网站导航免费论文 原创论文 论文搜索 作业答案 网学软件 学术大家 资料中心 会员中心 问题解答 定作论文 论文素材 设计下载 最新论文 下载排行 论文上传 在线投稿 联系我们
返回网学首页
最新论文 推荐专题 热门论文 素材专题
当前位置: 网学 > 交易代码 > ASP精品代码 > 正文
用ASP+XMLHTTP编写一个天气预报程序
来源:Http://myeducs.cn 联系QQ:点击这里给我发消息 作者: 佚名 来源: 网络 发布时间: 10/11/04
  本人就职于一个本地门户网站,每天网站上的天气都得更新。久而久之感到相当麻烦,于是写了一个定时的新闻小偷,帖出来大家参考一下系统要求: 支持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, ">", ">")
   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
%>
  • 上一篇资讯: ASP中时间函数的使用
  • 网学推荐

    免费论文

    原创论文

    浏览:
    设为首页 | 加入收藏 | 论文首页 | 论文专题 | 设计下载 | 网学软件 | 论文模板 | 论文资源 | 程序设计 | 关于网学 | 站内搜索 | 网学留言 | 友情链接 | 资料中心
    版权所有 电话:013574892963 QQ:3710167 邮箱:Educs@163.com 网学网 [Myeducs.cn] 您电脑的分辨率是 像素
    Copyright 2008-2015 Www.myeducs.Cn All Rights Reserved
    湘ICP备09003080号