您的位置:首页网页设计ASP实例 → 采用XMLHTTP编写一个天气预报的程序

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

时间:2004/11/7 3:04:00来源:本站整理作者:蓝点我要评论(0)

本人就职于一个本地门户网站,每天网站上的天气都得更新。久而久之感到相当麻烦,于是写了一个定时的新闻小偷,帖出来大家参考一下系统要求: 支持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," pos1=Instr(BodyText,"")
 BodyText=mid(BodyText,pos,pos1)
 BodyText=split(BodyText," Pos=Instr(BodyText(4)," pos1=Instr(BodyText(4),"")
 Body=mid(BodyText(4),pos,len(BodyText(4))-pos)
 body=split(body,"")
body1=split(replace(replace(replace(body(0),"
",""),"",""),"",""),"天气")
for i= 1 to ubound(body1)
body3=split(body1(i),"weather=weather & "document.write("""& i&"$" & "天气" & HTMLEncode(trim(body3(0))) & """);" & vbcrlf
next
weather=replace(weather,"1$","【今天】")
weather=replace(weather,"2$","【明天】")
weather=replace(weather,"3$","【后天】")
 Set fs = CreateObject("Scripting.FileSystemObject")
  Set f = fs.CreateTextFile(request.ServerVariables("APPL_PHYSICAL_PATH")& "tq.js", True)
  f.write("document.write('绵阳天气预报:');" &vbcrlf &  replace(weather,"
",""))
  f.close
  Set f = nothing
  Set fs = nothing
response.write "绵阳天气预报:"& weather
Set oXMLHTTP = Nothing
if err.number<>0 then
response.write "出错了,错误描述:"&err.description & "
错误来源"& 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), "

")
   fString = Replace(fString, CHR(10), "
")
   HTMLEncode = fString
  End If
 End Function
%>


相关阅读 Windows错误代码大全 Windows错误代码查询激活windows有什么用Mac QQ和Windows QQ聊天记录怎么合并 Mac QQ和Windows QQ聊天记录Windows 10自动更新怎么关闭 如何关闭Windows 10自动更新windows 10 rs4快速预览版17017下载错误问题Win10秋季创意者更新16291更新了什么 win10 16291更新内容windows10秋季创意者更新时间 windows10秋季创意者更新内容kb3150513补丁更新了什么 Windows 10补丁kb3150513是什么

文章评论
发表评论

热门文章 没有查询到任何记录。

最新文章 迅雷新手完全入门手册 asp下面javascript上传图片限制格式大小方法告诉大家网页弹出窗口应用总结ASP常见错误类型大全asp常见错误分析和解决办法

人气排行 总是弹出visual studio 实时调试器 三种解决SQLSERVER存储过程及调用详解Asp获取真实IP地址ASP中连接Mssql的几种方法一个简单好用的UBB编辑器(含代码)如何用Split将字符串转换为数组并获取数组下ASP防止表单重复提交的办法告诉你免费的简单聊天室源代码