| FileName TianQi.asp Write By Niaoked QQ408611119 www.knowsky.com ＜% 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('綿陽天氣預(yù)報:');" &vbcrlf & replace(weather,"＜BR＞","")) f.close Set f = nothing Set fs = nothing response.write "綿陽天氣預(yù)報:"& 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, "＞", ">") fString = replace(fString, "＜", "<") fString = Replace(fString, CHR(32), " ") ' fString = Replace(fString, CHR(9), " ") ' fString = Replace(fString, CHR(34), """) fString = Replace(fString, CHR(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 %＞ |
新聞熱點
疑難解答
