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
%>

效果图如下:


  • 2
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

追夢秋陽

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值