从网站上获取需要的数据实例(天气预报)

//定义

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