您所在位置：主题：另一个获取天气信息的代码
一江秋水
[专家分：9680] 发布于 2021-12-12 15:27:15
另一个获取天气信息的代码
这个代码原本是作为回复发在笔者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.生活指数，有：穿衣指数、紫外线强度、护肤指数、洗车指数、感冒指数、晾晒指数、户外指数、污染
指数、钓鱼指数、中暑指数、舒适度、赏月指数。
需要注意的是，这些项目名称有的是英文，有的是汉语拼音，有的甚至是汉语拼音缩写。至于如何
从这些字符中取出有用信息、还要添加一些什么控件来显示信息，就由你自己去设计了。