当前位置：编程学习 > asp >>
答案：web采集程序？网页抓取程序？小倫程序？不管怎么叫，这种程序应用倒是蛮广的。本文不讨论这种使用这种程序引起的版权或道德问题，只谈这种程序在ASP+VBScript环境下的实现 :-)
预备知识：除了一般的ASP+VBScript的知识外，你还需要了解xmlhttp对象和正则表达式对象。xmlhttp对象是时下风头正劲的Ajax的主角；而学好了正则表达式，你再也不用为处理复杂的字符串犯愁。
在编写和调试正则表达式时，RegEx 这个小工具非常有用。
目录
抓取一个远程网页并保存到本地
改进：处理乱码
同时下载远程网页的图片（和其它文件）
改进：探测真实URL
改进：避免重复下载
实战举例（以****为例）
分析列表页
内容页的技巧
分析内容页中的上一页，下一页
高级主题：UTF-8和GB2312的转换
更多高级主题：登陆后抓取，客户端伪造
己有的采集程序
原文链接：http://gwx.showus.net/blog/article.asp?id=229
１.抓取一个远程网页并保存到本地
'用于调试的过程，后面会多次调用检查中间结果
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前缀,如http://somehost/upload/
'返回： 替换远程路径为本地路径之后的新的网页文本内容
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=>'函数： DetectUrl
'功能： 替换字符串中的远程文件相对路径为以http://..开头的绝对路径
'参数： 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 = "(http://[-A-Z0-9.]+)/[-A-Z0-9+&@#%~_|!:,.;/]+/"
Dim sHost,sPath
'http://localhost/get/sample.asp
Set sMatch=re.Execute(sUrl)
'http://localhost
sHost=sMatch(0).SubMatches(0)
'http://localhost/get/
sPath=sMatch(0)
re.Pattern = "(src|href)=""?((?!http://)[-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放在里面，在每次采集前先遍历数组看是否已经采集，然后只参集没有参集过的文件
３.实战举例（以****为例）
****是我最经常去的地方，而且网速不错，就以她为例啦，没有恶意哦:-)
分析列表页
内容页的技巧
分析内容页中的上一页，
- 更多asp疑问解答：
- asp正则过滤重复字符串的代码
- 用asp过滤全部html但保留br类似的符号
- 会asp，但感觉asp要过点，想学php。但我一般做的都是小公司的站，用access数
- PHP的空间可以用ASP的源代码吗？
- 以前做asp程序，现在应该怎样发展？是学.net还是php
- 以前做asp程序，现在应该怎样发展？是学.net还是php
- 想做一个市级的人才网acess,sql数据库，语言asp,jsp,php分别用哪种好
- jsp，asp，php 区别
- 我想找一个有比较多漏洞的网站的源码，比如可以asp，php注入等都可以。供学习研究用。请提供下载地址。。
- 现在候找人做个网站，用ASP，还是PHP语言去做好
- asp,php ,jsp,.net 对于做网站前台的重要吗？
- asp和php的区别是什么？
- 我是新手SEO菜鸟 请问wp dw php asp cms myspl dede 这些软件应该如何区分呀？
- 网页制作相关的三种语言：ASP JSP PHP那个好点，简单点？
- 网页制作相关的三种语言：ASP JSP PHP那个好点，简单点？