用ASP+XMLHTTP编写一个天气预报程序

2013 年 12 月 3 日3950

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

  下面是小偷的内容

  FileName TianQi.asp
  Write By Niaoked QQ408611119
  http://www.zjjv.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://http://www.zjjv.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

0 0