I work in a local portal and the weather on the website needs to be updated every day. Over time, I felt quite troublesome, so I wrote a timed news thief. I posted it and refer to the system requirements: Support FSO, server UDP TCP/IP is not blocked.
Here is the content of the thief:
| FileName TianQi.asp Write By Niaooked QQ408611119 www.knowsky.com ＜% if hour(now)=9 and minute(now)＜30 then getCategories() end if Function getCategories() on error resume next Dim oXMLHTTP ' As Object Dim oCategories ' As Object Dim BodyText Dim Pos,Pos1 Set oXMLHTTP = CreateObject(Microsoft.XMLHTTP) '--- set the XMLHTTP call and issue send (no parm as category '--- is included in URL oXMLHTTP.open GET,http://weather.china.com.cn/travel_gntq.php?cityid=56196&cityname=Mianyang,False 'This place is changed to your own address oXMLHTTP.send '--- load the response into the Categories data island BodyText=oXMLHTTP.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>,),weather) for i= 1 to ubund(body1) body3=split(body1(i),＜td) weather=weather & document.write(& i&$ & weather & HTMLEncode(trim(body3(0))) & ); & vbcrlf next weather=replace(weather,1$,＜FONT color=#ffffffff＞【Today】＜/FONT＞) weather=replace(weather,2$,＜FONT color=#ffffff＞【Tomorrow】＜/FONT＞) weather=replace(weather,3$,＜FONT color=#ffffffff＞【the day after day】＜/FONT＞) Set fs= CreateObject(Scripting.FileSystemObject) Set f = fs.CreateTextFile(request.ServerVariables(APPL_PHYSICAL_PATH)& tq.js, True) f.write(document.write('Mianyang weather forecast:'); &vbcrlf & replace(weather,＜BR>,)) f.close Set f = nothing Set fs = nothing response.write Mianyang weather forecast:& weather Set oXMLHTTP = Nothing if err.number＜＞0 then There was an error response.write, error description: &err.description & ＜br>Error source& 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 set objstream = nothing End Function Public Function HTMLEncode(fString) If Not IsNull(fString) Then fString = replace(fString, ＞, >) fString = replace(fString, ＜, <) fString = Replace(fString, CHR(32), ) ' fString = Replace(fString, CHR(9), ) ' fString = Replace(fString, CHR(34), ") fString = Replace(fString, CHR(39), ') 'Single quote filtering fString = Replace(fString, CHR(13), ) fString = Replace(fString, CHR(10) & CHR(10), ＜/P>＜P> ) fString = Replace(fString, CHR(10), ＜BR＞ ) HTMLEncode = fString End If End Function %＞ |