web采集程序？網(wǎng)頁抓取程序？小倫程序？不管怎么叫，這種程序應用倒是蠻廣的。本文不討論這種使用這種程序引起的版權或道德問題，只談這種程序在ASP+VBScript環(huán)境下的實現(xiàn) :-)

預備知識：除了一般的ASP+VBScript的知識外，你還需要了解xmlhttp對象和正則表達式對象。xmlhttp對象是時下風頭正勁的Ajax的主角；而學好了正則表達式，你再也不用為處理復雜的字符串犯愁。

在編寫和調(diào)試正則表達式時，RegEx 這個小工具非常有用。

目錄
抓取一個遠程網(wǎng)頁并保存到本地 
改進：處理亂碼 
同時下載遠程網(wǎng)頁的圖片（和其它文件） 
改進：探測真實URL 
改進：避免重復下載 
實戰(zhàn)舉例（以****為例） 
分析列表頁 
內(nèi)容頁的技巧 
分析內(nèi)容頁中的上一頁，下一頁 
高級主題：UTF-8和GB2312的轉(zhuǎn)換 
更多高級主題：登陸后抓取，客戶端偽造 
己有的采集程序 
原文鏈接：http://gwx.showus.net/blog/article.asp?id=229

１.抓取一個遠程網(wǎng)頁并保存到本地
'用于調(diào)試的過程，后面會多次調(diào)用檢查中間結果
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
'功能： 把文本或字節(jié)流保存為文件
'參數(shù)： sContent    要保存的內(nèi)容
'       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

關鍵的函數(shù)
'函數(shù)： myHttpGet
'功能： 抓取一個遠程文件（網(wǎng)頁或圖片等）并保存到本地
'參數(shù)： sUrl    遠程文件的URL
'       bText   是否是文本（網(wǎng)頁），下載遠程圖片是bText=False
'返回： 抓取的內(nèi)容
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組件
    '理解下面的內(nèi)容，你可以參考一下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

改進：處理亂碼
直接讀取服務器返回的中文內(nèi)容會出現(xiàn)亂碼，myHttpGet函數(shù)中引用的bytes2BSTR的作用是正確讀取服務器返回的文件中的雙字節(jié)文本（比如說中文）
'myHttpGet helper 處理雙字節(jié)文本
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函數(shù)的功能也可以利用Adodb.Stream組件通過下面的函數(shù)實現(xiàn)，雖然下面的函數(shù)可以指定字符集Charset,但它并不能轉(zhuǎn)換編碼，即傳遞"UTF-8"給參數(shù)sCset，來讀取一張GB2312編碼的網(wǎng)頁將顯示為亂碼。
'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

２.同時下載遠程網(wǎng)頁的圖片（和其它文件）
'函數(shù)： ProcessRemoteUrl
'功能： 替換字符串中的遠程文件為本地文件并保存遠程文件
'參數(shù)： strContent  要替換的字符串，即遠程網(wǎng)頁文件的內(nèi)容
'       sSavePath   不以／結尾的相對路徑,指示遠程文件的本地保存路徑
'       sPreceding  更改后的URL前綴,如http://somehost/upload/
'返回： 替換遠程路徑為本地路徑之后的新的網(wǎng)頁文本內(nèi)容
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函數(shù)不能正確處理形如<img src="upload/abc.jpg" />和<a href="/upload/abc.gif" ...的內(nèi)容，要處理這些相對鏈接，我們可以先用下面的函數(shù)把網(wǎng)頁中的相對鏈接都轉(zhuǎn)換成絕對鏈接
'函數(shù)： DetectUrl
'功能： 替換字符串中的遠程文件相對路徑為以http://..開頭的絕對路徑
'參數(shù)： sContent    要處理的含相對路徑的網(wǎng)頁的文本內(nèi)容
'       sUrl        所處理的遠程網(wǎng)頁自身的URL，用于分析相對路徑
'返回： 替換相對鏈接為絕對鏈接之后的新的網(wǎng)頁文本內(nèi)容
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 
改進：避免重復下載
網(wǎng)頁中的有些圖片，比如spacer.gif重復出現(xiàn)，會被重復下載，壁免這個問題的一個方法是設置一個arrUrls數(shù)組，把采集過的文件的URL放在里面，在每次采集前先遍歷數(shù)組看是否已經(jīng)采集，然后只參集沒有參集過的文件

