用ASP+XMLHTTP編寫一個天氣預報程序

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('綿陽天氣預報:'); &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, ＞, >)

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

%＞