一个完整的雅虎天气应用，是的，又一个
使用 Farhad Siasar 的 YahooWeathertlb 库并添加了一些附加功能。
天气桌面
天气桌面启动画面
引言
这是一个完整的天气应用程序，包含 2 天和 5 天的预报。它显示本地天气和 4 张地图（雷达、红外卫星、热指数和风寒指数）。该应用程序具有面板动画（感谢 Fredrik Bornander），模仿了 CloneDVD2 的滑动帧，我还使用 WindowsAPICodePack 添加了一些任务栏按钮。我在 Debug 文件夹中添加了一个名为 "states" 的文件夹。在此文件夹中是包含所有城市、城镇、村庄和乡镇的 50 个州的文本文件。我还添加了一个邮政编码和 woeID 文件。WoeID 是 "Where on Earth ID" 的缩写。WoeID 下拉框与邮政编码下拉框同步。我添加这些是为了让您不必去雅虎搜索以查找您的 WoeID。WoeID 仅用于检索 5 天预报。我使用水平条样式来显示温度、风速和风向，使用了 Steve Low 的 "NextUI 库"。还添加了一个启动画面，因为天气应用程序需要一段时间才能启动。还有一个 Daffy Duck 光标，我在所有应用程序中都大量使用它。
此天气应用程序使用了 Farhad Siasar 的 YahooWeathertlb 的重写版本，现在称为 "pWeatherLib.dll"。由于设计方式的原因，该库比原始版本稍大一些。
面板动画
我必须想出一个解决方案来移动面板（从左到右和从右到左），所以我问了 VB 论坛上的一个问题，Fredrik Bornander 提供了一个非常好的解决方案。我不得不更改他的一些代码以适用于此应用程序，但总的来说，这仍然是他的想法。谢谢 Fredrik。
要开始动画，我首先在窗体上添加了 5 个面板。我将其中 4 个放置在屏幕外，以便它们不可见。我将它们按顺序放置（向前和向后滚动）。要进行滚动，首先必须将面板添加到列表中，设置面板的位置，然后使用定时器和几个按钮点击事件。在下面的 4 个代码块中是动画的子程序。
Private Sub frmWeatherDesktop_Load_
(sender As Object, e As System.EventArgs) Handles Me.Load
'Panel Animation setup
panels.Add(pnlLocalWeather)
pnlLocalWeather.Location = New Point(0, 0)
panels.Add(pnlTwoDayForecast)
pnlTwoDayForecast.Location = New Point(816, 0)
panels.Add(pnlFiveDayForecast)
pnlFiveDayForecast.Location = New Point(1632, 0)
panels.Add(pnlMaps)
pnlMaps.Location = New Point(2448, 0)
panels.Add(pnlAbout)
pnlAbout.Location = New Point(3264, 0)
For Each panel As Panel In panels
Controls.Add(panel)
Next
animationTimer.Interval = 50
animationTimer.Start()
'...more code follows.
End Sub
面板大小为 814x561。如上面的代码所示，我通过在面板的 x 坐标上加 2 来使面板之间相隔 2 像素。接下来，我们将它们添加到 Controls 数组中，然后设置并启动定时器。
Private Sub animationTimer_Tick_
(sender As Object, e As System.EventArgs) Handles animationTimer.Tick
If panels(currentIndex).Location.X <> 0 Then
Dim delta As Integer = panels(currentIndex).Location.X / 5.0
For Each panel As Panel In panels
panel.Location = New Point(panel.Location.X - delta, panel.Location.Y)
Next
End If
End Sub
使用 "上一页" 和 "下一页" 按钮滚动时，我们检查 currentIndex 以查看我们在哪里。如果我们处于开头并按下 "上一页按钮"，我们不希望出现运行时错误，因此我们只是优雅地退出子程序，对于 "下一页按钮" 如果我们处于最后一个面板，我们也做同样的事情，优雅地退出。
Private Sub btnPrevious_Click(sender As Object, e As System.EventArgs) _
Handles btnPrevious.Click
If currentIndex = 0 Then
Exit Sub
Else
currentIndex = Math.Max(0, currentIndex - 1)
End If
End Sub
Private Sub btnNext_Click(sender As Object, e As System.EventArgs) Handles btnNext.Click
If currentIndex = 4 Then
Exit Sub
Else
currentIndex = Math.Min(panels.Count - 1, currentIndex + 1)
End If
End Sub
启动应用程序
当应用程序首次启动时，有一个启动画面作为介绍，显示一张卡通天气图片以及版本号和它在主窗体显示之前所做的事情。在我们等待的同时，它正在构建仪表盘，将邮政编码和 WoeID 加载到它们各自的组合框中。要使邮政编码组合框和 WoeID 组合框同步，我们只需将 WoeID 组合框的选定索引设置为等于邮政编码组合框的选定索引，在邮政编码组合框的 SelectedIndexChanged 事件中。
Private Sub cmbZip_SelectedIndexChanged(sender As Object, e As System.EventArgs) _
Handles cmbZip.SelectedIndexChanged
cmbWoeID.SelectedIndex = cmbZip.SelectedIndex
End Sub
搜索组合框或抓狂
由于加载到组合框中的数据量非常大，我们需要为组合框添加自动完成功能。要做到这一点，您必须将组合框的 DropDownStyle 属性设置为 "DropDown"。这将允许您在组合框中键入。然后将 AutoCompleteMode 设置为 "Suggest"，将 AutoCompleteSource 设置为 "CustomSource"，仅此而已。要填充自定义源，我们只需在用数据填充组合框时填充它们。代码如下。
Private Sub OpentextFile(ByVal fname As String)
Dim fs As FileStream
Dim sr As StreamReader
Dim strFile As String
Try
Dim strParts() As String
fs = New FileStream(fname, FileMode.Open, FileAccess.Read)
sr = New StreamReader(fs)
strFile = sr.ReadLine()
Do Until strFile Is Nothing
strParts = Split(strFile, ",")
cmbZip.Items.Add(strParts(0))
cmbZip.AutoCompleteCustomSource.Add(strParts(0))
cmbWoeID.Items.Add(strParts(1))
strFile = sr.ReadLine()
Loop
fs.Close()
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
我们对州组合框和城市组合框执行相同的操作。我们不需要处理 WoeID 组合框，因为它与邮政编码组合框同步。
GetCondition 函数接受一个 String 作为值并返回相同的 String。首先，我们必须从 pWeatherLib 库中获取 enum 代码，即 0 到 47 和 3200。0 代表 Tornado，我们必须为 0 和 1 使用相同的图片，然后每个数字都与图片编号匹配。下面是我用于此例程的代码。
Private Function GetCondition(ByVal strCondition As String) As String
'Code by RSPercy 07/10/09
Dim p As New pWeatherLib.pWeatherForecast(cmbZip.Text, temperatureUnit.Fahrenheit)
Select Case t.rss.channel.item.condition.codeEnum
Case 0
strCondition = "Tornado"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/1d.png"
Case 1
strCondition = "Tropical Storm"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/1d.png"
Case 2
strCondition = "Hurricane"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/2d.png"
Case 3
strCondition = "Severe Thunderstorms"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/3d.png"
Case 4
strCondition = "Thunderstorms"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/4d.png"
Case 5
strCondition = "Mixed Rain and Snow"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/5d.png"
Case 6
strCondition = "Mixed Rain and Sleet"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/6d.png"
Case 7
...
...
...
Case 46
strCondition = "Snow Showers" 'Night
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/46d.png"
Case 47
strCondition = "Isolated Thundershowers" 'Night
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/47d.png"
Case 3200
strCondition = "Not Available"
pb1.ImageLocation = "http://l.yimg.com/a/i/us/nws/weather/gr/44d.png"
End Select
Return strCondition
End Function
外面很热，还是我？
更新了 RetreiveHeatIndex 函数。它使用我们从雅虎天气 RSS Feed 中获取的空气温度 (AT) 和相对湿度 (RH)。此例程可在 Wikipedia 上找到。有一个简短的例程和一个长例程。我使用了长例程，因为它更精确。此例程在温度高于 80 度且湿度高于 40 度时效果最好。如果未满足这些条件，它将显示低于空气温度的热指数温度。因此，我添加了几条 If-Then-End If 语句来纠正这个问题。这是此代码：
Private Function RetrieveHeatIndex(ByVal h As Long) As String
'Code by RSPercy 03/25/2011
'This is the more advanced version
Dim p As New pWeatherLib.pWeatherForecast(cmbZip.Text, temperatureUnit.Fahrenheit)
Dim HEATINDEX As Long
'Heat Index Should be calculated only when air temperatures
'are greater than 80°F (27°C), dew point temperatures are
'greater than 60°F (16°C), and relative humidities are higher than 40%.
HEATINDEX = Math.Round(C1 + (C2 * AT) + (C3 * RH) - _
(C4 * AT * RH) + (C5 * (AT ^ 2)) + (C6 * (RH ^ 2)) + _
(C7 * (AT ^ 2) * RH) - (C8 * AT * (RH ^ 2)) + _
(C9 * (AT ^ 2) * (RH ^ 2)) - (C10 * (AT ^ 3)) + _
(C11 * (RH ^ 3)) + (C12 * (AT ^ 3) * RH) + _
(C13 * AT * (RH ^ 3)) - (C14 * (AT ^ 3) * (RH ^ 2)) + _
(C15 * (AT ^ 2) * (RH ^ 3)) - (C16 * (AT ^ 3) * (RH ^ 3)))
If (AT > 80) And (GetDewPoint(RH) > 60) And (RH > 40) Then
h = HEATINDEX
Else
h = AT
End If
'Wind Chill Should only be calculated when temperatures
'are at or below 50°F and wind speeds are above 3 MPH. Bright
'sunshine may increase the wind chill temperature by 10°F to 18°F.
If AT <= 50 And p.rss.channel.wind.speed > 3 Then
h = p.rss.channel.wind.chill
Else
h = AT
End If
Return h
End Function
更新了 btnGo_Click 事件。我不得不重新处理露点才能使其正常工作。现在它给出了正确的结果。GetDewPoint() 函数在此处被调用，并显示在 btnGo_Click() 事件下方。
Using the Code
Private Sub btnGo_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnGo.Click
'Code by RSPercy 03/25/2011
Try
Dim p As New pWeatherLib.pWeatherForecast_
(cmbZip.Text, temperatureUnit.Fahrenheit) 'p = all the goodies
'Fill the main form with weather data.
lblLatitude.Text = p.rss.channel.item.lat.ToString
lblLongitude.Text = p.rss.channel.item.long.ToString
lblLocation.Text = p.rss.channel.item.title 'Display the Title
lblHigh.Text = p.rss.channel.item.forecast.high & "°" 'High temperature
lblLow.Text = p.rss.channel.item.forecast.low & "°" 'Low temperature
newWindD = p.rss.channel.wind.direction
newWindS = p.rss.channel.wind.speed
If newWindS = 0 Then
lblWindVelocity.Text = "Wind Velocity is Calm."
End If
newTemp = p.rss.channel.item.condition.temp 'Current temperature
AT = newTemp 'A variable used in RetrieveHeatIndex
lblCondition.Text = GetCondition(strMyString) 'Current Weather Condition
lblHumidity.Text = p.rss.channel.atmosphere.humidity 'Humidity percentage
RH = CInt(lblHumidity.Text) 'A variable used in RetrieveHeatIndex
lblHeatIndexWindChill.Text = RetrieveHeatIndex(HI) & "°" 'Heat Index
lblSunrise.Text = p.rss.channel.astronomy.sunrise 'Sunrise
lblSunset.Text = p.rss.channel.astronomy.sunset 'Sunset
lblVisibility.Text = p.rss.channel.atmosphere.visibility & " mi." 'Visibility
If p.rss.channel.atmosphere.rising = 0 Then
lblPressure.Text = p.rss.channel.atmosphere.pressure & " " & _
"in'' and steady"
ElseIf p.rss.channel.atmosphere.rising = 1 Then
lblPressure.Text = p.rss.channel.atmosphere.pressure & " " & _
"in'' and rising"
ElseIf p.rss.channel.atmosphere.rising = 2 Then
lblPressure.Text = p.rss.channel.atmosphere.pressure & " " & _
"in'' and falling"
End If
lblDewPoint.Text = GetDewPoint(RH).ToString() & "°"
RetrieveZipCode() 'Gets the zip-code and displays the correct doppler maps
lblHumidity.Text += "%"
lblTemperature.Text = newTemp.ToString & "°"
lblTodaysDate.Text = FormatDateTime(Now.Date, DateFormat.ShortDate)
WDTimer.Enabled = True
WVTimer.Enabled = True
TMPTimer.Enabled = True
Me.Text = "Your Local Weather - " & p.rss.channel.title.ToString()
'MessageBox.Show(t.rss.channel.item.guid)
'Fill the 2-day forecast with data
Get2DayForecast()
'Do the same for the 5-day forecast.
GetFiveDayInfo()
'Display the About information.
GetAboutInfo()
Catch ex As System.NullReferenceException
MessageBox.Show("Please Enter a Valid Zip-Code.", "Info to the Rescue")
cmbZip.Focus()
Catch 'exs As IOException
MessageBox.Show("Please Try Again Later. Weather is Not Available.", _
"Info to the Rescue")
cmbZip.Focus()
End Try
End Sub
Private Function GetDewPoint(ByVal intRH As Integer) As Integer
'Code by RSPercy 03/25/2011
Dim dewpoint As Integer
Select Case intRH
Case 40 To 43
dewpoint = AT - 18
Case 44 To 46
dewpoint = AT - 17
Case 47 To 49
dewpoint = AT - 16
Case 50 To 52
dewpoint = AT - 15
Case 53 To 55
dewpoint = AT - 14
Case 56 To 59
dewpoint = AT - 13
Case 60 To 63
dewpoint = AT - 12
Case 64 To 66
dewpoint = AT - 11
Case 67 To 69
dewpoint = AT - 10
Case 70 To 72
dewpoint = AT - 9
Case 73 To 76
dewpoint = AT - 8
Case 77 To 79
dewpoint = AT - 7
Case 80 To 82
dewpoint = AT - 6
Case 83 To 85
dewpoint = AT - 5
Case 86 To 89
dewpoint = AT - 4
Case 90 To 93
dewpoint = AT - 3
Case 94 To 96
dewpoint = AT - 2
Case 97 To 99
dewpoint = AT - 1
Case 100
dewpoint = AT
Case Else
dewpoint = Math.Round(AT - ((100 - RH) / 5))
End Select
Return dewpoint
End Function
GetWind 函数已被删除，并被三个 CreateGauge 子程序取代。添加了 CreateTempGuage（代码如下）、CreateWindDirectionGuage 和 CreateWindSpeedGuage。仪表盘具有定时器动画以及 LED 显示。请参见上图。这是我的指南针代码：
指南针代码
Private Sub CreateTempGauge()
'Code by RSPercy 02/25/2010
Dim hfTemp As HorizontalFrame = New HorizontalFrame(New Rectangle(1, 1, 912, 50))
Me.BaseUI1.Frame.Add(hfTemp)
hfTemp.BackRenderer.CenterColor = Color.DarkRed
hfTemp.BackRenderer.EndColor = Color.Black
Dim bar1 As New HorizontalScaleBar(hfTemp)
bar1.StartValue = -60
bar1.EndValue = 120
bar1.MajorTickNumber = 19
bar1.MinorTicknumber = 1
bar1.CustomLabel = New String() {"-60", "-50", "-40", "-30", "-20", _
"-10", "0", "10", "20", "30", _
"40", "50", "60", "70", "80", _
"90", "100", "110", "120"}
bar1.TickMajor.Width = 3
bar1.TickMajor.Height = 12
bar1.TickMajor.FillColor = Color.Lime
bar1.TickMajor.Type = TickBase.TickType.RoundedRect
bar1.TickMinor.Width = 3
bar1.TickMinor.Height = 8
bar1.TickMinor.FillColor = Color.Lime
bar1.TickMinor.TickPosition = TickBase.Position.Cross
bar1.TickMinor.Type = TickBase.TickType.RoundedRect
bar1.FillColor = Color.DarkBlue
bar1.TickLabel.FontColor = Color.White
bar1.TickLabel.LabelFont = New Font("Elephant", 8, FontStyle.Regular)
hfTemp.ScaleCollection.Add(bar1)
Dim pointer As HorizontalPointer = New HorizontalPointer(hfTemp)
bar1.Pointer.Add(pointer)
bar1.Pointer(0).BasePointer.PointerShapeType = Pointerbase.PointerType.Type1
bar1.Pointer(0).BasePointer.FillColor = Color.Blue
bar1.Pointer(0).BasePointer.Length = 15
End Sub
定时器事件
Private Sub TMPTimer_Tick(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles TMPTimer.Tick
If oldTemp < newTemp Then
oldTemp += 1
DirectCast((Me.BaseUI1.Frame(0)), _
HorizontalFrame).ScaleCollection(0).Pointer(0).Value = oldTemp
lblTemperature.Text = "Temperature " & oldTemp.ToString() & "°"
If oldTemp = newTemp Then
oldTemp = newTemp
TMPTimer.Enabled = False
End If
End If
If oldTemp > newTemp Then
oldTemp -= 1
DirectCast((Me.BaseUI1.Frame(0)), _
HorizontalFrame).ScaleCollection(0).Pointer(0).Value = oldTemp
lblTemperature.Text = "Temperature " & oldTemp.ToString() & "°"
If oldTemp = newTemp Then
oldTemp = newTemp
TMPTimer.Enabled = False
End If
End If
End Sub
上面的 TMPTimer_Tick 事件用于温度仪表盘动画。当应用程序首次启动时，oldTemp 等于零，newTemp 等于我们从雅虎 RSS Feed 中获取的温度。当定时器被激活时，上面的代码基本不言自明。如果 oldTemp 小于 newTemp，则我们在数字显示和指针值上加 1 并将其显示给用户；如果大于，则减一并进行显示。其他两个定时器滴答事件相同，只是变量不同。
在设计指南针时，我在对齐 "N" 与顶部中心方面遇到了问题。我尝试了 StartAngle 和 SweepAngle，直到我调对了。我还需要对 bar2（风速）做同样的事情。您将需要 NextUI 库，可以在 这里 找到，而 FunkyLibrary 可以在 这里 找到。所有指南针基本都相同。
两天预报
起初，我不知道如何从 HTML 文档中提取我需要的一些项目，所以决定使用正则表达式。接下来是学习如何做到这一点。我复制了30分钟正则表达式教程并打印了出来。它包含在 zip 文件中。接下来，您需要 expresso。这是一个非常有用的正则表达式学习工具。
我为此子程序使用了正则表达式。我使用了管道符来检索六种不同的天气状况。可能有更复杂的 string，但由于我是这方面的新手，所以我使用了对我有效的方法。
Private Sub Get2DayForecast()
'Code by RSPercy 03/25/2011
Try
lblDate1.Text = FormatDateTime(Now.Date, DateFormat.ShortDate).ToString()
lblDate2.Text = FormatDateTime(DateAdd(DateInterval.Day, 1, Now.Date))
Dim parts() As String
Dim m As Match
Dim strMatch As String = String.Empty
Dim p As New pWeatherLib.pWeatherForecast_
(cmbZip.Text, temperatureUnit.Fahrenheit)
'''''''''''''''''''''''''''Day, Condition, High, Low
Dim pattern As String = _
"\w*\s-\s(\w*|\w*\s\w*|\w*\s\w*\s\w*|\w*\s\w*\s\w*\s\w*|\w*\/\w*" &
"|\w*\/\w*\/\w*|\w*\s\w*\/\w*\s\w*|\w*\s\w*\/\w*|\w*\s\w*\/\w*\-\w*)_
\.\s\w*:\s(\d{1,3}" &
"|\-\d{1,3})\s\w*:\s(\d{1,3}|\-\d{1,3})"
Dim input As String = p.rss.channel.item.description
For Each m In Regex.Matches(input, pattern, RegexOptions.Multiline)
strMatch = m.Value
If strMatch = Nothing Then
Exit For
Else
strMatch = strMatch.Replace(" - ", ",")
strMatch = strMatch.Replace(". High: ", ",")
strMatch = strMatch.Replace(" Low: ", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts = Split(strMatch, ",")
If parts(0) <> p.rss.channel.item.forecast.day Then
lblTomorrow.Text = parts(0)
lblcc2.Text = parts(1)
RetrieveForecastCode()
lblHi2.Text = "High: " & parts(2)
lblLo2.Text = "Low : " & parts(3)
ElseIf parts(0) = p.rss.channel.item.forecast.day Then
lblcc1.Text = parts(1)
RetrieveForecast1()
lblHi1.Text = "High: " & parts(2)
lblLo1.Text = "Low : " & parts(3)
End If
End If
Next
Catch ex As Exception
MessageBox.Show("Sorry...Try again later!", "Info to the Rescue!")
End Try
End Sub
唯一不同的是模式字符串中的条件。在下面段落中的子程序中，您将找到六种不同的模式。
- 龙卷风
- 强雷暴
- 小雪阵雨
- 雨夹雪
- 雨/雷
- 上午多云/下午晴
该列表包含了到目前为止我遇到的 14 种不同的模式。我到处打听如何用一个正则表达式来完成六种不同字符串的工作。经过大量的试验和错误，我终于成功了。我使用了管道符来实现。我删除了 189 行代码。
RetrieveForecastCode() 和 RetrieveForecast1() 子程序从 YahooWeatherPics 文件夹中获取正确的 JPG 文件，并将它们显示在正确的 PictureBox 中。
5 天预报？……天气每天都在变化
这是迄今为止我为这个应用程序所做的最难的事情。我不得不学习如何从雅虎服务器请求信息，将数据从一个控件切换到另一个控件进行编辑，然后将其传递回原始控件再次使用；然后我不得不为 5 天、5 种天气状况、5 个最高温、5 个最低温、5 张图片和 5 个日期添加一些正则表达式。由于雅虎使用六种不同类型的字符串，我必须想办法获取并显示这些字符串。我使用正则表达式来获取我需要的所有字符串。结果可以在上面的最后一张图片中看到。这一切都在一个子程序（GetFiveDayInfo()）中完成。代码太多无法显示，所以我只显示如何访问雅虎服务器以获取页面源代码。一旦我们获取了请求的 HTML 页面源代码，我们就可以开始对其进行分析并显示我们需要的信息。如前所述，前一个应用程序中的此代码已被删除。
Private Sub GetFiveDayInfo()
'Code by RSPercy 03/25/2011
Try
Dim parts() As String
Dim parts1() As String
Dim parts2() As String
Dim m As Match
Dim strMatch As String = String.Empty
'Finds the 5-day forecast conditions...EX: Partly Cloudy, Rain/Thunder....etc.
'There are 14 different patterns that we need.
Dim patternAA As String = "<[\w]*/>{1}_
([\w\s/-]*|[\w\s/]*-{1}[der]{1,2})</div>"
'Finds the days oy the week....EX: Mon, Tue, Wed, Thur, Fri, Sat, Sun.
Dim pattern5Day As String = "\<\w*\>\w*\<\/\w*\>\<_
\w*\>\w*\<\/\w*\>\<\w*\>\w*\<\/\w*\>\<_
\w*\>\w*\<\/\w*\>\<\w*\>\w*\<\/\w*\>"
'Finds the 5-day forecast Hi's and Low's
Dim patternHiLow As String = "\<\w*\>\w*\:\s(\d{1,3}|\-\d{1,3})_
\&\#\d{1,3}\;\s\<\w*\>\w*\:\s(\d{1,3}|\-\d{1,3})"
'Create a request using a URL that can receive a post.
Dim request As WebRequest = WebRequest.Create_
("http://weather.yahoo.com/united-states/" & cmbStates.Text _
& "/" & cmbCity.Text & "-" & cmbWoeID.Text & "/")
'Create POST data and convert it to a byte array.
request.Method = "POST"
Dim postData As String = "This is a test."
' Set the ContentType property of the WebRequest.
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
' Set the ContentType property of the WebRequest.
request.ContentType = "application/x-www-form-urlencoded"
' Set the ContentLength property of the WebRequest.
request.ContentLength = byteArray.Length
'Create datastream and a response stream.
Dim dataStream As Stream = request.GetRequestStream()
' Write the data to the request stream, then close it
dataStream.Write(byteArray, 0, byteArray.Length)
dataStream.Close()
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Get the status.
Dim myString As String = CType(response, HttpWebResponse).StatusDescription
' Get the stream containing content returned by the server.
dataStream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim sr As StreamReader = New StreamReader(dataStream)
' Put the content in a textbox.
Dim myTB As TextBox = New TextBox
myTB.Multiline = True
myTB.WordWrap = False
myTB.Text = sr.ReadToEnd
' Clean up the streams.
sr.Close()
dataStream.Close()
response.Close()
'Move the content to a string variable.
strMatch = myTB.Text
'Remove the carriage returns and line feeds
'so our regex patterns work correctly.
strMatch = strMatch.Replace(ControlChars.CrLf, "")
strMatch = strMatch.Replace(ControlChars.Cr, "")
strMatch = strMatch.Replace(ControlChars.Lf, "")
'Reset the textbox to nothing.
myTB.Text = ""
'populate the textbox with the new data
myTB.Text = strMatch
'Reset strMatch to nothing.
strMatch = String.Empty
'Get the Dates for the forecasts
GetFiveDates()
'Get the days of the week.
For Each m In Regex.Matches(myTB.Text, pattern5Day, RegexOptions.Multiline)
strMatch = m.Value
If strMatch = Nothing Then
Exit For
Else
strMatch = strMatch.Replace("<th>", "")
strMatch = strMatch.Replace("</th>", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts = Split(strMatch, ",")
If parts(0) = "Today" Then
lblDay1.Text = parts(0)
lblDay2.Text = parts(1)
lblDay3.Text = parts(2)
lblDay4.Text = parts(3)
lblDay5.Text = parts(4)
ElseIf parts(0) = "Tonight" Then
lblDay1.Text = parts(0)
lblDay2.Text = parts(1)
lblDay3.Text = parts(2)
lblDay4.Text = parts(3)
lblDay5.Text = parts(4)
End If
End If
Next
strMatch = String.Empty
'Get the Highs and Lows.
For Each m In Regex.Matches(myTB.Text, patternHiLow, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("<td>High: ", ",")
strMatch = strMatch.Replace("° <div>Low: ", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts1 = Split(strMatch, ",")
lblHigh1.Text = "High : " & parts1(1)
lblLow1.Text = "Low : " & parts1(2)
lblHigh2.Text = "High : " & parts1(3)
lblLow2.Text = "Low : " & parts1(4)
lblHigh3.Text = "High : " & parts1(5)
lblLow3.Text = "Low : " & parts1(6)
lblHigh4.Text = "High : " & parts1(7)
lblLow4.Text = "Low : " & parts1(8)
lblHigh5.Text = "High : " & parts1(9)
lblLow5.Text = "Low : " & parts1(10)
strMatch = String.Empty
'Get the five conditions and the Images that we need.
For Each m In Regex.Matches(myTB.Text, patternAA, RegexOptions.Multiline)
strMatch += m.Value
Next
strMatch = strMatch.Replace("<br/>", "")
strMatch = strMatch.Replace("</div>", ",")
'MessageBox.Show(strMatch) 'For testing ONLY
parts2 = Split(strMatch, ",")
lblCon1.Text = parts2(0)
RetrieveForecastA()
lblCon2.Text = parts2(1)
RetrieveForecastB()
lblCon3.Text = parts2(2)
RetrieveForecastC()
lblCon4.Text = parts2(3)
RetrieveForecastD()
lblCon5.Text = parts2(4)
RetrieveForecastE()
strMatch = String.Empty
Catch ex As Exception
MessageBox.Show("Unexplained Error has occurred," & vbCrLf _
& "The 5-Day Weather Forecast" & vbCrLf _
& "will be unavailable. Please" & vbCrLf _
& "try again later.", "Info to the Rescue", _
MessageBoxButtons.OK, MessageBoxIcon.Information)
End Try
End Sub
下载 NextUI.dll 和 pWeatherLib.dll
NextUI.dll 和 pWeatherLib.dll 可以 在这里 下载。以防 CodeProject 决定删除 DLL 文件。下载，解压缩，重新添加库到项目中。您可以 在这里 下载完整的项目。
下载 WindowsAPICodePack
您可以 在这里 下载 WindowsAPICodePack 项目。
希望您能使用并享受这个应用程序。
结论
我一直看天气频道。为什么？你可能会问自己。那是因为天气频道是唯一一个没有重播的频道。因为我一直对天气着迷，所以这个应用程序就这样诞生了。
历史
- 此版本使用 VB.NET Pro 2010 创建。