asp+|xml| Program | Weather forecast |xml I work for a local portal, and the weather on the website is updated every day. Over time feel quite troublesome, so wrote a timed news thief, posted out everyone reference system requirements: Support FSO, server UDP TCP/IP is not shielded.
Here are the thieves ' contents:
FileName tianqi.asp
Write by niaoked 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 ' Change this place 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 (body (0), <br>, ""), "</td>", ""), "</tr>", ""), "weather")
For i= 1 To UBound (body1)
Body3=split (Body1 (i), "<TD")
Weather=weather & "document.write (" "& i&" $ "&" Weather "& HTMLEncode (Trim (body3 (0)) &" ""); "& V Bcrlf
Next
Weather=replace (Weather, "1$", "<font color= #ffffff" "Today" </FONT>)
Weather=replace (Weather, "2$", "<font color= #ffffff" "Tomorrow" </FONT>)
Weather=replace (Weather, "3$", "<font color= #ffffff" "The day after" </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
Response.Write "Error Description:" &err.description & "<br> Source of error" & 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 filter
fstring = Replace (fstring, CHR (13), "")
fstring = Replace (fstring, CHR (a) & CHR (a), "</P> <p>")
fstring = Replace (fstring, CHR (), "<BR>")
HTMLEncode = fstring
End If
End Function
%>
