写了段批量抓取某个列表页的东东(2)


    '=========取文章分类及相关ID参数 结束=======================

    '=========取文章标题及内容 开始=============================
    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>来源:</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)
    '=========取文章标题及内容 结束=============================
    Response.Write(ArticleTitle& "<br /><br />")
    Response.Flush()
Next


附几个函数:

Function getHTTPPage(url)
    IF(IsObjInstalled("Microsoft.XMLHTTP") = False)THEN
        Response.Write "<br><br>服务器不支持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>获取文件内容出错"
        '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

内容版权声明:除非注明,否则皆为本站原创文章。

转载注明出处:http://www.heiqu.com/3519.html