３.實戰(zhàn)舉例（以****為例）
****是我最經(jīng)常去的地方，而且網(wǎng)速不錯，就以她為例啦，沒有惡意哦:-)

分析列表頁
內(nèi)容頁的技巧
分析內(nèi)容頁中的上一頁，下一頁
想了一下，這部分內(nèi)容還是晢時不寫，免得被ＢＳ了  :-),還省得打好多字。 無非是把遠程網(wǎng)頁采集下來，然后用正則表達式分析提取其中的特定內(nèi)容，如標題，作者，內(nèi)容之類的 我有兩個小小的經(jīng)驗：

一是網(wǎng)頁源碼前后的內(nèi)容對分析有很大的干擾，你可以用下面的方法先把它支除
'抽取部分內(nèi)容進行分析，你可以用用EditPlus數(shù)字數(shù)
'去除前7600和后5000的字符
sPageW=Left(sPageW,Len(sPageW)-5000)
sPageW=Mid(sPageW,7600)

二是你可能不想在對方的服務器上留下連續(xù)的瀏覽記錄，下面的一個小函數(shù)會有所幫助
'過程： Sleep
'功能： 程序在此晢停幾秒
'參數(shù)： iSeconds    要暫停的秒數(shù)
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

'調(diào)用舉例，晢停,時長隨機，在3秒以內(nèi)
Sleep(Fix(Rnd()*3))

三就是多用正則表達式測試工具提高編寫正則表達式的效率

４.高級主題：UTF-8和GB2312的轉(zhuǎn)換
這個問題比較復雜，由于我智力和精力方面的原因沒有完全搞定，網(wǎng)上己有的資料也大多不完全正確或者不全面，我推薦一個UTF-8和GB2312的轉(zhuǎn)換的Ｃ語言的實現(xiàn)供大家參考，它功能完整而且不依賴Windows API函數(shù)。
我在試著用ASP+VBScript實現(xiàn)它，有一些不太成熟的經(jīng)驗：

計算機上的文件、操作系統(tǒng)內(nèi)部的字符串表示都是Unicode的，所以，UTF-8和GB2312之間的轉(zhuǎn)換需要以Unicode為中介 
UTF-8就是Unicode的一個變體，它們之間的相互轉(zhuǎn)換比較簡單，參考下圖就可以了 
GB2312和Unicode的編碼好像是不相關的，不依賴操作系統(tǒng)內(nèi)部函數(shù)進行轉(zhuǎn)換就需要一個編碼映射表，指出GB2312和Unicode的編碼一一對應的關系，這個編碼表大約包含7480×２個項目。 
在ASP文件中，要默認以某和編碼(如GB2312)讀取一個字符串，需要將ASP的CodePage設為相應代碼頁（對GB2312是CodePage=936） 
編碼轉(zhuǎn)換中還有一些又小又重要的問題我還不知道:-( 
５.更多高級主題：登陸后抓取，客戶端偽造等
xmlhttp對象可以以post或get的方法與http服務器交互，可以設置和讀取http頭，學習一下http協(xié)議，并且更深入的了解一些xmlhttp對象的方法和屬性，你就可以用它來模擬一個瀏覽器，自動的做各種以前需要人來做的重復工作。

６.己有的采集程序
本文旨在討論采集程序在ASP+VBScript環(huán)境下的實現(xiàn)，如果你需要一個網(wǎng)頁采集程序，下面的鏈接可能對你有用。

LocoySpider火車頭網(wǎng)頁內(nèi)容采集器 
C#+.Net編寫的內(nèi)容采集器，它的一個重要特點是不將采集來的內(nèi)容保存到數(shù)據(jù)庫，而是使用自定的POST提交的別的網(wǎng)頁，如內(nèi)容管理系統(tǒng)的新建內(nèi)容頁。免費。 
BeeCollector (小蜜蜂采集器) 
PHP+MySQL編寫的內(nèi)容采集器。 
風訊內(nèi)容管理系統(tǒng) 
這個強大的內(nèi)容管理系統(tǒng)內(nèi)帶有一個ASP的網(wǎng)頁內(nèi)容采集器