<%
    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 included in URL
    oXMLHTTP.open "GET","http://weather.china.com.cn/travel_gntq.php?cityid=56196&cityname=绵阳",False  '这个地方换成你自己的地址
    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(replace(replace(body(0),"<br>",""),"</td>",""),"</tr>",""),"天气")
    for i= 1 to ubound(body1)
    body3=split(body1(i),"<td")
    weather=weather & "document.write("""& i&"$" & "天气" & HTMLEncode(trim(body3(0))) & """);" & vbcrlf
    next
    weather=replace(weather,"1$","<FONT color=#ffffff>【今天】</FONT>")
    weather=replace(weather,"2$","<FONT color=#ffffff>【明天】</FONT>")
    weather=replace(weather,"3$","<FONT color=#ffffff>【后天】</FONT>")
     Set fs = CreateObject("Scripting.FileSystemObject")
      Set f = fs.CreateTextFile(request.ServerVariables("APPL_PHYSICAL_PATH")& "tq.js", True)
      f.write("document.write('绵阳天气预报:');" &vbcrlf &  replace(weather,"<BR>",""))
      f.close
      Set f = nothing
      Set fs = nothing
    response.write "绵阳天气预报:"& weather
    Set oXMLHTTP = Nothing
    if err.number<>0 then
    response.write "出错了，错误描述："&err.description & "<br>错误来源"& 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;") '单引号过滤
       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
    %>