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)