asp生成html microsoft.serverxmlhttp,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,"

","
",0,0)

strBody =Replace(strBody,"(本文首发于","")

strBody =Replace(strBody,"财富动力网,转载请注明出处。)","")

strBody =Replace(strBody,"本文首发于,转载请注明出处。)","")

strBody =Replace(strBody,"财富动力网: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)

Set ra = New RegExp

ra.IgnoreCase = True

ra.Global = True

ra.Pattern = "]+>(.+?)"

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

END Function

%>

效果图如下:

2e1e46610541adf2c90ea3db68d84748.gif

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值