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

来源:岁月联盟 编辑:zhuzhu 时间:2003-07-11
起始很简单的。分析一下抓下来的代码,然后处理一下就行了。


'文件: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=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    


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