ASP

ASP远程读取基本函数

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> 
<% 
'codepage=936简体中文 'codepage=950繁体中文 
'codepage=65001UTF-8 url="http://www.gkj.com.cn/article.asp?id=21" 
'url=request.Form("weburl") 
'num=request.Form("count") 
'str=GetBody(url) 
'start="<div id=""logPanel"" class=""Content-body"">" 
'ends="</div>" 
'response.Write body(str,start,ends) 
Hello("http://list.mp3.baidu.com/song/A.htm"
, "<table width=""90%"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""0"" bgcolor=""#f5f5f5"" >"
, "<div align=center>"
, ".*(<td width=""20%""><a href="".*\.htm"" target=_blank>)(.*)(</a></td>)[.\n]*", "<font style=""font-size:9pt;"" color=blue>$2</font>") 
%>

<form action="" method="post"> 采集网址 <input type="text" size="100" name="weburl">
采集数量 <input type="text" size="5" name="count">
<input type="submit" value="submit"> 
</form> 

<% 
'1、取得网站的分页列表页的每页地址 
'2、获取被采集网站的分页列表页内容 
'3、从分页列表代码中提取被采集的内容页面的URL连接地址 
'4、取得被采集的内容页面内容 '用以下代码就可以获得一个URL连接集合 
'以下内容为程序代码: 
'Set xiaoqi = New Regexp 
'xiaoqi.IgnoreCase = True 
'xiaoqi.Global = True 
'xiaoqi.Pattern = """.+?""" 
'Set Matches =xiaoqi.Execute(页面列表内容) 
'set xiaoqi=nothing 'url="" 
'For Each Match in Matches 
'url=url&Match.Value 
'Next 
'用serverXMLHTTP组件获取数据 
'调用方法:GetBodyServer(文件的URLf地址) 

Function GetBodyServer(weburl) 
'创建对象 
Dim ObjXMLHTTP Set ObjXMLHTTP=Server.CreateObject("MSXML2.serverXMLHTTP") 
'请求文件,以异步形式
ObjXMLHTTP.Open "GET",weburl,False ObjXMLHTTP.send 
While ObjXMLHTTP.readyState <> 4 
ObjXMLHTTP.waitForResponse 1000 
Wend 
'得到结果 
GetBodyServer=ObjXMLHTTP.responseBody 
'释放对象 
Set ObjXMLHTTP=Nothing End Function 
'XMLHTTP组件获取数据 
'调用方法:GetBody(文件的URLf地址) 
Function GetBody(weburl) 
'创建对象 
Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
With Retrieval .Open "Get", weburl, False, "", "" 
.Send GetBody =BytesToBstr( .ResponseBody , "GB2312") 
End With 
'释放对象 
Set Retrieval = Nothing End Function 
'BytesToBstr(要转换的数据,编码) 
'编码常用为GB2312和UTF-8 

Function BytesToBstr(body,Cset) 
dim objstream 
set objstream = Server.CreateObject("adodb.stream") 
objstream.Type = 1 
objstream.Mode =3 
objstream.Open 
objstream.Write body 
objstream.Position = 0 
objstream.Type = 2 
objstream.Charset = Cset 
BytesToBstr = objstream.ReadText 
objstream.Close 
set objstream = nothing 
End Function 

'后期处理 
Function Hello(strUrl, strStart, strEnd, patrn, replStr) 
Str = GetBody(strUrl) 
Str = MyMid(Str, strStart, strEnd) 
Str = ReplaceTest(patrn, replStr, Str) 
Hello = Str 
End Function 

Function MyMid(Str, strstart, strend) 
If strstart = "" 
Then
i = 0 
Else
i = InStr(Str, strstart) 
End If 
If strend = "" Then j = Len(Str) 
Else j = InStr(i, Str, strend) 
End If 
MyMid = Mid(Str, i, j - i + 1) 
End Function 

Function ReplaceTest(patrn, replStr, str1) 
Dim regEx, match, matches 
Set regEx = New RegExp 
regEx.Pattern = patrn 
regEx.IgnoreCase = True 
regEx.Global = True 
Set matches = regEx.Execute(str1) 

For Each match in matches 
ReplaceTest = ReplaceTest@Ex.Replace(Match.Value, replStr) 
Next 
End Function 

'用ASP内置的MID函数截取需要的数据 
'调用方法:body(被采集的页面的内容,开始标记,结束标记) 
Function bodyb(wstr,start,over) 
start=Newstring(wstr,start) 
'设置需要处理的数据的唯一的开始标记 
over=Newstring(wstr,over) 
'和start相对应的就是需要处理的数据的唯一的结束标记 
body=mid(wstr,start,over-start) 
'设置显示页面的范围 
End Function 
'用正则获取需要的数据 
'调用方法:body(被采集的页面的内容,开始标记,结束标记) 

Function body(wstr,start,over) 
Set xiaoqi = New Regexp
'设置配置对象 
xiaoqi.IgnoreCase = True
'忽略大小写
xiaoqi.Global = True
'设置为全文搜索 
xiaoqi.Pattern = ""&start&".*?"&over&""
'正则表达式 
Set Matches =xiaoqi.Execute(wstr)
'开始执行配置 
set xiaoqi=nothing 
body="" 
For Each Match in Matches 
body=body&Match.Value 
'循环匹配 
Next 
End Function 
%>
分类: ASP

发表回复

您的邮箱地址不会被公开。 必填项已用 * 标注

这个站点使用 Akismet 来减少垃圾评论。了解你的评论数据如何被处理

相关文章

开始在上面输入您的搜索词,然后按回车进行搜索。按ESC取消。

返回顶部