Asp使用XMLHTTP方式上实现数据抓取!

 Function Getbody(Url)
  On Error Resume Next
  Set Retrieval = Createobject("Microsoft.Xmlhttp")
  With Retrieval
  .Open "Get", Url, False, "", ""
  .Send
  Getbody = .Responsebody
  End With
  Set Retrieval = Nothing
 End Function
 Function Bytestobstr(Body,Cset)
  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 = Cset
  Bytestobstr = Objstream.Readtext
  Objstream.Close
  Set Objstream = Nothing
 End Function

'==========================

'过滤HTML代码

'==========================

 function nohtml(str)
    dim re
 if str <> "" then
  Set re=new RegExp
  re.IgnoreCase =true
  re.Global=True
  re.Pattern="(/<.[^/<]*/>)"
  str=re.replace(str," ")
  re.Pattern="(/<//[^/<]*/>)"
  str=re.replace(str," ")
 end if
    nohtml=str
    set re=nothing
end function

 Html = Getbody("http://cgi.news.sina.com.cn/cgi-bin/figureWeather/search.cgi?city=重庆")
 Html = Bytestobstr(Html,"Gb2312")
 s0 = Instr(Html,"<!-- 城市天气 begin -->")
 s1 = InstrRev(Html,"<!-- 城市天气 end -->")
 Html = mid(Html,s0,s1-s0)
 Html = replace(Html,"<!-- 城市天气 begin -->","")
 Html = trim(replace(Html," ",""))
 s0 = instr(Html,"重庆")
 s1 = len(Html)-1
 Html = mid(Html,s0,s1-s0)
 Html = Trim(nohtml(Html))
 Html = replace(Html,chr(10),"")
 Html = replace(Html,chr(13),"")
 Html = trim(Html)

response.write(html)

评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值