晰帶語法著色的版本：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
１.抓取一個遠程網頁並保存到本地
'用於調試的過程，後面會多次調用檢查中間結果
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="/upload/abc.gif" ...的內容，要處理這些相對鏈接，我們可以先用下面的函數把網頁中的相對鏈接都轉換成絕對鏈接
'函數： 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放在裡面，在每次采集前先遍歷數組看是否已經采集，然後只參集沒有參集過的文件
３.實戰舉例（以****為例）
****是我最經常去的地方，而且網速不錯，就以她為例啦，沒有惡意哦:-)
分析列表頁
內容頁的技巧
分析內容頁中的上一頁，下一頁
想了一下，這部分內容還是晢時不寫，免得被ＢＳ了 :-),還省得打好多字。 無非是把遠程網頁采集下來，然後用正則表達式分析提取其中的特定內容，如標題，作者，內容之類的 我有兩個小小的經驗：
一是網頁源碼前後的內容對分析有很大的干擾，你可以用下面的方法先把它支除
'抽取部分內容進行分析，你可以用用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的網頁內容采集器
