• Asp 使用 Microsoft.XMLHTTP 抓取网页内容无乱码处理,并过滤须要的内容


    Asp 使用 Microsoft.XMLHTTP 抓取网页内容。并过滤须要的内容

    Asp 使用 Microsoft.XMLHTTP 抓取网页内容无乱码处理,并过滤须要的内容

    演示样例源代码:

    <%
     Dim xmlUrl,http,strHTML,strBody
     xmlUrl = Request.QueryString("u")
    
     REM 异步读取XML源
     Set http = server.CreateObject("Microsoft.XMLHTTP") 
     http.Open "POST",xmlUrl,false
     http.setrequestheader "User-Agent", "Mozilla/4.0"
     http.setrequestheader "Connection", "Keep-Alive"
     http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
     http.Send()
    
     strHTML = BytesToBstr(http.ResponseBody)
     set http = nothing
    
     REM 抓取主要内容
     strBody = GetBody(strHTML,"<div id=""Div_newsContentc"" class=""cnt"">","</div>",0,0)
     strBody =Replace(strBody,"(本文首发于","")
     strBody =Replace(strBody,"財富动力网</a>。转载请注明出处。)","")
     strBody =Replace(strBody,"本文首发于,转载请注明出处。

    )","") strBody =Replace(strBody,"財富动力网</a>:http://www.927953.com","") strBody =Replace(strBody,"本文首发于","") Response.Write RegRemoveHref(strBody) REM 获取相应网址响应的HTML Function BytesToBstr(body) dim objstream set objstream = Server.CreateObject("adodb.stream") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = "UTF-8" '转换原来默认的UTF-8编码转换成GB2312编码。否则直接用 'XMLHTTP调用有中文字符的网页得到的将是乱码 BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function REM 使用正則表達式。抓取标签之内的的内容 Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR) If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then GetBody="$False$" Exit Function End If Dim ConStrTemp Dim Start,Over ConStrTemp=Lcase(ConStr) StartStr=Lcase(StartStr) OverStr=Lcase(OverStr) Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare) If Start<=0 then GetBody="$False$" Exit Function Else If IncluL=False Then Start=Start+LenB(StartStr) End If End If Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare) If Over<=0 Or Over<=Start then GetBody="$False$" Exit Function Else If IncluR=True Then Over=Over+LenB(OverStr) End If End If GetBody=MidB(ConStr,Start,Over-Start) End Function REM 过滤a超链接 Function RegRemoveHref(HTMLstr) Dim ClsTempLoseStr,regEx ClsTempLoseStr = Cstr(HTMLstr) Set regEx = New RegExp regEx.Pattern = "<(/){0,1}a[^<>]*>" regEx.IgnoreCase = True regEx.Global = True ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"") RegRemoveHref = ClsTempLoseStr Set regEx = Nothing End Function %>


    效果图例如以下:


  • 相关阅读:
    egrep及扩展正则
    grep命令及正则
    Linux管道及I/O重定向
    权限及权限管理
    Linux-用户管理
    Linux用户及权限
    文件名通配
    bash特性-命令历史命令行编辑
    USACO 2014 US Open Decorating The Pastures
    USACO 2014 US Open Odometer /// 枚举
  • 原文地址:https://www.cnblogs.com/zhchoutai/p/8283861.html
Copyright © 2020-2023  润新知