濮阳杆衣贸易有限公司

主頁 > 知識(shí)庫(kù) > 用xmlhttp編寫web采集程序

用xmlhttp編寫web采集程序

熱門標(biāo)簽:長(zhǎng)春公司外呼系統(tǒng)中心 沈陽電話機(jī)器人公司 鄢陵學(xué)校如何做地圖標(biāo)注 成都ai外呼系統(tǒng)線路 沈陽三五防封電銷卡 鄭州智能外呼電銷機(jī)器人廠家 云南便宜外呼系統(tǒng)平臺(tái) 廣東語音外呼系統(tǒng)公司 虛擬電話外呼系統(tǒng)
晰帶語法著色的版本: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īng)用倒是蠻廣的。本文不討論這種使用這種程序引起的版權(quá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ù)雜的字符串犯愁。

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

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

1.抓取一個(gè)遠(yuǎn)程網(wǎng)頁并保存到本地
'用于調(diào)試的過程,后面會(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

'過程: 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)頁或圖片等)并保存到本地
'參數(shù): sUrl    遠(yuǎn)程文件的URL
'       bText   是否是文本(網(wǎng)頁),下載遠(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é)文本(比如說中文)
'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ù)實(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

2.同時(shí)下載遠(yuǎn)程網(wǎng)頁的圖片(和其它文件)
'函數(shù): ProcessRemoteUrl
'功能: 替換字符串中的遠(yuǎn)程文件為本地文件并保存遠(yuǎn)程文件
'參數(shù): strContent  要替換的字符串,即遠(yuǎn)程網(wǎng)頁文件的內(nèi)容
'       sSavePath   不以/結(jié)尾的相對(duì)路徑,指示遠(yuǎn)程文件的本地保存路徑
'       sPreceding  更改后的URL前綴,如http://somehost/upload/
'返回: 替換遠(yuǎn)程路徑為本地路徑之后的新的網(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)文件擴(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,sPrecedingSaveFileName)
    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)頁中的相對(duì)鏈接都轉(zhuǎn)換成絕對(duì)鏈接
'函數(shù): DetectUrl
'功能: 替換字符串中的遠(yuǎn)程文件相對(duì)路徑為以http://..開頭的絕對(duì)路徑
'參數(shù): sContent    要處理的含相對(duì)路徑的網(wǎng)頁的文本內(nèi)容
'       sUrl        所處理的遠(yuǎn)程網(wǎng)頁自身的URL,用于分析相對(duì)路徑
'返回: 替換相對(duì)鏈接為絕對(duì)鏈接之后的新的網(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 正則表達(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)"="""sAbsoluteUrlRemoteFileUrl.SubMatches(1)""""
        sContent=Replace(sContent,RemoteFileUrl,sAbsoluteUrl)
    Next

DetectUrl=sContent
End Function 
改進(jìn):避免重復(fù)下載
網(wǎng)頁中的有些圖片,比如spacer.gif重復(fù)出現(xiàn),會(huì)被重復(fù)下載,壁免這個(gè)問題的一個(gè)方法是設(shè)置一個(gè)arrUrls數(shù)組,把采集過的文件的URL放在里面,在每次采集前先遍歷數(shù)組看是否已經(jīng)采集,然后只參集沒有參集過的文件

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

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

一是網(wǎng)頁源碼前后的內(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ì)有所幫助
'過程: 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è)試工具提高編寫正則表達(dá)式的效率

4.高級(jí)主題:UTF-8和GB2312的轉(zhuǎn)換
這個(gè)問題比較復(fù)雜,由于我智力和精力方面的原因沒有完全搞定,網(wǎng)上己有的資料也大多不完全正確或者不全面,我推薦一個(gè)UTF-8和GB2312的轉(zhuǎn)換的C語言的實(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×2個(gè)項(xiàng)目。 
在ASP文件中,要默認(rèn)以某和編碼(如GB2312)讀取一個(gè)字符串,需要將ASP的CodePage設(shè)為相應(yīng)代碼頁(對(duì)GB2312是CodePage=936) 
編碼轉(zhuǎn)換中還有一些又小又重要的問題我還不知道:-( 
5.更多高級(jí)主題:登陸后抓取,客戶端偽造等
xmlhttp對(duì)象可以以post或get的方法與http服務(wù)器交互,可以設(shè)置和讀取http頭,學(xué)習(xí)一下http協(xié)議,并且更深入的了解一些xmlhttp對(duì)象的方法和屬性,你就可以用它來模擬一個(gè)瀏覽器,自動(dòng)的做各種以前需要人來做的重復(fù)工作。

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

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

標(biāo)簽:湖北 四平 孝感 遼陽 馬鞍山 朝陽 防城港 平頂山

巨人網(wǎng)絡(luò)通訊聲明:本文標(biāo)題《用xmlhttp編寫web采集程序》,本文關(guān)鍵詞  用,xmlhttp,編寫,web,采集,;如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問題,煩請(qǐng)?zhí)峁┫嚓P(guān)信息告之我們,我們將及時(shí)溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò),涉及言論、版權(quán)與本站無關(guān)。
  • 相關(guān)文章
  • 下面列出與本文章《用xmlhttp編寫web采集程序》相關(guān)的同類信息!
  • 本頁收集關(guān)于用xmlhttp編寫web采集程序的相關(guān)信息資訊供網(wǎng)民參考!
  • 推薦文章
    鄄城县| 即墨市| 内江市| 巴彦淖尔市| 通道| 洪洞县| 金溪县| 莱西市| 延寿县| 闵行区| 手游| 扎囊县| 威远县| 平潭县| 鄂伦春自治旗| 巴东县| 二连浩特市| 大埔区| 凌云县| 象州县| 伊吾县| 大城县| 东莞市| 岫岩| 健康| 柏乡县| 张北县| 平顶山市| 隆子县| 永丰县| 偃师市| 徐州市| 凤凰县| 崇义县| 依兰县| 崇明县| 体育| 仙桃市| 大关县| 油尖旺区| 盱眙县|