回 帖 发 新 帖 刷新版面

主题:另一个获取天气信息的代码

另一个获取天气信息的代码


    这个代码原本是作为回复发在笔者12月2日《获取天气信息的代码》的后面,但今天一看,居然莫名其妙地消失了,是外星人的恶作剧还是版主干的好事?那么笔者干脆另发新贴了。


12月2日的贴中,那个天气API有3个不爽之处:1.免费用户有访问次数的限制,每天只能访问40次;2.不能利用循环语句自动获取多个城市的天气信息,只能点击按纽逐个地获取;3.只能获取3天的预报信息。
笔者另外找了个没有上述弊端的天气API,又编写了相应的代码。这个天气API可获取6天的天气信息,要求输入的是城市代码而不是城市名(程序运行时只要输入城市名即可,由程序自动查表转换为城市代码),城市代码为9位数,与上面源代码中的5位数城市代码不相同。
新建一个工程,在窗体上添加一个按纽,标题为“天气预报”,添加2个文本框,Text1用于输入城市名,Text2用于输出获取到的天气信息,应设置为可接收多行文本。源代码如下:


Option Explicit


Dim MyHTTP As Object, cityName As String


Private Sub Form_Load()
Dim st1 As String, st2 As String
Set MyHTTP = CreateObject("Microsoft.XMLHTTP")

st1 = "北京101010100朝阳101010300顺义101010400怀柔101010500通州101010600昌平101010700延庆101010800丰台101010900石景山101011000大兴101011100房山101011200密云101011300门头沟101011400平谷101011500八达岭101011600佛爷顶101011700汤河口101011800密云上甸子101011900斋堂101012000霞云岭101012100北京城区101012200海淀101010200" & vbCrLf & _
"天津101030100宝坻101030300东丽101030400西青101030500北辰101030600蓟县101031400汉沽101030800静海101030900津南101031000塘沽101031100大港101031200武清101030200宁河101030700" & vbCrLf & _
"上海101020100宝山101020300嘉定101020500南汇101020600浦东101021300青浦101020800松江101020900奉贤101021000崇明101021100徐家汇101021200闵行101020200金山101020700" & vbCrLf & _
"重庆101040100合川101040300南川101040400江津101040500万盛101040600渝北101040700北碚101040800巴南101040900长寿101041000黔江101041100万州天城101041200万州龙宝101041300涪陵101041400开县101041500城口101041600云阳101041700巫溪101041800奉节101041900巫山101042000潼南101042100垫江101042200梁平101042300忠县101042400石柱101042500大足101042600荣昌101042700铜梁101042800璧山101042900丰都101043000武隆101043100彭水101043200綦江101043300酉阳101043400秀山101043600沙坪坝101043700永川101040200" & vbCrLf & _
"哈尔滨101050101牡丹江101050301佳木斯101050401绥化101050501黑河101050601双鸭山101051301伊春101050801大庆101050901七台河101051002鸡西101051101鹤岗101051201齐齐哈尔101050201大兴安岭101050701" & vbCrLf & _
"长春101060101延吉101060301四平101060401白山101060901白城101060601辽源101060701松原101060801吉林101060201通化101060501" & vbCrLf & _
"沈阳101070101鞍山101070301抚顺101070401本溪101070501丹东101070601葫芦岛101071401营口101070801阜新101070901辽阳101071001铁岭101071101朝阳101071201盘锦101071301大连101070201锦州101070701" & vbCrLf & _
"呼和浩特101080101乌海101080301集宁101080401通辽101080501阿拉善左旗101081201鄂尔多斯101080701临河101080801锡林浩特101080901呼伦贝尔101081000乌兰浩特101081101包头101080201赤峰101080601" & vbCrLf & _
"乌鲁木齐101130101石河子101130301昌吉101130401吐鲁番101130501库尔勒101130601阿拉尔101130701阿克苏101130801喀什101130901伊宁101131001塔城101131101哈密101131201和田101131301阿勒泰101131401阿图什101131501博乐101131601克拉玛依101130201" & vbCrLf & _
"拉萨101140101山南101140301阿里101140701昌都101140501那曲101140601日喀则101140201林芝101140401" & vbCrLf & _
"石家庄101090101张家口101090301承德101090402唐山101090501秦皇岛101091101沧州101090701衡水101090801邢台101090901邯郸101091001保定101090201廊坊101090601" & vbCrLf & _
"郑州101180101新乡101180301许昌101180401平顶山101180501信阳101180601南阳101180701开封101180801洛阳101180901商丘101181001焦作101181101鹤壁101181201濮阳101181301周口101181401漯河101181501驻马店101181601三门峡101181701济源101181801安阳101180201" & vbCrLf & _
"济南101120101潍坊101120601临沂101120901菏泽101121001滨州101121101东营101121201威海101121301枣庄101121401日照101121501莱芜101121601聊城101121701青岛101120201淄博101120301德州101120401烟台101120501济宁101120701泰安101120801" & vbCrLf & _
"太原101100101临汾101100701运城101100801朔州101100901忻州101101001长治101100501大同101100201阳泉101100301晋中101100401晋城101100601吕梁101101100" & vbCrLf & _
"西安101110101延安101110300榆林101110401铜川101111001商洛101110601安康101110701汉中101110801宝鸡101110901咸阳101110200渭南101110501" & vbCrLf & _
"兰州101160101平凉101160301庆阳101160401武威101160501金昌101160601嘉峪关101161401酒泉101160801天水101160901武都101161001临夏101161101合作101161201白银101161301定西101160201张掖101160701"

