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

來源:互聯網
上載者:User
asp+|xml|程式|天氣預報|xml     本人就職於一個本地門戶網站,每天網站上的天氣都得更新。久而久之感到相當麻煩,於是寫了一個定時的新聞小偷,帖出來大家參考一下系統要求: 支援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
%>



相關文章

Beyond APAC's No.1 Cloud

19.6% IaaS Market Share in Asia Pacific - Gartner IT Service report, 2018

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。