晰帶語(yǔ)法著色的版本：http://gwx.showus.net/blog/article.asp?id=229

原創(chuàng)很辛苦，轉(zhuǎn)載請(qǐng)注明原文鏈接：http://gwx.showus.net/blog/article.asp?id=229

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

預(yù)備知識(shí)：除了一般的ASP+VBScript的知識(shí)外，你還需要了解xmlhttp對(duì)象和正則表達(dá)式對(duì)象。xmlhttp對(duì)象是時(shí)下風(fēng)頭正勁的Ajax的主角；而學(xué)好了正則表達(dá)式，你再也不用為處理復(fù)雜的字符串犯愁。

在編寫(xiě)和調(diào)試正則表達(dá)式時(shí)，RegEx 這個(gè)小工具非常有用。

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

１.抓取一個(gè)遠(yuǎn)程網(wǎng)頁(yè)并保存到本地
'用于調(diào)試的過(guò)程，后面會(huì)多次調(diào)用檢查中間結(jié)果
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

'過(guò)程： 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

關(guān)鍵的函數(shù)
'函數(shù)： myHttpGet
'功能： 抓取一個(gè)遠(yuǎn)程文件（網(wǎng)頁(yè)或圖片等）并保存到本地
'參數(shù)： sUrl    遠(yuǎn)程文件的URL
'       bText   是否是文本（網(wǎng)頁(yè)），下載遠(yuǎn)程圖片是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")  '服務(wù)器版本的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

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

２.同時(shí)下載遠(yuǎn)程網(wǎng)頁(yè)的圖片（和其它文件）
'函數(shù)： ProcessRemoteUrl
'功能： 替換字符串中的遠(yuǎn)程文件為本地文件并保存遠(yuǎn)程文件
'參數(shù)： strContent  要替換的字符串，即遠(yuǎn)程網(wǎng)頁(yè)文件的內(nèi)容
'       sSavePath   不以／結(jié)尾的相對(duì)路徑,指示遠(yuǎn)程文件的本地保存路徑
'       sPreceding  更改后的URL前綴,如http://somehost/upload/
'返回： 替換遠(yuǎn)程路徑為本地路徑之后的新的網(wǎng)頁(yè)文本內(nèi)容
Function ProcessRemoteUrl(sContent,sSavePath,sPreceding)
    Call D("ProcessRemoteUrl")

Set re=new RegExp
    re.IgnoreCase =true
    re.Global=True
    '下面的正則中.SubMatches(4)=文件名全名.SubMatches(5)文件擴(kuò)展名
    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     正則表達(dá)式Match對(duì)象的集合
    'RemoteFileUrl  正則表達(dá)式Match對(duì)象
    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 
改進(jìn)：探測(cè)真實(shí)URL
上面的ProcessRemoteUrl函數(shù)不能正確處理形如<img src="upload/abc.jpg" />和<a href="/upload/abc.gif" ...的內(nèi)容，要處理這些相對(duì)鏈接，我們可以先用下面的函數(shù)把網(wǎng)頁(yè)中的相對(duì)鏈接都轉(zhuǎn)換成絕對(duì)鏈接
'函數(shù)： DetectUrl
'功能： 替換字符串中的遠(yuǎn)程文件相對(duì)路徑為以http://..開(kāi)頭的絕對(duì)路徑
'參數(shù)： sContent    要處理的含相對(duì)路徑的網(wǎng)頁(yè)的文本內(nèi)容
'       sUrl        所處理的遠(yuǎn)程網(wǎng)頁(yè)自身的URL，用于分析相對(duì)路徑
'返回： 替換相對(duì)鏈接為絕對(duì)鏈接之后的新的網(wǎng)頁(yè)文本內(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 正則表達(dá)式Match對(duì)象的集合
    'RemoteFileUrl 正則表達(dá)式Match對(duì)象,形如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 
改進(jìn)：避免重復(fù)下載
網(wǎng)頁(yè)中的有些圖片，比如spacer.gif重復(fù)出現(xiàn)，會(huì)被重復(fù)下載，壁免這個(gè)問(wèn)題的一個(gè)方法是設(shè)置一個(gè)arrUrls數(shù)組，把采集過(guò)的文件的URL放在里面，在每次采集前先遍歷數(shù)組看是否已經(jīng)采集，然后只參集沒(méi)有參集過(guò)的文件

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

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

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

二是你可能不想在對(duì)方的服務(wù)器上留下連續(xù)的瀏覽記錄，下面的一個(gè)小函數(shù)會(huì)有所幫助
'過(guò)程： 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)用舉例，晢停,時(shí)長(zhǎng)隨機(jī)，在3秒以內(nèi)
Sleep(Fix(Rnd()*3))

三就是多用正則表達(dá)式測(cè)試工具提高編寫(xiě)正則表達(dá)式的效率

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

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

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

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

最新評(píng)論