asp实现天气预报的抓取
![](https://www.cnblogs.com/Images/OutliningIndicators/ContractedBlock.gif)
![](https://www.cnblogs.com/Images/OutliningIndicators/ExpandedBlockStart.gif)
<%
'On Error Resume Next
'作者:无情 来源: 转载请保留出处
Response.ContentType="text/html; charset=gb2312"
url="http://weather.news.qq.com/inc/07_ss255.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=""77"" class=""wht2 lk37"">((.|\n)*?)</td>"
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,"<td height=""77"" class=""wht2 lk37"">","")
weatherStr=Replace(weatherStr,"<div class=""txbd"">","")
weatherStr=Replace(weatherStr,"</div>"," ")
weatherStr=Replace(weatherStr,"</td>","")
response.write "杭州天气预报:"&weatherStr&""
end if
end if
'// 采用 Microsoft.XMLHTTP 组件采集数据
Function getHTTPPage(url)
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)
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.end()
Else
IsObjInstalled = False
'Response.write "当前组件 XMLHTTP"
End If
Else
IsObjInstalled = False
'Response.write "当前组件 XMLHTTP"
End If
Set xTestObj = Nothing
Err = 0
End Function
%>