晰带语法着色的版本：http://gwx.showus.net/blog/article.asp?id=229
原创很辛苦，转载请注明原文链接：http://gwx.showus.net/blog/article.asp?id=229
web采集程序？网页抓取程序？小倫程序？不管怎么叫，这种程序应用倒是蛮广的。本文不讨论这种使用这种程序引起的版权或道德问题，只谈这种程序在ASP+VBScript环境下的实现:-)
预备知识：除了一般的ASP+VBScript的知识外，你还需要了解xmlhttp对象和正则表达式对象。xmlhttp对象是时下风头正劲的Ajax的主角；而学好了正则表达式，你再也不用为处理复杂的字符串犯愁。
在编写和调试正则表达式时，RegEx这个小工具非常有用。
目录
抓取一个远程网页并保存到本地
改进：处理乱码
同时下载远程网页的图片（和其它文件）
改进：探测真实URL
改进：避免重复下载
实战举例（以****为例）
分析列表页
内容页的技巧
分析内容页中的上一页，下一页
高级主题：UTF-8和GB2312的转换
更多高级主题：登陆后抓取，客户端伪造
己有的采集程序
原文链接：http://gwx.showus.net/blog/article.asp?id=229
１.抓取一个远程网页并保存到本地
'用于调试的过程，后面会多次调用检查中间结果
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
.Open"GET",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=3'adModeReadWrite
.Open
.WritearrBytes
.Position=0
.Type=2
.Charset=sCset
CharsetHelper=.ReadText
.Close
EndWith
SetoAdos=Nothing
EndFunction
２.同时下载远程网页的图片（和其它文件）
'函数：ProcessRemoteUrl
'功能：替换字符串中的远程文件为本地文件并保存远程文件
'参数：strContent要替换的字符串，即远程网页文件的内容
'sSavePath不以／结尾的相对路径,指示远程文件的本地保存路径
'sPreceding更改后的URL前缀,如http://somehost/upload/
'返回：替换远程路径为本地路径之后的新的网页文本内容
FunctionProcessRemoteUrl(sContent,sSavePath,sPreceding)
CallD("ProcessRemoteUrl")
Setre=newRegExp
re.IgnoreCase=true
re.Global=True
'下面的正则中.SubMatches(4)=文件名全名.SubMatches(5)文件扩展名
re.Pattern="((http):(?://){1}(?:(?:w)+[.])+(net|com|cn|org|cc|tv|[0-9]{1,4})(S*/)((?:S)+[.]{1}(gif|jpg|jpeg|png|bmp)))"
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
'功能：替换字符串中的远程文件相对路径为以http://..开头的绝对路径
'参数：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="(http://[-A-Z0-9.]+)/[-A-Z0-9+&@#%~_|!:,.;/]+/"
DimsHost,sPath
'http://localhost/get/sample.asp
SetsMatch=re.Execute(sUrl)
'http://localhost
sHost=sMatch(0).SubMatches(0)
'http://localhost/get/
sPath=sMatch(0)
re.Pattern="(src|href)=""?((?!http://)[-A-Z0-9+&@#%=~_|!:,.;/]+)""?"
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火车头网页内容采集器
C#+.Net编写的内容采集器，它的一个重要特点是不将采集来的内容保存到数据库，而是使用自定的POST提交的别的网页，如内容管理系统的新建内容页。免费。
BeeCollector(小蜜蜂采集器)
PHP+MySQL编写的内容采集器。
风讯内容管理系统
这个强大的内容管理系统内带有一个ASP的网页内容采集器
【用xmlhttp编写web采集程序】相关文章：
★ 一段采集程序代码