盗墓笔记全集,盗墓笔记全集,完美世界辰东

主頁(yè) > 知識(shí)庫(kù) > 寫(xiě)了段批量抓取某個(gè)列表頁(yè)的東東

寫(xiě)了段批量抓取某個(gè)列表頁(yè)的東東

有些人當(dāng)抓取程序是個(gè)寶，到目前還TND有人在賣(mài)錢(qián)，強(qiáng)烈BS一下這些家伙真是的！可能偶下邊這段東西比較爛哈
下邊這個(gè)沒(méi)有寫(xiě)入庫(kù)功能，已經(jīng)到這一步了，入庫(kù)功能是很簡(jiǎn)單的事了，需要的請(qǐng)自己去完成吧，其它功能各位自行完善吧！把代碼拷貝過(guò)去直接運(yùn)行即可看到效果

Dim Url,List_PageCode,Array_ArticleID,i,ArticleID
Dim Content_PageCode,Content_TempCode
Dim Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Dim ArticleTitle,ArticleAuthor,ArticleFrom,ArticleContent

Url = "http://www.webasp.net/article/class/1.htm"
List_PageCode = getHTTPPage(Url)
List_PageCode = RegExpText(List_PageCode,"打印/th>/tr>","/table>table border=0 cellpadding=5",0)
List_PageCode = RegExpText(List_PageCode,"td align=left>a href='../","'>img border=0 src='../images/authortype0.gif'",1) '取得當(dāng)前列表頁(yè)的文章鏈接，以,分隔
Array_ArticleID = Split(List_PageCode,",") '創(chuàng)建數(shù)組，存儲(chǔ)文章ID

For i=0 To Ubound(Array_ArticleID)-1
    ArticleID = Array_ArticleID(i)    '文章ID
    Content_PageCode = getHTTPPage("http://www.webasp.net/article/"ArticleID)    '取得文章頁(yè)的內(nèi)容

    '=========取文章分類(lèi)及相關(guān)ID參數(shù) 開(kāi)始=======================
    Content_TempCode = RegExpText(Content_PageCode,"a href=""/article/"">技術(shù)教程/a> gt;gt; ","gt;gt; 內(nèi)容/td>",0)
    Content_CategoryID = RegExpText(Content_PageCode,"a href='../class","/'>",1)
    BorderID = Split(Content_CategoryID,",")(0)    '大類(lèi)ID
    ClassID = Split(Content_CategoryID,",")(1)    '子類(lèi)ID
        '==========檢查大類(lèi)是否存在開(kāi)始===============
        '如果不存在則入庫(kù)

        '==========檢查大類(lèi)是否存在結(jié)束===============
    'Response.Write(BorderID "," ClassID "br />")
    Content_CategoryName = RegExpText(Content_PageCode,"/'>","/a>",1)
    BorderName = Split(Content_CategoryName,",")(0)    '大類(lèi)名稱(chēng)
    ClassName = Split(Content_CategoryName,",")(1)    '子類(lèi)名稱(chēng)
        '==========檢查子類(lèi)是否存在開(kāi)始===============
        '如果不存在則入庫(kù)

        '==========檢查子類(lèi)是否存在結(jié)束===============
    '=========取文章分類(lèi)及相關(guān)ID參數(shù) 結(jié)束=======================

    '=========取文章標(biāo)題及內(nèi)容開(kāi)始=============================
    ArticleTitle = RegExpText(Content_PageCode,"tr>td align=center bgcolor=#DEE2F5>strong>","/strong>/td>/tr>",0)
    ArticleAuthor = RegExpText(Content_PageCode,"tr>td>span class=blue>作者：/span>","/td>/tr>",0)
    ArticleFrom = RegExpText(Content_PageCode,"tr>td>span class=blue>來(lái)源：/span>","/td>/tr>",0)
    ArticleContent = RegExpText(Content_PageCode,"tr>td class=content style=""WORD-WRAP: break-word"" id=zoom>","/td>/tr>"VBCrlf"        /table>"VBCrlf"    /td>/tr>/table>",0)
    '=========取文章標(biāo)題及內(nèi)容結(jié)束=============================
    Response.Write(ArticleTitle "br />br />")
    Response.Flush()
Next

附幾個(gè)函數(shù)：

Function getHTTPPage(url)
    IF(IsObjInstalled("Microsoft.XMLHTTP") = False)THEN
        Response.Write "br>br>服務(wù)器不支持Microsoft.XMLHTTP組件"
        Err.Clear
        Response.End
    END IF
    On Error Resume Next
    Dim http
    SET http=Server.CreateObject("Msxml2.XMLHTTP")
    Http.open "GET",url,False
    Http.send()
    IF(Http.readystate>4)THEN
        Exit Function
    END IF
    getHTTPPage=BytesToBSTR(Http.responseBody,"GB2312")
    SET http=NOTHING
    IF(Err.number>0)THEN
        Response.Write "br>br>獲取文件內(nèi)容出錯(cuò)"
        'Response.End
        Err.Clear
    END IF
End Function

Function BytesToBstr(CodeBody,CodeSet)
    Dim objStream
    SET objStream = Server.CreateObject("adodb.stream")
    objStream.Type = 1
    objStream.Mode =3
    objStream.Open
    objStream.Write CodeBody
    objStream.Position = 0
    objStream.Type = 2
    objStream.Charset = CodeSet
    BytesToBstr = objStream.ReadText
    objStream.Close
    SET objStream = NOTHING
End Function

'================================================
'作用：檢查組件是否已經(jīng)安裝
'返回值：True ----已經(jīng)安裝
'        False ----沒(méi)有安裝
'================================================
Function IsObjInstalled(objName)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim testObj
    SET testObj = Server.CreateObject(objName)
    IF(0 = Err)THEN IsObjInstalled = True
    SET testObj = NOTHING
    Err = 0
End Function

Function RegExpText(strng,strStart,strEnd,n)
    Dim regEx,Match,Matches,RetStr
    SET regEx = New RegExp
    regEx.Pattern = strStart"([\s\S]*?)"strEnd
    regEx.IgnoreCase = True
    regEx.Global = True
    SET Matches = regEx.Execute(strng)
    For Each Match in Matches
        IF(n=1)THEN
            RetStr = RetStr regEx.Replace(Match.Value,"$1") ","
        ELSE
            RetStr = RetStr regEx.Replace(Match.Value,"$1")
        END IF
    Next
    RegExpText = RetStr
    SET regEx=NOTHING
End Function

標(biāo)簽：臺(tái)灣懷化成都公主嶺內(nèi)江重慶天津麗江

巨人網(wǎng)絡(luò)通訊聲明：本文標(biāo)題《寫(xiě)了段批量抓取某個(gè)列表頁(yè)的東東》，本文關(guān)鍵詞寫(xiě)了,段批量,段,批量,抓取,；如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問(wèn)題，煩請(qǐng)?zhí)峁┫嚓P(guān)信息告之我們，我們將及時(shí)溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò)，涉及言論、版權(quán)與本站無(wú)關(guān)。

濮阳杆衣贸易有限公司

寫(xiě)了段批量抓取某個(gè)列表頁(yè)的東東