VBS获取天气预报[BY Broly]

来源：互联网发布：万网中文域名注册编辑：程序博客网时间：2024/05/17 18:40

'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

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

0 0