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)

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章