采用XMLHTTP编写一个天气预报的程序

2018-09-06 12:46

阅读:488

  本人就职于一个本地门户网站,每天网站上的天气都得更新。久而久之感到相当麻烦,于是写了一个定时的新闻小偷,帖出来大家参考一下系统要求: 支持FSO, 服务器UDPTCP/IP 没有屏蔽

  下面是小偷的内容
FileName TianQi.asp
Write By Niaoked QQ408611119

<%
if hour(now)=9 and minute(now)<30 then
getCategories()
end if
Function getCategories()
on error resume next
Dim oxml(标准化越来越近了)HTTP As Object
Dim oCategories As Object
Dim BodyText
Dim Pos,Pos1
Set oxml(标准化越来越近了)HTTP = CreateObject(Microsoft.xml(标准化越来越近了)HTTP)
--- set the xml(标准化越来越近了)HTTP call and issue send (no parm as category
--- is included in URL
oxml(标准化越来越近了)HTTP.open GET,绵阳,False 这个地方换成你自己的地址
oxml(标准化越来越近了)HTTP.send
--- load the response into the Categories data island
BodyText=oxml(标准化越来越近了)HTTP.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 oxml(标准化越来越近了)HTTP = 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


评论


亲,登录后才可以留言!