采用XMLHTTP编写一个天气预报的程序

本人就职于一个本地门户网站，每天网站上的天气都得更新。久而久之感到相当麻烦，于是写了一个定时的新闻小偷，帖出来大家参考一下系统要求: 支持FSO, 服务器UDP　TCP/IP    没有屏蔽

下面是小偷的内容
FileName TianQi.asp
Write By Niaoked QQ408611119
www.acnow.net
<%
if hour(now)=9 and minute(now)<30 then
getCategories()
end if
Function getCategories()
on error resume next
Dim oxml(标准化越来越近了)HTTP As Object
Dim oCategories As Object
Dim BodyText
Dim Pos,Pos1
Set oxml(标准化越来越近了)HTTP = CreateObject("Microsoft.xml(标准化越来越近了)HTTP")
--- set the xml(标准化越来越近了)HTTP call and issue send (no parm as category
--- is included in URL
oxml(标准化越来越近了)HTTP.open "GET","http://weather.china.com.cn/travel_gntq.php?cityid=56196&cityname=绵阳",False  这个地方换成你自己的地址
oxml(标准化越来越近了)HTTP.send
--- load the response into the Categories data island
 BodyText=oxml(标准化越来越近了)HTTP.responsebody
 BodyText=BytesToBstr(BodyText,"gb2312")
 Pos=Instr(BodyText,"<body")
 pos1=Instr(BodyText,"</body>")
 BodyText=mid(BodyText,pos,pos1)
 BodyText=split(BodyText,"<table")
 Pos=Instr(BodyText(4),"<tr")
 pos1=Instr(BodyText(4),"</tr>")
 Body=mid(BodyText(4),pos,len(BodyText(4))-pos)
 body=split(body,"</table>")
body1=split(replace(replace(replace(body(0),"<br>",""),"</td>",""),"</tr>",""),"天气")
for i= 1 to ubound(body1)
body3=split(body1(i),"<td")
weather=weather & "document.write("""& i&"$" & "天气" & HTMLEncode(trim(body3(0))) & """);" & vbcrlf
next
weather=replace(weather,"1$","<FONT color=#ffffff>【今天】</FONT>")
weather=replace(weather,"2$","<FONT color=#ffffff>【明天】</FONT>")
weather=replace(weather,"3$","<FONT color=#ffffff>【后天】</FONT>")
 Set fs = CreateObject("Scripting.FileSystemObject")
  Set f = fs.CreateTextFile(request.ServerVariables("APPL_PHYSICAL_PATH")& "tq.js", True)
  f.write("document.write(绵阳天气预报:);" &vbcrlf &  replace(weather,"<BR>",""))
  f.close
  Set f = nothing
  Set fs = nothing
response.write "绵阳天气预报:"& weather
Set oxml(标准化越来越近了)HTTP = Nothing
if err.number<>0 then
response.write "出错了，错误描述："&err.description & "<br>错误来源"& err.source
response.End()
end if
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