加入收藏 | 设为首页 | 会员中心 | 我要投稿 济南站长网 (https://www.0531zz.com/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 站长学院 > PHP教程 > 正文

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

发布时间:2016-12-06 16:20:41 所属栏目:PHP教程 来源:站长网
导读:Asp 使用 Microsoft.XMLHTTP 抓取网页内容(没用乱码),并过滤需要的内容 示例源码: 复制代码 代码如下: lt;% Dim xmlUrl,http,strHTML,strBody xmlUrl = Request.QueryString("u") REM 异步读取XML源 Set http = server.CreateObject("Microsoft.XMLHTTP")
Asp 使用 Microsoft.XMLHTTP 抓取网页内容(没用乱码),并过滤需要的内容

示例源码:
复制代码 代码如下:
lt;%
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,"lt;div id=""Div_newsContentc"" class=""cnt""gt;","lt;/divgt;",0,0)
strBody =Replace(strBody,"(本文首发于","")
strBody =Replace(strBody,"财富动力网lt;/agt;,转载请注明出处。)","")
strBody =Replace(strBody,"本文首发于,转载请注明出处。)","")
strBody =Replace(strBody,"财富动力网lt;/agt;: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 Startlt;=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 Overlt;=0 Or Overlt;=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)
Set ra = New RegExp
ra.IgnoreCase = True
ra.Global = True
ra.Pattern = "lt;a[^gt;]+gt;(.+?)lt;/agt;"

RegRemoveHref = Replace(ra.replace(HTMLstr,"$1"),"href=""http://www.927953.com""","")
END Function
%gt;

效果图如下:nbsp;
nbsp;

(编辑:济南站长网)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    热点阅读