st2 = "成都101270101自贡101270301绵阳101270401南充101270501达州101270601遂宁101270701广安101270801巴中101270901泸州101271001宜宾101271101内江101271201资阳101271301乐山101271401眉山101271501凉山101271601雅安101271701甘孜101271801阿坝101271901德阳101272001广元101272101攀枝花101270201" & vbCrLf & _
"银川101170101中卫101170501固原101170401石嘴山101170201吴忠101170301" & vbCrLf & _
"西宁101150101黄南101150301海北101150801果洛101150501玉树101150601海西101150701海东101150201海南101150401" & vbCrLf & _
"南京101190101镇江101190301苏州101190401南通101190501扬州101190601宿迁101191301徐州101190801淮安101190901连云港101191001常州101191101泰州101191201无锡101190201盐城101190701" & vbCrLf & _
"合肥101220101芜湖101220301淮南101220401马鞍山101220501安庆101220601宿州101220701阜阳101220801亳州101220901黄山101221001滁州101221101淮北101221201铜陵101221301宣城101221401六安101221501巢湖101221601池州101221701蚌埠101220201" & vbCrLf & _
"杭州101210101舟山101211101湖州101210201嘉兴101210301金华101210901绍兴101210501台州101210601温州101210701丽水101210801衢州101211001宁波101210401" & vbCrLf & _
"福州101230101泉州101230501漳州101230601龙岩101230701晋江101230509南平101230901厦门101230201宁德101230301莆田101230401三明101230801" & vbCrLf & _
"南昌101240101上饶101240301抚州101240401宜春101240501鹰潭101241101赣州101240701景德镇101240801萍乡101240901新余101241001九江101240201吉安101240601" & vbCrLf & _
"武汉101200101黄冈101200501荆州101200801宜昌101200901恩施101201001十堰101201101神农架101201201随州101201301荆门101201401天门101201501仙桃101201601潜江101201701襄樊101200201鄂州101200301孝感101200401黄石101200601咸宁101200701" & vbCrLf & _
"长沙101250101株洲101250301衡阳101250401郴州101250501常德101250601益阳101250700娄底101250801邵阳101250901岳阳101251001张家界101251101怀化101251201黔阳101251301永州101251401吉首101251501湘潭101250201" & vbCrLf & _
"广州101280101惠州101280301梅州101280401汕头101280501深圳101280601珠海101280701佛山101280800肇庆101280901湛江101281001江门101281101河源101281201清远101281301云浮101281401潮州101281501东莞101281601中山101281701阳江101281801揭阳101281901茂名101282001汕尾101282101韶关101280201" & vbCrLf & _
"南宁101300101柳州101300301来宾101300401桂林101300501梧州101300601防城港101301401贵港101300801玉林101300901百色101301001钦州101301101河池101301201北海101301301崇左101300201贺州101300701" & vbCrLf & _
"贵阳101260101安顺101260301都匀101260401兴义101260906铜仁101260601毕节101260701六盘水101260801遵义101260201凯里101260501" & vbCrLf & _
"昆明101290101红河101290301文山101290601玉溪101290701楚雄101290801普洱101290901昭通101291001临沧101291101怒江101291201香格里拉101291301丽江101291401德宏101291501景洪101291601大理101290201曲靖101290401保山101290501" & vbCrLf & _
"海口101310101三亚101310201东方101310202临高101310203澄迈101310204儋州101310205昌江101310206白沙101310207琼中101310208定安101310209屯昌101310210琼海101310211文昌101310212保亭101310214万宁101310215陵水101310216西沙101310217南沙岛101310220乐东101310221五指山101310222琼山101310102" & vbCrLf & _
"台北101340101高雄101340201台中101340401"

