ASP调用腾讯网天气预报 针对特定城市-%@LANGUAGE=VBSCRIPT CODEPAGE=65001% !DOCTYPE ht...

海南网站建设,网页设计
记忆工作中的点滴
首页>> Asp技术 >>ASP调用腾讯网天气预报 针对特定城市
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>海口天气预报</title>
</head>

<body>
<%Call weather()
Sub weather()
url="http://weather.news.qq.com/inc/07_dc303.htm"  '海口的天气
Call IsObjInstalled("Microsoft.XMLHTTP")
weatherStr= getHTTPPage(url)
if weatherStr="" then
response.write "抱歉,天气预报加载失败!"
else
set reg=new Regexp
reg.Multiline=True
reg.Global=false
reg.IgnoreCase=true
reg.Pattern="<td height=""57"" align=""center"" bgcolor=""#EEF3F8"">((.|\n)*?)</td></tr>"
Set matches = reg.execute(weatherStr)
For Each match1 in matches
weatherStr=match1.Value
Next
Set matches = Nothing
Set reg = Nothing
if InStr(weatherStr,"没有找到与")>0 then
response.write "抱歉,天气预报加载失败!"
Else
weatherStr=Replace(weatherStr,"<br>"," ")
%>
<font color="#CC0000" style="font-size: 9pt">今日天气:<%=weatherStr%></font>
<%
end if 
end if
End Sub
'// 采用 Microsoft.XMLHTTP 组件采集数据
Function getHTTPPage(url) 
'on error resume next 
dim http
set http=Server.createobject("Microsoft.XMLHTTP") 
Http.open "GET",url,false 
Http.send() 
if Http.readystate<>4 then
exit function 
end if 
getHTTPPage=bytes2BSTR(Http.responseBody) 
set http=nothing
if err.number<>0 then err.Clear 
End function
'// 采用 ADODB.Stream 处理采集到的数据,把二进制的文件转成文本字符
Function Bytes2bStr(vin)
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("ADODB.Stream")
BytesStream.Type = 2
BytesStream.Open
BytesStream.WriteText vin
BytesStream.Position = 0
BytesStream.Charset = "GB2312"
BytesStream.Position = 2
StringReturn =BytesStream.ReadText
BytesStream.close
Set BytesStream = Nothing
Bytes2bStr = StringReturn
End Function
'//检查组件,采用xmlhttp抓取网页还是AspHTTP
Function IsObjInstalled(strClassString)
' On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then
If AspHttpOpen=1 Then
IsObjInstalled = True
Response.write "系统不支持 XMLHTTP 组件"
'Response.write "当前组件 ASPHTTP"
response.end()
Else
IsObjInstalled = False
'Response.write "当前组件 XMLHTTP"
End If
Else
IsObjInstalled = False
'Response.write "当前组件 XMLHTTP"
End If
Set xTestObj = Nothing
Err = 0
End Function%>
</body>
</html>

以上为源码部份


×

感谢您的支持,我们会一直保持!

扫码支持
请土豪扫码随意打赏

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

打赏作者
版权所有,转载注意明处:不懂戀愛魚兒 » ASP调用腾讯网天气预报 针对特定城市
标签: asp 天气预报 腾讯网

发表评论

路人甲 表情
看不清楚?点图切换 Ctrl+Enter快速提交

网友评论(0)