一個例子：從新浪提取上海天氣的vbs

起始很簡單的。分析一下抓下來的代碼，然后處理一下就行了。


'文件：weather.vbs放入計劃任務，每天早上8:30執行，生成飽含
'文件供首頁使用
'執行方式：cscript D:\上海國家會計學院網站\內部社區\vbs\weather.vbs
'********************************************************************************************************
' Symantec ScriptBlocking Authenticated File
' E9815BB2-5813-400B-9ED5-156350335DE3

const incFilePath= "D:\上海國家會計學院網站\內部社區\web\club\"'包含文件所在目錄,最后的\號是必須的
const logfile= "d:\club-job-log.txt"'日志文件
const incWeather= "weather-report.asp"'包含文件所在目錄,最后的\號是必須的
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,"<img src=http://cfan.net.cn/info/images/sina_sh/new/sh24.gif width=172 height=17>")>0 then
wstr=mid(wstr,instr(wstr,"<img src=http://cfan.net.cn/info/images/sina_sh/new/sh24.gif width=172 height=17>")+len("<img src=http://cfan.net.cn/info/images/sina_sh/new/sh24.gif width=172 height=17>"))
wstr=mid(wstr,instr(wstr,"<table width=160 border=0 cellspacing=0 cellpadding=0>"))
wstr=mid(wstr,1,instr(wstr,"")+len(""))
 end if 
 wstr=replace(wstr,"<tr><td colspan=3 align=right><a href=http://weather.sina.com.cn/>其他城市</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,"","")
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


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