cityName = st1 & st2
End Sub


Private Sub Command1_Click()
Dim st As String, k As Integer
st = Text1
k = InStr(cityName, st)
If k Then
  Text2 = weather(Mid(cityName, k + Len(st), 9))
Else
  MsgBox "很遗憾,没有找到对应的城市代码"
End If
End Sub


Private Function weather(cistID As String) As String
With MyHTTP
  .open "POST", "http://wthrcdn.etouch.cn/WeatherApi?citykey=" & cistID, False
  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  .send
  weather = .responseText

End With

End Function


Private Sub Form_Unload(Cancel As Integer)
Set MyHTTP = Nothing
End Sub


运行之后,获取的信息比较繁杂,其项目结构大致为:
1.数据更新时的天气状况,项目依次为:温度、风力、湿度、风向、日出时分、日落时分。
2.昨天的天气状况,项目依次为:高温、低温、白天的天气类型和风向风力、夜晚的天气类型和风向风力。
3.今天的天气状况,项目同上。
4.明天的天气状况,项目同上。
5.第三天的天气状况,项目同上。
6.第四天的天气状况,项目同上。
7.第五天的天气状况,项目同上。
8.生活指数,有:穿衣指数、紫外线强度、护肤指数、洗车指数、感冒指数、晾晒指数、户外指数、污染
指数、钓鱼指数、中暑指数、舒适度、赏月指数。


需要注意的是,这些项目名称有的是英文,有的是汉语拼音,有的甚至是汉语拼音缩写。至于如何
从这些字符中取出有用信息、还要添加一些什么控件来显示信息,就由你自己去设计了。

回复列表 (共2个回复)

沙发

下面的代码在桌面显示文字,由于窗体透明看不见,所以更换城市时,要点击文字的笔划,才会弹出对话框,连同城市名和城市代码一起输入。

Option Explicit


Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long


Dim city As String, cityID As String


Private Sub Form_Load()
On Error Resume Next
city = GetSetting("王牌天气预报", "所在城市", "城市代码") '从注册表中取出城市名和代码
If Len(city) < 11 Then city = "北京101010100" '北京
cityID = Right(city, 9)
city = Left(city, Len(city) - 9)
SetWindowLong hWnd, -20, &H80000
SetLayeredWindowAttributes hWnd, Me.BackColor, 0, 1 '将窗体设为透明
End Sub


Private Sub Form_Activate()
weather
End Sub


Private Sub weather()
Dim st As String, z(3) As String, i As Integer, j As Integer, L As Long
Dim MyHTTP As Object
Set MyHTTP = CreateObject("Microsoft.XMLHTTP")

With MyHTTP
  .Open "POST", "http://wthrcdn.etouch.cn/WeatherApi?citykey=" & cityID, False
  .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  .send
  st = .responseText
End With

i = InStr(st, "污染指数") + 18: j = InStr(i, st, "</value>") - i
z(3) = Mid(st, i, j)
i = InStr(st, "<weather>") + 15: j = InStr(i, st, "</weather>") - i
st = Mid(st, i, j)
i = InStr(st, "<day>") + 11: j = InStr(i, st, "</type>") - i
z(0) = city & ":" & Mid(st, i, j) '天气类型
i = InStr(st, "低温") + 3: j = InStr(i, st, "</low>") - i
z(1) = Mid(st, i, j) & "/" '最低温度
i = InStr(st, "高温") + 3: j = InStr(i, st, "</high>") - i
z(1) = z(1) & Mid(st, i, j) '最高温度
i = InStr(st, "<fengxiang>") + 11: j = InStr(i, st, "</fengxiang>") - i
z(2) = Mid(st, i, j) '风向
i = InStr(st, "[CDATA[") + 7: j = InStr(i, st, "]]>") - i
z(2) = z(2) & Mid(st, i, j) '风力
st = Join(z, " ")

Set MyHTTP = Nothing
L = TextWidth(st)
Me.Move (Screen.Width - L) \ 2, 900, L, TextHeight(st) + 90
Cls
Print st
End Sub


Private Sub Form_Click()
Dim st As String
st = InputBox("请输入城市名称和9位数的城市代码:", "输入城市名称和代码")
If Len(st) < 11 Then MsgBox "城市名称和代码无效": Exit Sub
cityID = Right(st, 9)
city = Left(st, Len(st) - 9)
SaveSetting "王牌天气预报", "所在城市", "城市代码", st '将城市名和代码保存到注册表
weather
End Sub


Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then Unload Me

End Sub

板凳

设置窗体的BorderStyle=0

我来回复

您尚未登录,请登录后再回复。点此登录或注册