Function getbody (URL)
On Error resume next
Set retrieval = Createobject ("Microsoft. XMLHTTP ")
With Retrieval
. Open "get", URL, false ,"",""
. Send
Getbody =. responsebody
End
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
'================================
'Filter htmlCode
'================================
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 = Chongqing ")
Html = bytestobstr (HTML, "gb2312 ")
S0 = instr (HTML, "<! -- City weather begin --> ")
S1 = Limit Rev (HTML, "<! -- City weather end --> ")
Html = mid (HTML, S0, s1-s0)
Html = Replace (HTML, "<! -- City weather begin --> ","")
Html = trim (replace (HTML ,"",""))
S0 = instr (HTML, "Chongqing ")
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)