I work on a local portal website. The weather on the website is updated every day. Over time, I felt quite troublesome. So I wrote a regular news thief and posted it for your reference.
System Requirements:
FSO supported
The server UDP TCP/IP is not blocked.
The contents of the thief are as follows:
Filename Tianqi. asp
Write by niaoked qq408611119
<%
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 encoded in URL
Oxmlhttp. Open "get", "http://weather.china.com.cn/travel_gntq.php? Cityid = 56196 & cityname = Mianyang ", false' replace this address with 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 (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) & ""); "& vbcrlf
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> [day after tomorrow] </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, 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, ">", "& gt ;")
Fstring = Replace (fstring, "<", "& lt ;")
Fstring = Replace (fstring, CHR (32), "") '& nbsp;
Fstring = Replace (fstring, CHR (9), "") '& nbsp;
Fstring = Replace (fstring, CHR (34), "& quot ;")
Fstring = Replace (fstring, CHR (39), "& #39;") 'single quotation mark 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
%>