用xmlhttp编写web采集程序

2018-09-05 19:33

阅读:1233

  晰带语法着色的版本:

原创很辛苦,转载请注明原文链接:

web采集程序?网页抓取程序?小倫程序?不管怎么叫,这种程序应用倒是蛮广的。本文不讨论这种使用这种程序引起的版权或道德问题,只谈这种程序在ASP+VBScript环境下的实现:-)

预备知识:除了一般的ASP+VBScript的知识外,你还需要了解xmlhttp对象和正则表达式对象。xmlhttp对象是时下风头正劲的Ajax的主角;而学好了正则表达式,你再也不用为处理复杂的字符串犯愁。

在编写和调试正则表达式时,RegEx这个小工具非常有用。

目录
抓取一个远程网页并保存到本地
改进:处理乱码
同时下载远程网页的图片(和其它文件)
改进:探测真实URL
改进:避免重复下载
实战举例(以****为例)
分析列表页
内容页的技巧
分析内容页中的上一页,下一页
高级主题:UTF-8和GB2312的转换
更多高级主题:登陆后抓取,客户端伪造
己有的采集程序
原文链接:

1.抓取一个远程网页并保存到本地
用于调试的过程,后面会多次调用检查中间结果
DiminDebug:inDebug=True
SubD(Str)
IfinDebug=FalseThenExitSub
Response.Write(<divstyle=color:#003399;border:solid1px#003399;background:#EEF7FF;margin:1px;font-size:12px;padding:4px;>)
Response.Write(Str&</div>)
Response.Flush()
EndSub

过程:Save2File
功能:把文本或字节流保存为文件
参数:sContent要保存的内容
sFile保存到文件,形如files/abc.htm
bText是否是文本
bOverWrite是否覆盖己存在文件
SubSave2File(sContent,sFile,bText,bOverWrite)
CallD(Save2File:+sFile+*是否文本:&bText)
DimSaveOption,TypeOption
If(bOverWrite=True)ThenSaveOption=2ElseSaveOption=1
If(bText=True)ThenTypeOption=2ElseTypeOption=1
SetAds=Server.CreateObject(Adodb.Stream)
WithAds
.Type=TypeOption
.Open
If(bText=True)Then.WriteTextsContentElse.WritesContent
.SaveToFileServer.MapPath(sFile),SaveOption
.Cancel()
.Close()
EndWith
SetAds=nothing
EndSub

关键的函数
函数:myHttpGet
功能:抓取一个远程文件(网页或图片等)并保存到本地
参数:sUrl远程文件的URL
bText是否是文本(网页),下载远程图片是bText=False
返回:抓取的内容
FunctionmyHttpGet(sUrl,bText)
CallD(<fontcolor=red>myHttpGet:</font>+sUrl+*是否文本:&bText)
SetoXml=Server.CreateObject(Microsoft.XMLHTTP)
SetoXml=Server.CreateObject(MSXML2.ServerXMLHTTP)服务器版本的XMLHTTP组件
理解下面的内容,你可以参考一下MSDN中的MSXML2.ServerXMLHTTP
WithoXml
.OpenGET,sUrl,False
.Send
While.readyState<>4等待下载完毕
.waitForResponse1000
Wend
IfbText=TrueThen
myHttpGet=bytes2BSTR(.responseBody)
Else
myHttpGet=.responseBody
EndIf
EndWith
SetoXml=Nothing
EndFunction

改进:处理乱码
直接读取服务器返回的中文内容会出现乱码,myHttpGet函数中引用的bytes2BSTR的作用是正确读取服务器返回的文件中的双字节文本(比如说中文)
myHttpGethelper处理双字节文本
Functionbytes2BSTR(vIn)
strReturn=
Fori=1ToLenB(vIn)
ThisCharCode=AscB(MidB(vIn,i,1))
IfThisCharCode<&H80Then
strReturn=strReturn&Chr(ThisCharCode)
Else
NextCharCode=AscB(MidB(vIn,i+1,1))
strReturn=strReturn&Chr(CLng(ThisCharCode)*&H100+CInt(NextCharCode))
i=i+1
EndIf
Next
bytes2BSTR=strReturn
EndFunction

bytes2BSTR函数的功能也可以利用Adodb.Stream组件通过下面的函数实现,虽然下面的函数可以指定字符集Charset,但它并不能转换编码,即传递UTF-8给参数sCset,来读取一张GB2312编码的网页将显示为乱码。
CharsetHelper可以正确的读取以sCset(如GB2312,UTF-8等)编码的文件
FunctionCharsetHelper(arrBytes,sCset)
CallD(CharsetHelper:+sCset)
DimoAdos
SetoAdos=CreateObject(Adodb.Stream)
WithoAdos
.Type=1
.Mode=3adModeReadWrite
.Open
.WritearrBytes
.Position=0
.Type=2
.Charset=sCset
CharsetHelper=.ReadText
.Close
EndWith
SetoAdos=Nothing
EndFunction

2.同时下载远程网页的图片(和其它文件)
函数:ProcessRemoteUrl
功能:替换字符串中的远程文件为本地文件并保存远程文件
参数:strContent要替换的字符串,即远程网页文件的内容
sSavePath不以/结尾的相对路径,指示远程文件的本地保存路径
sPreceding更改后的URL前缀,如
返回:替换远程路径为本地路径之后的新的网页文本内容
FunctionProcessRemoteUrl(sContent,sSavePath,sPreceding)
CallD(ProcessRemoteUrl)

Setre=newRegExp
re.IgnoreCase=true
re.Global=True
下面的正则中.SubMatches(4)=文件名全名.SubMatches(5)文件扩展名
re.Pattern=((http):(?:\/\/){1}(?:(?:\w)+[.])+(netcomcnorgcctv[0-9]{1,4})(\S*\/)((?:\S)+[.]{1}(gifjpgjpegpngbmp)))

SetRemoteFile=re.Execute(sContent)

DimSaveFileName
RemoteFile正则表达式Match对象的集合
RemoteFileUrl正则表达式Match对象
ForEachRemoteFileUrlinRemoteFile
SaveFileName=RemoteFileUrl.SubMatches(4)
CallSave2File(myHttpGet(RemoteFileUrl,False),sSavePath&/&SaveFileName,False,True)
sContent=Replace(sContent,RemoteFileUrl,sPreceding&SaveFileName)
Next

ProcessRemoteUrl=sContent
EndFunction
改进:探测真实URL
上面的ProcessRemoteUrl函数不能正确处理形如<imgsrc=upload/abc.jpg/>和<ahref=/upload/abc.gif...的内容,要处理这些相对链接,我们可以先用下面的函数把网页中的相对链接都转换成绝对链接
函数:DetectUrl
功能:替换字符串中的远程文件相对路径为以开头的绝对路径
参数:sContent要处理的含相对路径的网页的文本内容
sUrl所处理的远程网页自身的URL,用于分析相对路径
返回:替换相对链接为绝对链接之后的新的网页文本内容
FunctionDetectUrl(sContent,sUrl)
CallD(DetectUrl:&sUrl)

分析URL
Dimre,sMatch
Setre=newRegExp
re.Multiline=True
re.IgnoreCase=true
re.Global=True

re.Pattern=(
DimsHost,sPath

SetsMatch=re.Execute(sUrl)

sHost=sMatch(0).SubMatches(0)

sPath=sMatch(0)

re.Pattern=(srchref)=?((?!
SetRemoteFile=re.Execute(sContent)

RemoteFile正则表达式Match对象的集合
RemoteFileUrl正则表达式Match对象,形如src=Upload/a.jpg
DimsAbsoluteUrl
ForEachRemoteFileUrlinRemoteFile
<imgsrc=a.jpg>,<imgsrc=f/a.jpg>,<imgsrc=/ff/a.jpg>
IfLeft(RemoteFileUrl.SubMatches(1),1)=/Then
sAbsoluteUrl=sHost
Else
sAbsoluteUrl=sPath
EndIf
sAbsoluteUrl=RemoteFileUrl.SubMatches(0)&=&sAbsoluteUrl&RemoteFileUrl.SubMatches(1)&
sContent=Replace(sContent,RemoteFileUrl,sAbsoluteUrl)
Next

DetectUrl=sContent
EndFunction
改进:避免重复下载
网页中的有些图片,比如spacer.gif重复出现,会被重复下载,壁免这个问题的一个方法是设置一个arrUrls数组,把采集过的文件的URL放在里面,在每次采集前先遍历数组看是否已经采集,然后只参集没有参集过的文件

3.实战举例(以****为例)
****是我最经常去的地方,而且网速不错,就以她为例啦,没有恶意哦:-)

分析列表页
内容页的技巧
分析内容页中的上一页,下一页
想了一下,这部分内容还是晢时不写,免得被BS了:-),还省得打好多字。无非是把远程网页采集下来,然后用正则表达式分析提取其中的特定内容,如标题,作者,内容之类的我有两个小小的经验:

一是网页源码前后的内容对分析有很大的干扰,你可以用下面的方法先把它支除
抽取部分内容进行分析,你可以用用EditPlus数字数
去除前7600和后5000的字符
sPageW=Left(sPageW,Len(sPageW)-5000)
sPageW=Mid(sPageW,7600)

二是你可能不想在对方的服务器上留下连续的浏览记录,下面的一个小函数会有所帮助
过程:Sleep
功能:程序在此晢停几秒
参数:iSeconds要暂停的秒数
SubSleep(iSeconds)
DTimer()&<fontcolor=blue>SleepFor&iSeconds&Seconds</font>
Dimt:t=Timer()
While(Timer()<t+iSeconds)
DoNothing
Wend
DTimer()&<fontcolor=blue>SleepFor&iSeconds&SecondsOK</font>
EndSub

调用举例,晢停,时长随机,在3秒以内
Sleep(Fix(Rnd()*3))

三就是多用正则表达式测试工具提高编写正则表达式的效率

4.高级主题:UTF-8和GB2312的转换
这个问题比较复杂,由于我智力和精力方面的原因没有完全搞定,网上己有的资料也大多不完全正确或者不全面,我推荐一个UTF-8和GB2312的转换的C语言的实现供大家参考,它功能完整而且不依赖WindowsAPI函数。
我在试着用ASP+VBScript实现它,有一些不太成熟的经验:

计算机上的文件、操作系统内部的字符串表示都是Unicode的,所以,UTF-8和GB2312之间的转换需要以Unicode为中介
UTF-8就是Unicode的一个变体,它们之间的相互转换比较简单,参考下图就可以了
GB2312和Unicode的编码好像是不相关的,不依赖操作系统内部函数进行转换就需要一个编码映射表,指出GB2312和Unicode的编码一一对应的关系,这个编码表大约包含7480×2个项目。
在ASP文件中,要默认以某和编码(如GB2312)读取一个字符串,需要将ASP的CodePage设为相应代码页(对GB2312是CodePage=936)
编码转换中还有一些又小又重要的问题我还不知道:-(
5.更多高级主题:登陆后抓取,客户端伪造等
xmlhttp对象可以以post或get的方法与http服务器交互,可以设置和读取http头,学习一下http协议,并且更深入的了解一些xmlhttp对象的方法和属性,你就可以用它来模拟一个浏览器,自动的做各种以前需要人来做的重复工作。

6.己有的采集程序
本文旨在讨论采集程序在ASP+VBScript环境下的实现,如果你需要一个网页采集程序,下面的链接可能对你有用。

LocoySpider火车头网页内容采集器
BeeCollector(小蜜蜂采集器)
PHP+MySQL编写的内容采集器。
风讯内容管理系统
这个强大的内容管理系统内带有一个ASP的网页内容采集器


评论


亲,登录后才可以留言!