<p>　　本人就职于一个本地门户网站，每天网站上的天气都得更新。久而久之感到相当麻烦，于是写了一个定时的新闻小偷，帖出来大家参考一下系统要求: 支持FSO, 服务器UDP　TCP/IP 没有屏蔽。</p><p>　　下面是小偷的内容：</p><p>　　<code>FileName TianQi.asp<br />Write By Niaoked QQ408611119<br />www.knowsky.com<br />＜%<br />　if hour(now)=9 and minute(now)＜30 then<br />　　getCategories()<br />　end if<br />　Function getCategories()<br />　　on error resume next<br />　　Dim oXMLHTTP ' As Object<br />　　Dim oCategories ' As Object<br />　　Dim BodyText<br />　　Dim Pos,Pos1<br />　　Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")<br />　　'--- set the XMLHTTP call and issue send (no parm as category<br />　　'--- is included in URL<br />　　oXMLHTTP.open "GET","http://weather.china.com.cn/travel_gntq.php?cityid=56196&cityname=绵阳",False '这个地方换成你自己的地址<br />　　oXMLHTTP.send<br />　　'--- load the response into the Categories data island<br />　　BodyText=oXMLHTTP.responsebody<br />　　BodyText=BytesToBstr(BodyText,"gb2312")<br />　　Pos=Instr(BodyText,"＜body")<br />　　pos1=Instr(BodyText,"＜/body＞")<br />　　BodyText=mid(BodyText,pos,pos1)<br />　　BodyText=split(BodyText,"＜table")<br />　　Pos=Instr(BodyText(4),"＜tr")<br />　　pos1=Instr(BodyText(4),"＜/tr＞")<br />　　Body=mid(BodyText(4),pos,len(BodyText(4))-pos)<br />　　body=split(body,"＜/table＞")<br />　　body1=split(replace(replace(replace(body(0),"＜br＞",""),"＜/td＞",""),"＜/tr＞",""),"天气")<br />　　for i= 1 to ubound(body1)<br />　　　body3=split(body1(i),"＜td")<br />　　　weather=weather & "document.write("""& i&"$" & "天气" & HTMLEncode(trim(body3(0))) & """);" & vbcrlf<br />　　next<br />　　weather=replace(weather,"1$","＜FONT color=#ffffff＞【今天】＜/FONT＞")<br />　　weather=replace(weather,"2$","＜FONT color=#ffffff＞【明天】＜/FONT＞")<br />　　weather=replace(weather,"3$","＜FONT color=#ffffff＞【后天】＜/FONT＞")<br />　　Set fs = CreateObject("Scripting.FileSystemObject")<br />　　Set f = fs.CreateTextFile(request.ServerVariables("APPL_PHYSICAL_PATH")& "tq.js", True)<br />　　f.write("document.write('绵阳天气预报:');" &vbcrlf & replace(weather,"＜BR＞",""))<br />　　f.close<br />　　Set f = nothing<br />　　Set fs = nothing<br />　　response.write "绵阳天气预报:"& weather<br />　　Set oXMLHTTP = Nothing<br />　　if err.number＜＞0 then<br />　　　response.write "出错了，错误描述："&err.description & "＜br＞错误来源"& err.source<br />　　　response.End()<br />　　end if<br />　End Function<br />　Function BytesToBstr(body,Cset)<br />　　dim objstream<br />　　set objstream = Server.CreateObject("adodb.stream")<br />　　objstream.Type = 1<br />　　objstream.Mode =3<br />　　objstream.Open<br />　　objstream.Write body<br />　　objstream.Position = 0<br />　　objstream.Type = 2<br />　　objstream.Charset = Cset<br />　　BytesToBstr = objstream.ReadText<br />　　objstream.Close<br />　　set objstream = nothing<br />　End Function<br />　Public Function HTMLEncode(fString)<br />　　If Not IsNull(fString) Then<br />　　　fString = replace(fString, "＞", ">")<br />　　　fString = replace(fString, "＜", "<")<br />　　　fString = Replace(fString, CHR(32), " ") '&#160;<br />　　　fString = Replace(fString, CHR(9), " ") '&#160;<br />　　　fString = Replace(fString, CHR(34), """)<br />　　　fString = Replace(fString, CHR(39), "'") '单引号过滤<br />　　　fString = Replace(fString, CHR(13), "")<br />　　　fString = Replace(fString, CHR(10) & CHR(10), "＜/P＞＜P＞ ")<br />　　　fString = Replace(fString, CHR(10), "＜BR＞ ")<br />　　　HTMLEncode = fString<br />　　End If<br />　End Function<br />%＞</code></p>