VBS获取天气预报[BY Broly]

'VBS获取天气预报 @CODE BY Broly
'我的博客:http://blog.sina.com.cn/brolyblog
'部分代码参考网络
Dim re,colMa
Dim url,txt
url="http://weather.news.qq.com/inc/07_dc292.htm"
txt=getHTTPPage(url)
Set re=New RegExp
re.Global=True
re.IgnoreCase=True
re.Pattern="[u4e00-u9fa5]+
"
Set colMa=re.Execute(txt)
city=Left(colMa.Item(0),Len(colMa.Item(0))-9)
title="天气预报 v1.0  BY Broly"
re.Pattern="([u4e00-u9fa5]+)
(.*)"
content="城市:"&city&Space(8)&"今天是"&Date&vbCrLf&vbCrLf
content=content & "天气:" & re.Replace(re.Execute(txt).Item(0),"$1") & vbCrLf
content=content & "温度:" & re.Replace(re.Execute(txt).Item(0),"$2") & vbCrLf
re.Pattern="[u4e00-u9fa5]+:([u4e00-u9fa5]+)"
content=content & "风力:" & re.Replace(re.Execute(txt).Item(0),"$1")
MsgBox content,vbokonly,title
WScript.Quit

Function getHTTPPage(url)
Dim Http
Set Http=CreateObject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
If Http.readystate<>4 then
Exit Function
End If
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
Set http=nothing
If err.number<>0 then err.Clear
End Function
Function BytesToBstr(body,Cset)
Dim objstream
Set objstream =CreateObject("adodb.stream")
With objstream
  .Type = 1
  .Mode = 3
  .Open
  .Write body
  .Position = 0
  .Type = 2
  .Charset = Cset
  BytesToBstr = .ReadText
  .Close
End with
Set objstream = nothing
End Function


网站不可用,返回信息已转换成图片格式,无法解析图片信息!

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值