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

2008-02-23 09:29:38来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

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

下面是小偷的内容
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('绵阳天气预报:');" &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
%>

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:提高ASP执行权限的问题

下一篇:人文的ASP开发基础入门之简介