用xmlhttp编写web采集程序

　　晰带语法着色的版本：

原创很辛苦，转载请注明原文链接：

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

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

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

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

１.抓取一个远程网页并保存到本地
用于调试的过程，后面会多次调用检查中间结果
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

２.同时下载远程网页的图片（和其它文件）
函数：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放在里面，在每次采集前先遍历数组看是否已经采集，然后只参集没有参集过的文件

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

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

一是网页源码前后的内容对分析有很大的干扰，你可以用下面的方法先把它支除
抽取部分内容进行分析，你可以用用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))

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

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

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

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

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