一个例子：从新浪提取上海天气的vbs

March 25,2004

起始很简单的。分析一下抓下来的代码，然后处理一下就行了。

'文件：weather.vbs  放入计划任务，每天早上8:30执行，生成饱含
'文件供首页使用
'执行方式：cscript D:上海国家会计学院网站内部社区vbsweather.vbs
'********************************************************************************************************
' Symantec ScriptBlocking Authenticated File
' E9815BB2-5813-400B-9ED5-156350335DE3

const incFilePath          = "D:上海国家会计学院网站内部社区webclub"       '包含文件所在目录,最后的号是必须的
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=images/sina_sh/new/sh24.gif width=172 height=17>")>0 then
      wstr=mid(wstr,instr(wstr,"<img src=images/sina_sh/new/sh24.gif width=172 height=17>")+len("<img src=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,"</table>")+len("</table>"))
   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,"</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

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