晰带语法着色的版本：[url=http://gwx.showus.net/blog/article.asp?id=229]http://gwx.showus.net/blog/article.asp?id=229[/url] 原创很辛苦，转载请注明原文链接：[url=http://gwx.showus.net/blog/article.asp?id=229]http://gwx.showus.net/blog/article.asp?id=229[/url] web采集程序？网页抓取程序？小倫程序？不管怎么叫，这种程序应用倒是蛮广的。本文不讨论这种使用这种程序引起的版权或道德问题，只谈这种程序在ASP+VBScript环境下的实现 :-) 预备知识：除了一般的ASP+VBScript的知识外，你还需要了解xmlhttp对象和正则表达式对象。xmlhttp对象是时下风头正劲的Ajax的主角；而学好了正则表达式，你再也不用为处理复杂的字符串犯愁。 在编写和调试正则表达式时，RegEx 这个小工具非常有用。 目录 抓取一个远程网页并保存到本地  改进：处理乱码  同时下载远程网页的图片（和其它文件）  改进：探测真实URL  改进：避免重复下载  实战举例（以****为例）  分析列表页  内容页的技巧  分析内容页中的上一页，下一页  高级主题：UTF-8和GB2312的转换  更多高级主题：登陆后抓取，客户端伪造  己有的采集程序  原文链接：[url=http://gwx.showus.net/blog/article.asp?id=229]http://gwx.showus.net/blog/article.asp?id=229[/url] １.抓取一个远程网页并保存到本地 '用于调试的过程，后面会多次调用检查中间结果 Dim inDebug:inDebug=True  Sub D(Str)     If inDebug = False Then Exit Sub     Response.Write("<div style='color:#003399; border: solid 1px #003399; background: #EEF7FF; margin: 1px; font-size: 12px; padding: 4px;'>")     Response.Write(Str &"</div>")     Response.Flush() End Sub '过程： Save2File '功能： 把文本或字节流保存为文件 '参数： sContent    要保存的内容 '       sFile       保存到文件，形如"files/abc.htm" '       bText       是否是文本 '       bOverWrite  是否覆盖己存在文件 Sub Save2File(sContent,sFile,bText,bOverWrite)     Call D("Save2File:"+sFile+" *是否文本："&bText)     Dim SaveOption,TypeOption     If (bOverWrite = True) Then SaveOption=2 Else SaveOption=1     If (bText = True) Then TypeOption=2 Else TypeOption=1     Set Ads = Server.CreateObject("Adodb.Stream")     With Ads         .Type = TypeOption          .Open         If (bText = True) Then .WriteText sContent Else .Write sContent         .SaveToFile Server.MapPath(sFile),SaveOption         .Cancel()         .Close()     End With     Set Ads=nothing End Sub 关键的函数 '函数： myHttpGet '功能： 抓取一个远程文件（网页或图片等）并保存到本地 '参数： sUrl    远程文件的URL '       bText   是否是文本（网页），下载远程图片是bText=False '返回： 抓取的内容 Function myHttpGet(sUrl,bText)     Call D("<font color=red>myHttpGet:</font>"+sUrl+" *是否文本："&bText)     'Set oXml = Server.CreateObject("Microsoft.XMLHTTP")     Set oXml = Server.CreateObject("MSXML2.ServerXMLHTTP")  '服务器版本的XMLHTTP组件     '理解下面的内容，你可以参考一下MSDN中的MSXML2.ServerXMLHTTP     With oXml         .Open "GET",sUrl,False         .Send         While .readyState <> 4  '等待下载完毕             .waitForResponse 1000          Wend          If bText = True Then             myHttpGet = bytes2BSTR(.responseBody)         Else             myHttpGet = .responseBody         End If     End With     Set oXml = Nothing End Function 改进：处理乱码 直接读取服务器返回的中文内容会出现乱码，myHttpGet函数中引用的bytes2BSTR的作用是正确读取服务器返回的文件中的双字节文本（比如说中文） 'myHttpGet helper 处理双字节文本 Function bytes2BSTR(vIn)     strReturn = ""     For i = 1 To LenB(vIn)         ThisCharCode = AscB(MidB(vIn,i,1))         If ThisCharCode < &H80 Then             strReturn = strReturn & Chr(ThisCharCode)         Else             NextCharCode = AscB(MidB(vIn,i+1,1))             strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))             i = i + 1         End If     Next     bytes2BSTR = strReturn End Function bytes2BSTR函数的功能也可以利用Adodb.Stream组件通过下面的函数实现，虽然下面的函数可以指定字符集Charset,但它并不能转换编码，即传递"UTF-8"给参数sCset，来读取一张GB2312编码的网页将显示为乱码。 'CharsetHelper可以正确的读取以sCset（如"GB2312","UTF-8"等）编码的文件 Function CharsetHelper(arrBytes,sCset)     Call D("CharsetHelper: "+sCset)     Dim oAdos     Set oAdos = CreateObject("Adodb.Stream")     With oAdos         .Type = 1         .Mode =3    'adModeReadWrite         .Open         .Write arrBytes         .Position = 0         .Type = 2         .Charset = sCset         CharsetHelper = .ReadText          .Close     End With     Set oAdos = Nothing End Function ２.同时下载远程网页的图片（和其它文件） '函数： ProcessRemoteUrl '功能： 替换字符串中的远程文件为本地文件并保存远程文件 '参数： strContent  要替换的字符串，即远程网页文件的内容 '       sSavePath   不以／结尾的相对路径,指示远程文件的本地保存路径 '       sPreceding  更改后的URL前缀,如[url=http://somehost/upload/]http://somehost/upload/[/url] '返回： 替换远程路径为本地路径之后的新的网页文本内容 Function ProcessRemoteUrl(sContent,sSavePath,sPreceding)     Call D("ProcessRemoteUrl") Set re=new RegExp     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)))" Set RemoteFile = re.Execute(sContent) Dim SaveFileName     'RemoteFile     正则表达式Match对象的集合     'RemoteFileUrl  正则表达式Match对象     For Each RemoteFileUrl in RemoteFile         SaveFileName = RemoteFileUrl.SubMatches(4)         Call Save2File(myHttpGet(RemoteFileUrl,False),sSavePath&"/"&SaveFileName,False,True)         sContent=Replace(sContent,RemoteFileUrl,sPreceding&SaveFileName)     Next ProcessRemoteUrl=sContent End Function  改进：探测真实URL 上面的ProcessRemoteUrl函数不能正确处理形如<img src="upload/abc.jpg" />和<a href="/upload/abc.gif" ...的内容，要处理这些相对链接，我们可以先用下面的函数把网页中的相对链接都转换成绝对链接 '函数： DetectUrl '功能： 替换字符串中的远程文件相对路径为以[url=http://../]http://..[/url]开头的绝对路径 '参数： sContent    要处理的含相对路径的网页的文本内容 '       sUrl        所处理的远程网页自身的URL，用于分析相对路径 '返回： 替换相对链接为绝对链接之后的新的网页文本内容 Function DetectUrl(sContent,sUrl)     Call D("DetectUrl:"&sUrl) '分析URL     Dim re,sMatch     Set re=new RegExp     re.Multiline=True     re.IgnoreCase =true     re.Global=True re.Pattern = "([url=http:/]http://[/url][-A-Z0-9.]+)/[-A-Z0-9+&@#%~_|!:,.;/]+/"     Dim sHost,sPath     '[url=http://localhost/get/sample.asp]http://localhost/get/sample.asp[/url]     Set sMatch=re.Execute(sUrl)     '[url=http://localhost/]http://localhost[/url]     sHost=sMatch(0).SubMatches(0)     '[url=http://localhost/]http://localhost[/url]/get/     sPath=sMatch(0) re.Pattern = "(src|href)=""?((?![url=http:/]http://[/url])[-A-Z0-9+&@#%=~_|!:,.;/]+)""?"     Set RemoteFile = re.Execute(sContent) 'RemoteFile 正则表达式Match对象的集合     'RemoteFileUrl 正则表达式Match对象,形如src="Upload/a.jpg"     Dim sAbsoluteUrl     For Each RemoteFileUrl in RemoteFile         '<img src="a.jpg">,<img src="f/a.jpg">,<img src="/ff/a.jpg">         If Left(RemoteFileUrl.SubMatches(1),1)="/" Then             sAbsoluteUrl=sHost         Else             sAbsoluteUrl=sPath         End If         sAbsoluteUrl = RemoteFileUrl.SubMatches(0)&"="""&sAbsoluteUrl&RemoteFileUrl.SubMatches(1)&""""         sContent=Replace(sContent,RemoteFileUrl,sAbsoluteUrl)     Next DetectUrl=sContent End Function  改进：避免重复下载 网页中的有些图片，比如spacer.gif重复出现，会被重复下载，壁免这个问题的一个方法是设置一个arrUrls数组，把采集过的文件的URL放在里面，在每次采集前先遍历数组看是否已经采集，然后只参集没有参集过的文件 ３.实战举例（以****为例） ****是我最经常去的地方，而且网速不错，就以她为例啦，没有恶意哦:-) 分析列表页 内容页的技巧 分析内容页中的上一页，下一页 想了一下，这部分内容还是晢时不写，免得被ＢＳ了  :-),还省得打好多字。 无非是把远程网页采集下来，然后用正则表达式分析提取其中的特定内容，如标题，作者，内容之类的 我有两个小小的经验： 一是网页源码前后的内容对分析有很大的干扰，你可以用下面的方法先把它支除 '抽取部分内容进行分析，你可以用用EditPlus数字数 '去除前7600和后5000的字符 sPageW=Left(sPageW,Len(sPageW)-5000) sPageW=Mid(sPageW,7600) 二是你可能不想在对方的服务器上留下连续的浏览记录，下面的一个小函数会有所帮助 '过程： Sleep '功能： 程序在此晢停几秒 '参数： iSeconds    要暂停的秒数 Sub Sleep(iSeconds)     D Timer()&" <font color=blue>Sleep For "&iSeconds&" Seconds</font>"     Dim t:t=Timer()     While(Timer()<t+iSeconds)         'Do Nothing     Wend     D Timer()&" <font color=blue>Sleep For "&iSeconds&" Seconds OK</font>" End Sub '调用举例，晢停,时长随机，在3秒以内 Sleep(Fix(Rnd()*3)) 三就是多用正则表达式测试工具提高编写正则表达式的效率 ４.高级主题：UTF-8和GB2312的转换 这个问题比较复杂，由于我智力和精力方面的原因没有完全搞定，网上己有的资料也大多不完全正确或者不全面，我推荐一个UTF-8和GB2312的转换的Ｃ语言的实现供大家参考，它功能完整而且不依赖Windows API函数。 我在试着用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的网页内容采集器