From Sina to extract the weather in Shanghai VBS

The start is simple. Analyze the captured code and then deal with it.


' Files: Weather.vbs into Scheduled tasks, executed 8:30 every day, generating full
' File for home use
' Execution mode: cscript d:\ Shanghai National Accounting Institute website \ Internal Community \vbs\weather.vbs
'********************************************************************************************************
' Symantec scriptblocking authenticated File
' E9815bb2-5813-400b-9ed5-156350335de3

Const INCFILEPATH = "d:\ Shanghai National Accounting Institute website \ Internal Community \web\club\" ' contains the directory where the file is located, the last number is required
Const LOGFILE = "D:\club-job-log.txt" log file
Const Incweather = "Weather-report.asp" contains the directory where the file is located, and the last \ number is required
Dim fs
Dim f
On Error Resume Next

Set fs = CreateObject ("Scripting.FileSystemObject")
Dim wstr
Wstr=gethttppage ("http://sh.sina.com.cn/")
' Response.Write wstr

If InStr (Wstr, "0 Then
Wstr=mid (Wstr,instr (WSTR, " ") +len (" "))
Wstr=mid (Wstr,instr (wstr, <table width=160 border=0 cellspacing=0 cellpadding=0>))
Wstr=mid (Wstr,1,instr (WSTR, "</table>") +len ("</table>")
End If
Wstr=replace (Wstr, "<tr><td colspan=3 align=right><a href=http://weather.sina.com.cn/> other cities </a ><font color= #015B7B >>></font></td></tr> "" ")
Dim Pos1,pos2
Pos1=instr (WSTR, "<tr>")
Pos2=instr (Pos1,wstr, "</tr>")
Wstr=right (Wstr,len (WSTR)-pos2-4-4)
Wstr=replace (WSTR, "</table>", "")
Wstr=replace (WSTR, "width=35", "")
Wstr=replace (WSTR, "width=45", "")
Wstr=replace (WSTR, "width=60", "")
' Response.Write wstr
If Err.number=0 Then
Set f = fs. CreateTextFile (Incfilepath & Incweather,true)
F.write WSTR
Set F = Nothing
Else
WScript.Echo Err.Description
End If
Set fs = Nothing

Sub Writelog (MSG)
On Error Resume Next
Dim F
Set f = fs. OpenTextFile (Logfile,8,true)
F.writeline Now & "-" & MSG
F.close
End Sub

function gethttppage (URL)
On Error Resume Next
Dim http
Set Http=createobject ("MSXML2. XMLHTTP ")
Http.open "Get", Url,false
Http.send ()
If Http.readystate<>4 Then
Exit function
End If
Gethttppage=bytes2bstr (Http.responsebody)
Set http=nothing
If Err.number<>0 then err. Clear
End Function

Function Bytes2bstr (vIn)
Dim Strreturn
Dim I,thischarcode,nextcharcode
Strreturn = ""
For i = 1 to LenB (vIn)
Thischarcode = AscB (MidB (vin,i,1))
If Thischarcode < &h80 Then
Strreturn = Strreturn & Chr (Thischarcode)
Else
Nextcharcode = AscB (MidB (vin,i+1,1))
Strreturn = Strreturn & Chr (CLng (thischarcode) * &h100 + CInt (nextcharcode))
i = i + 1
End If
Next
Bytes2bstr = Strreturn
End Function


'***********************************************