//定義
Option Explicit
Private Type Weather
strAdd As String
strDate As String
strPicPath As String
strWeather As String
strWind As String
strSM(10) As String
End Type
Public Weatherday(2) As Weather
//*******************************************************************
//窗體
Option Explicit
Dim strHTML As String
Public StaFlag As Byte
Private Sub Combo1_Click()
Combo2.Clear
'北京
If Combo1.Text = "北京市" Then
Combo2.AddItem "北京"
End If
'天津
If Combo1.Text = "天津市" Then
Combo2.AddItem "天津"
End If
'山西省
If Combo1.Text = "山西省" Then
Combo2.AddItem "太原"
Combo2.AddItem "大同"
Combo2.AddItem "陽泉"
Combo2.AddItem "晉城"
Combo2.AddItem "朔州"
Combo2.AddItem "忻州"
Combo2.AddItem "離石"
Combo2.AddItem "榆次"
Combo2.AddItem "臨汾"
Combo2.AddItem "運城"
Combo2.AddItem "長治"
End If
'河北省
If Combo1.Text = "河北省" Then
Combo2.AddItem "石家莊"
Combo2.AddItem "唐山"
Combo2.AddItem "秦皇島"
Combo2.AddItem "張家口"
Combo2.AddItem "承德"
Combo2.AddItem "廊坊"
Combo2.AddItem "邯鄲"
Combo2.AddItem "邢台"
Combo2.AddItem "保定"
Combo2.AddItem "滄州"
Combo2.AddItem "衡水"
End If
'內蒙古自治區
If Combo1.Text = "內蒙古自治區" Then
Combo2.AddItem "呼和浩特"
Combo2.AddItem "包頭"
Combo2.AddItem "烏海"
Combo2.AddItem "集寧"
Combo2.AddItem "巴彥浩特"
Combo2.AddItem "臨河"
Combo2.AddItem "鄂爾多斯"
Combo2.AddItem "赤峰"
Combo2.AddItem "通遼"
Combo2.AddItem "錫林浩特"
Combo2.AddItem "海拉爾"
Combo2.AddItem "烏蘭浩特"
End If
'遼寧省
If Combo1.Text = "遼寧省" Then
Combo2.AddItem "沈陽"
Combo2.AddItem "大連"
Combo2.AddItem "鞍山"
Combo2.AddItem "撫順"
Combo2.AddItem "本溪"
Combo2.AddItem "錦州"
Combo2.AddItem "營口"
Combo2.AddItem "阜新"
Combo2.AddItem "盤錦"
Combo2.AddItem "鐵嶺"
Combo2.AddItem "朝陽"
Combo2.AddItem "葫蘆島"
Combo2.AddItem "丹東"
Combo2.AddItem "遼陽"
End If
'吉林省
If Combo1.Text = "吉林省" Then
Combo2.AddItem "長春"
Combo2.AddItem "吉林"
Combo2.AddItem "四平"
Combo2.AddItem "遼源"
Combo2.AddItem "松原"
Combo2.AddItem "白城"
Combo2.AddItem "延邊"
Combo2.AddItem "通化"
End If
'黑龍江省
If Combo1.Text = "黑龍江省" Then
Combo2.AddItem "哈爾濱"
Combo2.AddItem "雞西"
Combo2.AddItem "鶴崗"
Combo2.AddItem "雙鴨山"
Combo2.AddItem "伊春"
Combo2.AddItem "佳木斯"
Combo2.AddItem "七台河"
Combo2.AddItem "牡丹江"
Combo2.AddItem "綏化"
Combo2.AddItem "齊齊哈爾"
Combo2.AddItem "大慶"
Combo2.AddItem "黑河"
Combo2.AddItem "大興安嶺"
End If
'上海市
If Combo1.Text = "上海市" Then
Combo2.AddItem "上海"
End If
'江蘇省
If Combo1.Text = "江蘇省" Then
Combo2.AddItem "南京"
Combo2.AddItem "無錫"
Combo2.AddItem "徐州"
Combo2.AddItem "常州"
Combo2.AddItem "蘇州"
Combo2.AddItem "南通"
Combo2.AddItem "連雲港"
Combo2.AddItem "淮陰"
Combo2.AddItem "鹽城"
Combo2.AddItem "揚州"
Combo2.AddItem "鎮江"
Combo2.AddItem "泰州"
Combo2.AddItem "宿遷"
End If
'浙江省
If Combo1.Text = "浙江省" Then
Combo2.AddItem "杭州"
Combo2.AddItem "寧波"
Combo2.AddItem "溫州"
Combo2.AddItem "嘉興"
Combo2.AddItem "湖州"
Combo2.AddItem "紹興"
Combo2.AddItem "金華"
Combo2.AddItem "衢州"
Combo2.AddItem "舟山"
Combo2.AddItem "麗水"
Combo2.AddItem "台州"
End If
'安徽省
If Combo1.Text = "安徽省" Then
Combo2.AddItem "合肥"
Combo2.AddItem "蕪湖"
Combo2.AddItem "蚌埠"
Combo2.AddItem "淮南"
Combo2.AddItem "馬鞍山"
Combo2.AddItem "淮北"
Combo2.AddItem "銅陵"
Combo2.AddItem "安慶"
Combo2.AddItem "黃山市"
Combo2.AddItem "阜陽"
Combo2.AddItem "宿州"
Combo2.AddItem "滁州"
Combo2.AddItem "六安"
Combo2.AddItem "宣城"
Combo2.AddItem "巢湖"
Combo2.AddItem "池州"
End If
'福建省
If Combo1.Text = "福建省" Then
Combo2.AddItem "福州"
Combo2.AddItem "廈門"
Combo2.AddItem "莆田"
Combo2.AddItem "三明"
Combo2.AddItem "泉州"
Combo2.AddItem "漳州"
Combo2.AddItem "南平"
Combo2.AddItem "寧德"
Combo2.AddItem "龍巖"
Combo2.AddItem "隴南"
Combo2.AddItem "慶陽"
End If
'江西省
If Combo1.Text = "江西省" Then
Combo2.AddItem "南昌"
Combo2.AddItem "景德鎮"
Combo2.AddItem "贛州"
Combo2.AddItem "萍鄉"
Combo2.AddItem "九江"
Combo2.AddItem "新余"
Combo2.AddItem "鷹潭"
Combo2.AddItem "宜春"
Combo2.AddItem "上饒"
Combo2.AddItem "吉安"
End If
'山東省
If Combo1.Text = "山東省" Then
Combo2.AddItem "濟南"
Combo2.AddItem "青島"
Combo2.AddItem "淄博"
Combo2.AddItem "棗莊"
Combo2.AddItem "東營"
Combo2.AddItem "煙台"
Combo2.AddItem "濰坊"
Combo2.AddItem "濟寧"
Combo2.AddItem "泰安"
Combo2.AddItem "威海"
Combo2.AddItem "日照"
Combo2.AddItem "濱州"
Combo2.AddItem "德州"
Combo2.AddItem "聊城"
Combo2.AddItem "臨沂"
Combo2.AddItem "菏澤"
Combo2.AddItem "萊蕪"
End If
'河南
If Combo1.Text = "河南省" Then
Combo2.AddItem "鄭州"
Combo2.AddItem "開封"
Combo2.AddItem "洛陽"
Combo2.AddItem "平頂山"
Combo2.AddItem "安陽"
Combo2.AddItem "鶴壁"
Combo2.AddItem "新鄉"
Combo2.AddItem "焦作"
Combo2.AddItem "濮陽"
Combo2.AddItem "許昌"
Combo2.AddItem "漯河"
Combo2.AddItem "三門峽"
Combo2.AddItem "商丘"
Combo2.AddItem "周口"
Combo2.AddItem "駐馬店"
Combo2.AddItem "南陽"
Combo2.AddItem "信陽"
End If
'湖北省
If Combo1.Text = "湖北省" Then
Combo2.AddItem "武漢"
Combo2.AddItem "黃石"
Combo2.AddItem "十堰"
Combo2.AddItem "隨州"
Combo2.AddItem "宜昌"
Combo2.AddItem "襄樊"
Combo2.AddItem "鄂州"
Combo2.AddItem "荊門"
Combo2.AddItem "黃岡"
Combo2.AddItem "孝感"
Combo2.AddItem "鹹寧"
Combo2.AddItem "荊州"
Combo2.AddItem "恩施"
End If
'湖南省
If Combo1.Text = "湖南省" Then
Combo2.AddItem "長沙"
Combo2.AddItem "衡陽"
Combo2.AddItem "邵陽"
Combo2.AddItem "郴州"
Combo2.AddItem "永州"
Combo2.AddItem "韶山"
Combo2.AddItem "張家界"
Combo2.AddItem "懷化"
Combo2.AddItem "吉首"
Combo2.AddItem "株洲"
Combo2.AddItem "湘潭"
Combo2.AddItem "岳陽"
Combo2.AddItem "常德"
Combo2.AddItem "益陽"
Combo2.AddItem "婁底"
End If
'廣東省
If Combo1.Text = "廣東省" Then
Combo2.AddItem "廣州"
Combo2.AddItem "深圳"
Combo2.AddItem "汕尾"
Combo2.AddItem "惠州"
Combo2.AddItem "河源"
Combo2.AddItem "佛山"
Combo2.AddItem "清遠"
Combo2.AddItem "東莞"
Combo2.AddItem "珠海"
Combo2.AddItem "江門"
Combo2.AddItem "肇慶"
Combo2.AddItem "中山"
Combo2.AddItem "湛江"
Combo2.AddItem "茂名"
Combo2.AddItem "韶關"
Combo2.AddItem "汕頭"
Combo2.AddItem "梅州"
Combo2.AddItem "陽江"
Combo2.AddItem "潮州"
Combo2.AddItem "順德"
Combo2.AddItem "揭陽"
Combo2.AddItem "雲浮"
End If
'廣西壯族自治區
If Combo1.Text = "廣西壯族自治區" Then
Combo2.AddItem "南寧"
Combo2.AddItem "梧州"
Combo2.AddItem "玉林"
Combo2.AddItem "桂林"
Combo2.AddItem "百色"
Combo2.AddItem "河池"
Combo2.AddItem "欽州"
Combo2.AddItem "柳州"
Combo2.AddItem "北海"
Combo2.AddItem "防城港"
Combo2.AddItem "貴港"
Combo2.AddItem "賀州"
End If
'海南省
If Combo1.Text = "海南省" Then
Combo2.AddItem "海口"
Combo2.AddItem "三亞"
Combo2.AddItem "西沙群島"
End If
'四川省
If Combo1.Text = "四川省" Then
Combo2.AddItem "成都"
Combo2.AddItem "眉山"
Combo2.AddItem "雅安"
Combo2.AddItem "峨嵋山"
Combo2.AddItem "自貢"
Combo2.AddItem "南充"
Combo2.AddItem "泸州"
Combo2.AddItem "德陽"
Combo2.AddItem "綿陽"
Combo2.AddItem "遂寧"
Combo2.AddItem "內江"
Combo2.AddItem "樂山"
Combo2.AddItem "宜賓"
Combo2.AddItem "廣元"
Combo2.AddItem "達州"
Combo2.AddItem "資陽"
Combo2.AddItem "攀枝花"
Combo2.AddItem "阿壩"
Combo2.AddItem "甘孜"
Combo2.AddItem "涼山"
Combo2.AddItem "廣安"
Combo2.AddItem "巴中"
End If
'重慶市
If Combo1.Text = "重慶市" Then
Combo2.AddItem "重慶"
Combo2.AddItem "萬州"
Combo2.AddItem "涪陵"
Combo2.AddItem "黔江"
End If
'貴州省
If Combo1.Text = "貴州省" Then
Combo2.AddItem "貴陽"
Combo2.AddItem "六盤水"
Combo2.AddItem "銅仁"
Combo2.AddItem "安順"
Combo2.AddItem "凱裡"
Combo2.AddItem "都勻"
Combo2.AddItem "興義"
Combo2.AddItem "畢節"
Combo2.AddItem "遵義"
End If
'雲南省
If Combo1.Text = "雲南省" Then
Combo2.AddItem "昆明"
Combo2.AddItem "德宏"
Combo2.AddItem "曲靖"
Combo2.AddItem "楚雄"
Combo2.AddItem "玉溪"
Combo2.AddItem "紅河"
Combo2.AddItem "文山"
Combo2.AddItem "思茅"
Combo2.AddItem "昭通"
Combo2.AddItem "西雙版納"
Combo2.AddItem "大理"
Combo2.AddItem "保山"
Combo2.AddItem "怒江"
Combo2.AddItem "麗江"
Combo2.AddItem "迪慶"
Combo2.AddItem "臨滄"
End If
'西藏自治區
If Combo1.Text = "西藏自治區" Then
Combo2.AddItem "拉薩"
Combo2.AddItem "昌都"
Combo2.AddItem "山南"
Combo2.AddItem "日喀則"
Combo2.AddItem "那曲"
Combo2.AddItem "阿裡"
Combo2.AddItem "林芝"
End If
'陝西省
If Combo1.Text = "陝西省" Then
Combo2.AddItem "西安"
Combo2.AddItem "銅川"
Combo2.AddItem "寶雞"
Combo2.AddItem "鹹陽"
Combo2.AddItem "渭南"
Combo2.AddItem "漢中"
Combo2.AddItem "安康"
Combo2.AddItem "商洛"
Combo2.AddItem "延安"
Combo2.AddItem "榆林"
End If
'甘肅省
If Combo1.Text = "甘肅省" Then
Combo2.AddItem "蘭州"
Combo2.AddItem "白銀"
Combo2.AddItem "金昌"
Combo2.AddItem "天水"
Combo2.AddItem "張掖"
Combo2.AddItem "武威"
Combo2.AddItem "定西"
Combo2.AddItem "平涼"
Combo2.AddItem "臨夏"
Combo2.AddItem "嘉峪關"
Combo2.AddItem "酒泉"
End If
'青海省
If Combo1.Text = "青海省" Then
Combo2.AddItem "西寧"
Combo2.AddItem "果洛"
Combo2.AddItem "海西"
Combo2.AddItem "格爾木"
Combo2.AddItem "海東"
Combo2.AddItem "海北"
Combo2.AddItem "玉樹"
Combo2.AddItem "黃南"
End If
'寧夏回族自治區
If Combo1.Text = "寧夏回族自治區" Then
Combo2.AddItem "銀川"
Combo2.AddItem "石嘴山"
Combo2.AddItem "吳忠"
Combo2.AddItem "固原"
End If
'新疆維吾爾自治區
If Combo1.Text = "新疆維吾爾自治區" Then
Combo2.AddItem "烏魯木齊"
Combo2.AddItem "克拉瑪依"
Combo2.AddItem "吐魯番"
Combo2.AddItem "哈密"
Combo2.AddItem "昌吉"
Combo2.AddItem "博樂"
Combo2.AddItem "庫爾勒"
Combo2.AddItem "阿克蘇"
Combo2.AddItem "克州"
Combo2.AddItem "喀什"
Combo2.AddItem "伊犁"
Combo2.AddItem "石河子"
Combo2.AddItem "塔城"
Combo2.AddItem "阿勒泰"
Combo2.AddItem "和田"
End If
'台灣省
If Combo1.Text = "台灣省" Then
Combo2.AddItem "台北"
End If
'澳門特別行政區
If Combo1.Text = "澳門特別行政區" Then
Combo2.AddItem "澳門"
End If
'香港特別行政區
If Combo1.Text = "香港特別行政區" Then
Combo2.AddItem "香港"
End If
Combo2.ListIndex = 0
End Sub
Private Sub Command1_Click()
If Combo2.Text = "" Then
MsgBox "請選擇城市!", vbOKOnly + 64, "提示"
Else
strHTML = ""
tital.Caption = Combo2.Text & "天氣"
StaFlag = 0
Call WebBrowser1.Navigate("http://php.weather.sina.com.cn/search.php?city=" & Combo2.Text)
Label1.Caption = "請 稍 後 ．．．"
End If
End Sub
Private Sub Command2_Click()
Call DisPlayData(StaFlag)
End Sub
Private Sub Form_Load()
Combo1.AddItem "北京市"
Combo1.AddItem "天津市"
Combo1.AddItem "重慶市"
Combo1.AddItem "河北省"
Combo1.AddItem "山西省"
Combo1.AddItem "內蒙古自治區"
Combo1.AddItem "遼寧省"
Combo1.AddItem "吉林省"
Combo1.AddItem "黑龍江省"
Combo1.AddItem "上海市"
Combo1.AddItem "江蘇省"
Combo1.AddItem "浙江省"
Combo1.AddItem "安徽省"
Combo1.AddItem "福建省"
Combo1.AddItem "江西省"
Combo1.AddItem "山東省"
Combo1.AddItem "河南省"
Combo1.AddItem "湖北省"
Combo1.AddItem "湖南省"
Combo1.AddItem "廣東省"
Combo1.AddItem "廣西壯族自治區"
Combo1.AddItem "海南省"
Combo1.AddItem "四川省"
Combo1.AddItem "貴州省"
Combo1.AddItem "雲南省"
Combo1.AddItem "西藏自治區"
Combo1.AddItem "陝西省"
Combo1.AddItem "甘肅省"
Combo1.AddItem "青海省"
Combo1.AddItem "寧夏回族自治區"
Combo1.AddItem "新疆維吾爾自治區"
Combo1.AddItem "台灣省"
Combo1.AddItem "香港特別行政區"
Combo1.AddItem "澳門特別行政區"
Combo1.ListIndex = 0
End Sub
Private Sub WebBrowser1_DownloadComplete()
Dim i As Long
Dim j As Long
Dim k As Long
Dim intTemp As Integer
On Error Resume Next
If Len(strHTML) = 0 Then
'Get data
strHTML = WebBrowser1.Document.documentElement.innerHTML
If Len(strHTML) <> 0 Then
For j = 0 To 2
i = InStr(strHTML, "<DIV class=City_Data>")
strHTML = Mid$(strHTML, i)
Weatherday(j).strAdd = GetData("<H3>", "</H3>", strHTML)
Weatherday(j).strDate = GetData("<P>", "</P>", strHTML)
Weatherday(j).strPicPath = GetData("src=" & Chr$(34), Chr$(34) & "></DIV>", strHTML)
Weatherday(j).strWeather = GetData("Weather_TP>", "</DIV>", strHTML)
Weatherday(j).strWind = GetData("Weather_W>", "</DIV>", strHTML)
i = InStr(strHTML, "<DIV class=Weather_SM")
strHTML = Mid$(strHTML, i)
intTemp = IIf(j = 0, 9, 5)
For k = 0 To intTemp
Weatherday(j).strSM(k) = GetData("<P>", "</P>", strHTML)
Next
Next
'Display Data
Call DisPlayData(StaFlag)
Label1.Caption = "下載完成 "
End If
End If
Exit Sub
err1:
End Sub
Public Sub DisPlayData(index As Byte)
On Error GoTo ToExit '打開錯誤陷阱
'------------------------------------------------
Dim i As Integer
Frame1(0).Caption = Replace$(Weatherday(index).strAdd, " ", " ")
todayTime(0).Caption = Replace$(Weatherday(index).strDate, " ", " ")
TodayTP(0).Caption = Replace$(Weatherday(index).strWeather, " ", " ")
TodayTP(1).Caption = Replace$(Weatherday(index).strWind, " ", "")
For i = 0 To 9
TodayTP(i + 2).Caption = vbNullString
TodayTP(i + 2).Caption = Mid$(Replace$(Weatherday(index).strSM(i), "</SPAN>", ""), 7)
Next
Call DownBinData(Weatherday(index).strPicPath)
DoEvents
Image1.Picture = LoadPicture(App.Path & "\imag.gif")
index = index + 1
If index >= 3 Then index = 0
'------------------------------------------------
Exit Sub
'----------------
ToExit:
End Sub
Public Function GetData(StartFlag As String, EndFlag As String, strSource As String) As String
Dim lngStart As Long
Dim lngEnd As Long
Dim strTemp As String
lngStart = InStr(1, strSource, StartFlag)
lngEnd = InStr(lngStart, strSource, EndFlag)
strTemp = Mid(strSource, lngStart + Len(StartFlag), lngEnd - lngStart - Len(StartFlag))
strSource = Mid(strSource, lngEnd + Len(EndFlag))
GetData = strTemp
End Function
'下載二進制內容
'*******************************************************************************************
'FunctionName: DownBinData
'Description :DownLoad BinaryData
'Return : Boolean
'parameter : sURL:WEB Adress
'*******************************************************************************************
Private Function DownBinData(ByVal sURL As String) As Boolean
On Error GoTo ExitHead
Dim m_vBinData() As Byte
m_vBinData() = Inet1.OpenURL(sURL, icByteArray)
EntryBegin:
DoEvents
If UBound(m_vBinData) <> 0 Then
DoEvents
End If
If Inet1.StillExecuting Then
DoEvents
GoTo EntryBegin:
End If
DownBinData = True
If Dir(App.Path & "\imag.gif") <> "" Then
Kill App.Path & "\imag.gif"
End If
Open App.Path & "\imag.gif" For Binary As #1
Put #1, 1, m_vBinData
Close #1
Exit Function
ExitHead:
DownBinData = False
'將錯誤輸出到日志中
' If Err <> 0 Then
' SaveErrMsg Err, Me, "DownBinData"
' End If
End Function
