I think that such information can be obtained from google services or other sites windy.com OR meteoblue.com. I understand that there will be a delay in time, for me a delay of 15-30 minutes does not matter. I probably this is solved with the help of API requests Therefore, I hoped to see an example of such a request to the weather site.It will vary based on what service you are talking to. Which one did you have in mind?
Change what you needthere are already examples
Well, there are several and each has it's own API that you need to code against. I do have an example that I made years ago, I think it was B4A version 3 or 4, certainly well before Wait For was a thing. It is for www.openweathermap.org, I'll post it here for you to review but I won't guarantee it'll compile for B4A version 12.I think that such information can be obtained from google services or other sites windy.com OR meteoblue.com. I understand that there will be a delay in time, for me a delay of 15-30 minutes does not matter. I probably this is solved with the help of API requests Therefore, I hoped to see an example of such a request to the weather site.
#Event: Error(WeatherSender As clsOpenWeather, ErrorMessage As String)
#Event: CurrentUpdated(WeatherSender As clsOpenWeather)
#Event: DetailForcastUpdated(WeatherSender As clsOpenWeather)
#Event: WeeklyForcastUpdated(WeatherSender As clsOpenWeather)
Private moCaller As Object
Private msBaseEvent As String
Private Const API_KEY As String = "47e_YOUR_API_KEY_HERE_0c"
Private msBaseWeatherURL As String = $"https://api.openweathermap.org/data/2.5/weather?appid=${API_KEY}&mode=xml"$
Private msDetailForecastURL As String = $"https://api.openweathermap.org/data/2.5/forecast?appid=${API_KEY}&mode=xml"$
Private msWeekForecastURL As String = $"https://api.openweathermap.org/data/2.5/forecast/daily?appid=${API_KEY}&mode=xml&cnt=8"$ ' returns 8 days as day 1 = today
Private moLastNode As List
Type DetailForecastData(FromTime As Long, ToTime As Long, SymbolName As String, SymbolVar As String, SymbolNumber As Int, PrecipType As String, PrecipValue As Double, _
PrecipUnit As String, WindDir As String, WindDirCode As String, WindDirDeg As Double, WindSpeed As String, WindSpeedVal As Double, WindSpeedUnit As String, _
TempHigh As Double, TempLow As Double, Pressure As Double, PressureUnit As String, Humidity As Double, HumidUnit As String, _
CloudsValue As String, CloudsUnit As String, CloudsAll As Double)
Type WeeklyForecastData(Date As Long, SymbolName As String, SymbolVar As String, SymbolNumber As Int, PrecipType As String, PrecipValue As Double, _
WindDir As String, WindDirCode As String, WindDirDeg As Double, WindSpeed As String, WindSpeedVal As Double, WindSpeedUnit As String, _
TempHigh As Double, TempLow As Double, Pressure As Double, PressureUnit As String, Humidity As Double, HumidUnit As String, _
CloudsValue As String, CloudsUnit As String, CloudsAll As Double)
Private moCurrentDetail As DetailForecastData
Private moCurrentWeekly As WeeklyForecastData
' properties
Public CityName As String
Public CityID As String
Public CityLat As Double
Public CityLon As Double
Public Country As String
Public TimeZone As String
Public SunRise As String
Public SunSet As String
Public TempCurr As Double
Public TempMax As Double
Public TempMin As Double
Public TempUnit As String = ""
Public HumidityVal As Double
Public HumidityUnit As String
Public Feels_Like As String
Public Pressure As Double
Public PressureUnit As String
Public WindSpeedName As String
Public WindSpeed As Double
Public WindSpeedUnit As String
Public WindGustsVal As Double
Public WindDirName As String
Public WindDirValue As Double
Public WindDirCode As String
Public CloudsName As String
Public CloudsValue As Int
Public PercipUnit As String
Public PercipValue As Double
Public PercipMode As String
Public WeatherValue As String
Public WeatherIcon As String
Public WeatherNumber As Int
Public VisibilityVal As Double
Public LastUpdate As String
Public LastUpdateTicks As Long
Public DetailForecasts As List ' list of DetailForecastData types
Public WeeklyForecasts As List ' list of WeeklyForecastData
Public LastCurrentUpdate As Long ' TICKS of the last current update query
Public LastDetailUpdate As Long ' TICKS of last detail update query
Public LastWeeklyUpdate As Long ' TICKS of last weekly update query
Public Tag As Object ' generic tag property
End Sub
' LocationName = "City,ST", LocationID = "1234567", LocationZip = "99999,us".
Public Sub Initialize(CallingObject As Object, BaseEvent As String, LocationName As String, LocationID As String, LocationZip As String, LocationLat As Double, locationLon As Double, UseMetricMeasure As Boolean)
' Set farienheight or celcius
If UseMetricMeasure Then
msBaseWeatherURL = msBaseWeatherURL & "&units=metric"
msDetailForecastURL = msDetailForecastURL & "&units=metric"
msWeekForecastURL = msWeekForecastURL & "&units=metric"
Else
msBaseWeatherURL = msBaseWeatherURL & "&units=imperial"
msDetailForecastURL = msDetailForecastURL & "&units=imperial"
msWeekForecastURL = msWeekForecastURL & "&units=imperial"
End If
' set query method, strongest to weakest preference
If LocationLat <> 0 And locationLon <> 0 Then
Dim psParms As String = "&lat=" & NumberFormat2(LocationLat, 1, 4, 0, False) & "&lon=" & NumberFormat2(locationLon, 1, 4, 0, False)
msBaseWeatherURL = msBaseWeatherURL & psParms
msDetailForecastURL = msDetailForecastURL & psParms
msWeekForecastURL = msWeekForecastURL & psParms
Else
If LocationID <> "" Then
msBaseWeatherURL = msBaseWeatherURL & "&id=" & LocationID
msDetailForecastURL = msDetailForecastURL & "&id=" & LocationID
msWeekForecastURL = msWeekForecastURL & "&id=" & LocationID
Else
If LocationZip <> "" Then
msBaseWeatherURL = msBaseWeatherURL & "&zip=" & LocationZip
msDetailForecastURL = msDetailForecastURL & "&zip=" & LocationZip
msWeekForecastURL = msWeekForecastURL & "&zip=" & LocationZip
Else
msBaseWeatherURL = msBaseWeatherURL & "&q=" & LocationName
msDetailForecastURL = msDetailForecastURL & "&q=" & LocationName
msWeekForecastURL = msWeekForecastURL & "&q=" & LocationName
End If
End If
End If
moCaller = CallingObject
If BaseEvent <> "" Then
msBaseEvent = BaseEvent & "_"
End If
moLastNode.Initialize
DetailForecasts.Initialize
WeeklyForecasts.Initialize
End Sub
Public Sub RefreshCurrentWeather
LastCurrentUpdate = DateTime.Now
Dim poJob As HttpJob
poJob.Initialize("Current" , Me)
poJob.Download(msBaseWeatherURL)
End Sub
Public Sub RefreshDetailForecast
LastDetailUpdate = DateTime.Now
Dim poJob As HttpJob
poJob.Initialize("DetailForecast" , Me)
poJob.Download(msDetailForecastURL)
End Sub
Public Sub RefreshWeeklyForecast
LastWeeklyUpdate = DateTime.Now
Dim poJob As HttpJob
poJob.Initialize("WeeklyForecast" , Me)
poJob.Download(msWeekForecastURL)
End Sub
Public Sub LastUpdateElapsed As String
If LastUpdateTicks > 0 Then
Return FormatElapsed(((DateTime.Now - LastUpdateTicks) / 1000)) & " ago."
Else
Return "Never"
End If
End Sub
Public Sub ClearDaily
CityName = ""
CityID = ""
CityLat = 0
CityLon = 0
Country = ""
SunRise = ""
SunSet = ""
TempCurr = 0
TempMax = 0
TempMin = 0
TempUnit = ""
HumidityVal = 0
HumidityUnit = ""
Pressure = 0
PressureUnit = ""
WindSpeedName = ""
WindSpeed = 0
WindSpeedUnit = ""
WindGustsVal = 0
WindDirName = ""
WindDirValue = 0
WindDirCode = ""
CloudsName = ""
CloudsValue = 0
PercipUnit = ""
PercipValue = 0
PercipMode = ""
WeatherValue = ""
WeatherIcon = ""
WeatherNumber = 0
VisibilityVal = 0
LastUpdateTicks = 0
LastUpdate = "Never"
End Sub
Public Sub ClearWeekly
WeeklyForecasts.Clear
End Sub
Public Sub ClearDetail
DetailForecasts.Clear
End Sub
Public Sub HighTemp(Date As Long) As String
If WeeklyForecasts.Size > 0 Then
For Each poWeek As WeeklyForecastData In WeeklyForecasts
If modMain.DateOnly(poWeek.Date) = modMain.DateOnly(Date) Then
Return NumberFormat2(Round(poWeek.TempHigh), 1, 0, 0, False)
End If
Next
End If
Return ""
End Sub
Public Sub LowTemp(Date As Long) As String
If WeeklyForecasts.Size > 0 Then
For Each poWeek As WeeklyForecastData In WeeklyForecasts
If modMain.DateOnly(poWeek.Date) = modMain.DateOnly(Date) Then
Return NumberFormat2(Round(poWeek.TempLow), 1, 0, 0, False)
End If
Next
End If
Return ""
End Sub
Public Sub WeeklyForecastIcon(Date As Long) As String
If WeeklyForecasts.Size > 0 Then
For Each poWeek As WeeklyForecastData In WeeklyForecasts
If modMain.DateOnly(poWeek.Date) = modMain.DateOnly(Date) Then
Return poWeek.SymbolVar
End If
Next
End If
Return ""
End Sub
Public Sub DateTimeFormat(Ticks As Long, MilitaryTime As Boolean, ShowSeconds As Boolean) As String
Dim poSD As String = DateTime.DateFormat
Dim poST As String = DateTime.TimeFormat
Dim psFmt As String
If MilitaryTime Then
DateTime.DateFormat = "dd-MMM-yyyy"
If ShowSeconds Then
DateTime.TimeFormat = "HH:mm:ss"
Else
DateTime.TimeFormat = "HH:mm"
End If
Else
DateTime.DateFormat = "MMM-dd-yyyy"
If ShowSeconds Then
DateTime.TimeFormat = "hh:mm:ss a"
Else
DateTime.TimeFormat = "hh:mm a"
End If
End If
psFmt = DateTime.Date(Ticks) & " " & DateTime.Time(Ticks)
DateTime.DateFormat = poSD
DateTime.TimeFormat = poST
Return psFmt
End Sub
Private Sub JobDone(Job As HttpJob)
'Log("Job result for JobName = " & Job.JobName & ", Success = " & Job.Success)
Select Case Job.JobName
Case "Current"
If Job.Success = True Then
Dim poBA() As Byte = Job.GetString.GetBytes("UTF8")
If poBA.Length > 0 Then
If poBA(0) = Asc("{") Then
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Current Forecast job: error returned: " & Job.GetString
RaiseEvent("Error", psArgs)
Else
Dim poIS As InputStream
poIS.InitializeFromBytesArray(poBA, 0, poBA.Length)
Dim poXML As SaxParser
poXML.Initialize
poXML.Parse(poIS, "CurrentWeather")
poIS.Close
End If
Else
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: current Forecast job: no bytes returned."
RaiseEvent("Error", psArgs)
End If
Else
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Current Weather job: " & Job.ErrorMessage
RaiseEvent("Error", psArgs)
End If
Case "DetailForecast"
If Job.Success = True Then
Dim poBA() As Byte = Job.GetString.GetBytes("UTF8")
If poBA.Length > 0 Then
If poBA(0) = Asc("{") Then
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Detail Forecast job: error returned: " & Job.GetString
RaiseEvent("Error", psArgs)
Else
Dim poIS As InputStream
poIS.InitializeFromBytesArray(poBA, 0, poBA.Length)
Dim poXML As SaxParser
poXML.Initialize
poXML.Parse(poIS, "DetailForecast")
poIS.Close
End If
Else
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Detail Forecast job: no bytes returned."
RaiseEvent("Error", psArgs)
End If
Else
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Detail Forecast job: " & Job.ErrorMessage
RaiseEvent("Error", psArgs)
End If
Case "WeeklyForecast"
If Job.Success = True Then
Dim psTemp As String = Job.GetString
If psTemp.StartsWith("{") Then
' we have a JSON error response
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Weekly Forecast job (Improper XML resonse): " & psTemp
RaiseEvent("Error", psArgs)
Else
If psTemp.Length > 0 Then
If psTemp.StartsWith("{") Then
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Detail Forecast job: error returned: " & psTemp
RaiseEvent("Error", psArgs)
Else
Dim poBA() As Byte = psTemp.GetBytes("UTF8")
Dim poIS As InputStream
poIS.InitializeFromBytesArray(poBA, 0, poBA.Length)
Dim poXML As SaxParser
poXML.Initialize
poXML.Parse(poIS, "WeeklyForecast")
poIS.Close
End If
Else
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Weekly Forecast job: no bytes returned."
RaiseEvent("Error", psArgs)
End If
End If
Else
Dim psArgs(2) As Object
psArgs(0) = Me
psArgs(1) = "HTTP: Weekly Forecast job: " & Job.ErrorMessage
RaiseEvent("Error", psArgs)
End If
End Select
Job.Release
End Sub
Private Sub RaiseEvent(EventName As String, ArgList() As Object)
If msBaseEvent <> "" Then
If SubExists(moCaller, msBaseEvent & EventName) Then
Select Case ArgList.Length
Case 0
CallSubDelayed(moCaller, msBaseEvent & EventName)
Case 1
CallSubDelayed2(moCaller, msBaseEvent & EventName, ArgList(0))
Case 2
CallSubDelayed3(moCaller, msBaseEvent & EventName, ArgList(0), ArgList(1))
Case Else
CallSubDelayed2(moCaller, msBaseEvent & EventName, ArgList)
End Select
End If
End If
End Sub
#Region CURRENT WEATHER PARSER
Sub CurrentWeather_StartElement(Uri As String, Name As String, Attributes As Attributes)
Select Case Name.Trim.ToLowerCase
Case "current"
ClearDaily
moLastNode.Clear
Case "city"
moLastNode.Add(Name.Trim.ToLowerCase)
CityName = Attributes.GetValue2("", "name")
CityID = Attributes.GetValue2("", "id")
Case "coord"
If LastParseNode = "city" Then
CityLat = NumbersOnly(Attributes.GetValue2("", "lat"), True)
CityLon = NumbersOnly(Attributes.GetValue2("", "lon"), True)
End If
Case "sun"
If LastParseNode = "city" Then
SunRise = FormatDate(ConvertUTCToTicks(Attributes.GetValue2("", "rise") & "+0000"), True)
SunSet = FormatDate(ConvertUTCToTicks(Attributes.GetValue2("", "set") & "+0000"), True)
End If
Case "country"
' do nothing as the country value is INSIDE the tag, not an attribute OF the tag (the end tag event has to fill it in)
Country = ""
Case "temperature"
TempUnit = Attributes.GetValue2("", "unit")
TempMax = NumbersOnly(Attributes.GetValue2("", "max"), True)
TempMin = NumbersOnly(Attributes.GetValue2("", "min"), True)
TempCurr = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "humidity"
HumidityUnit = Attributes.GetValue2("", "unit")
HumidityVal = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "pressure"
PressureUnit = Attributes.GetValue2("", "unit")
Pressure = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "wind"
moLastNode.Add(Name.Trim.ToLowerCase)
Case "speed"
If LastParseNode = "wind" Then
WindSpeed = NumbersOnly(Attributes.GetValue2("", "value"), True)
WindSpeedName = Attributes.GetValue2("", "name")
If msBaseWeatherURL.Contains("imperial") Then
' convert meters-per-second to miles per hour
WindSpeedUnit = "mph"
'WindSpeed = NumberFormat2((WindSpeed * 2.23694), 1, 2, 0, False) ' round to 100/th
End If
End If
Case "gusts"
If LastParseNode = "wind" Then
WindGustsVal = NumbersOnly(Attributes.GetValue2("", "value"), True)
End If
Case "direction"
If LastParseNode = "wind" Then
WindDirName = Attributes.GetValue2("", "name")
WindDirValue = NumbersOnly(Attributes.GetValue2("", "value"), True)
WindDirCode = Attributes.GetValue2("", "code")
End If
Case "clouds"
CloudsName = Attributes.GetValue2("", "name")
CloudsValue = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "visibility"
VisibilityVal = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "precipitation"
PercipMode = Attributes.GetValue2("", "mode") ' no, or "rain" or "snow"
PercipUnit = Attributes.GetValue2("", "unit")
PercipValue = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "weather"
WeatherIcon = Attributes.GetValue2("", "icon")
WeatherNumber = NumbersOnly(Attributes.GetValue2("", "number"), False)
WeatherValue = Attributes.GetValue2("", "value")
Case "lastupdate"
LastUpdateTicks = ConvertUTCToTicks(Attributes.GetValue2("", "value") & "+0000")
LastUpdate = FormatDate(LastUpdateTicks, False)
Case "timezone"
' do nothing as the timezone value is INSIDE the tag, not an attribute OF the tag (the end tag event has to fill it in)
TimeZone = ""
Case "feels_like"
Feels_Like = Attributes.GetValue2("", "value") 'feels like temp value
' attribute name "unit" is like "fahrenheit"
Case Else
Log("clsOpenWeather - unhandled XML parse node: " & Name & " (" & Uri & ")")
End Select
End Sub
Sub CurrentWeather_EndElement(Uri As String, Name As String, Text As StringBuilder)
If Name.Trim.ToLowerCase = LastParseNode Then
moLastNode.RemoveAt(moLastNode.Size - 1)
End If
If Name = "current" Then
' done with entire output
Dim psArgs(1) As Object
psArgs(0) = Me
RaiseEvent("CurrentUpdated", psArgs)
LastCurrentUpdate = DateTime.Now
Else
If Name = "country" Then
Country = Text.ToString
Else
If Name = "timezone" Then
TimeZone=Text.ToString
End If
End If
End If
End Sub
#End Region
#Region DETAILED FORECAST PARSER
Sub DetailForecast_StartElement(Uri As String, Name As String, Attributes As Attributes)
Select Case Name.Trim.ToLowerCase
Case "weatherdata"
ClearDetail
Case "time"
' create a new entry to be added the forcasts list
Dim poNew As DetailForecastData
poNew.Initialize
poNew.FromTime = ConvertUTCToTicks(Attributes.GetValue2("", "from") & "+0000")
poNew.ToTime = ConvertUTCToTicks(Attributes.GetValue2("", "to") & "+0000")
moCurrentDetail = poNew
Case "symbol"
moCurrentDetail.SymbolName = Attributes.GetValue2("", "name")
moCurrentDetail.SymbolVar = Attributes.GetValue2("", "var")
moCurrentDetail.SymbolNumber = NumbersOnly(Attributes.GetValue2("", "var"), False)
Case "precipitation"
moCurrentDetail.PrecipType = Attributes.GetValue2("", "type")
moCurrentDetail.PrecipValue = NumbersOnly(Attributes.GetValue2("", "value"), True)
moCurrentDetail.PrecipUnit = Attributes.GetValue2("", "unit")
Case "winddirection"
moCurrentDetail.WindDir = Attributes.GetValue2("", "name")
moCurrentDetail.WindDirCode = Attributes.GetValue2("", "code")
moCurrentDetail.WindDirDeg = NumbersOnly(Attributes.GetValue2("", "deg"), True)
Case "windspeed"
moCurrentDetail.WindSpeed = Attributes.GetValue2("", "name")
moCurrentDetail.WindSpeedVal = NumbersOnly(Attributes.GetValue2("", "mps"), True)
moCurrentDetail.WindSpeedUnit = "mps"
If msDetailForecastURL.Contains("imperial") Then
' convert meters-per-second to miles per hour
moCurrentDetail.WindSpeedUnit = "mph"
'moCurrentDetail.WindSpeedVal = NumberFormat2((moCurrentDetail.WindSpeedVal * 2.23694), 1, 2, 0, False) ' round to 100/th
End If
Case "temperature"
moCurrentDetail.TempHigh = NumbersOnly(Attributes.GetValue2("", "max"), True)
moCurrentDetail.TempLow = NumbersOnly(Attributes.GetValue2("", "min"), True)
Case "pressure"
moCurrentDetail.Pressure = NumbersOnly(Attributes.GetValue2("", "value"), True)
moCurrentDetail.PressureUnit = Attributes.GetValue2("", "unit")
Case "humidity"
moCurrentDetail.HumidUnit = Attributes.GetValue2("", "unit")
moCurrentDetail.Humidity = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "clouds"
moCurrentDetail.CloudsValue = Attributes.GetValue2("", "value")
moCurrentDetail.CloudsUnit = Attributes.GetValue2("", "unit")
moCurrentDetail.CloudsAll = NumbersOnly(Attributes.GetValue2("", "all"), True)
Case "location", "credit", "meta", "lastupdate", "calctime", "nextupdate", "sun", "forecast", "name", "type", "country", "timezone"
' just skip these values for now
Case Else
Log("clsOpenWeather - unhandled XML parse node: " & Name & " (" & Uri & ")")
End Select
End Sub
Sub DetailForecast_EndElement(Uri As String, Name As String, Text As StringBuilder)
If Name = "weatherdata" Then
' done with entire output
Dim psArgs(1) As Object
psArgs(0) = Me
RaiseEvent("DetailForecastUpdated", psArgs)
LastDetailUpdate = DateTime.Now
Else
If Name = "time" Then
' add in the forecast we built
If moCurrentDetail.IsInitialized Then
DetailForecasts.Add(moCurrentDetail)
End If
End If
End If
End Sub
#End Region
#Region WEEKLY FORCAST PARSER
Sub WeeklyForecast_StartElement(Uri As String, Name As String, Attributes As Attributes)
Select Case Name.Trim.ToLowerCase
Case "weatherdata"
ClearWeekly
Case "time"
' create a new entry to be added the forcasts list
Dim poNew As WeeklyForecastData
poNew.Initialize
poNew.Date = ShortDateConvert(Attributes.GetValue2("", "day"))
moCurrentWeekly = poNew
Case "symbol"
moCurrentWeekly.SymbolName = Attributes.GetValue2("", "name")
moCurrentWeekly.SymbolVar = Attributes.GetValue2("", "var")
moCurrentWeekly.SymbolNumber = NumbersOnly(Attributes.GetValue2("", "var"), False)
Case "precipitation"
moCurrentWeekly.PrecipType = Attributes.GetValue2("", "type")
moCurrentWeekly.PrecipValue = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "winddirection"
moCurrentWeekly.WindDir = Attributes.GetValue2("", "name")
moCurrentWeekly.WindDirCode = Attributes.GetValue2("", "code")
moCurrentWeekly.WindDirDeg = NumbersOnly(Attributes.GetValue2("", "deg"), True)
Case "windspeed"
moCurrentWeekly.WindSpeed = Attributes.GetValue2("", "name")
moCurrentWeekly.WindSpeedVal = NumbersOnly(Attributes.GetValue2("", "mps"), True)
moCurrentWeekly.WindSpeedUnit = "mps"
If msDetailForecastURL.Contains("imperial") Then
' convert meters-per-second to miles per hour
moCurrentWeekly.WindSpeedUnit = "mph"
'moCurrentWeekly.WindSpeedVal = NumberFormat2((moCurrentWeekly.WindSpeedVal * 2.23694), 1, 2, 0, False) ' round to 100/th
End If
Case "temperature"
moCurrentWeekly.TempHigh = NumbersOnly(Attributes.GetValue2("", "max"), True)
moCurrentWeekly.TempLow = NumbersOnly(Attributes.GetValue2("", "min"), True)
Case "pressure"
moCurrentWeekly.Pressure = NumbersOnly(Attributes.GetValue2("", "value"), True)
moCurrentWeekly.PressureUnit = Attributes.GetValue2("", "unit")
Case "humidity"
moCurrentWeekly.HumidUnit = Attributes.GetValue2("", "unit")
moCurrentWeekly.Humidity = NumbersOnly(Attributes.GetValue2("", "value"), True)
Case "clouds"
moCurrentWeekly.CloudsValue = Attributes.GetValue2("", "value")
moCurrentWeekly.CloudsUnit = Attributes.GetValue2("", "unit")
moCurrentWeekly.CloudsAll = NumbersOnly(Attributes.GetValue2("", "all"), True)
Case "location", "credit", "meta", "lastupdate", "calctime", "nextupdate", "sun", "forecast", "name", "type", "country", "timezone", "windgust", "feels_like"
' just skip these values for now
Case Else
Log("clsOpenWeather - unhandled XML parse node: " & Name & " (" & Uri & ")")
End Select
End Sub
Sub WeeklyForecast_EndElement(Uri As String, Name As String, Text As StringBuilder)
If Name = "weatherdata" Then
' done with entire output
Dim psArgs(1) As Object
psArgs(0) = Me
RaiseEvent("WeeklyForecastUpdated", psArgs)
LastWeeklyUpdate = DateTime.Now
Else
If Name = "time" Then
' add in the forecast we built
If moCurrentWeekly.IsInitialized Then
WeeklyForecasts.Add(moCurrentWeekly)
End If
End If
End If
End Sub
Private Sub LastParseNode As String
If moLastNode.Size > 0 Then
Return moLastNode.Get(moLastNode.Size - 1)
Else
Return ""
End If
End Sub
#End Region
Private Sub ShortDateConvert(sDate As String) As Long
Dim poSD As String = DateTime.DateFormat
Dim plDate As Long
DateTime.DateFormat = "yyyy-MM-dd"
Try
plDate = DateTime.DateParse(sDate)
Catch
plDate = 0
End Try
DateTime.DateFormat = poSD
Return plDate
End Sub
Private Sub ConvertUTCToTicks(utc As String) As Long
Dim df As String = DateTime.DateFormat
Dim res As Long
If utc.Length = 10 Then
DateTime.DateFormat = "yyyy-MM-dd"
Else
DateTime.DateFormat = "yyyy-MM-dd'T'HH:mm:ssZ"
End If
Try
res = DateTime.DateParse(utc)
Catch
res = -1
Log("clsOpenWeather-Error parsing UTC String: " & utc & CRLF & LastException.Message)
End Try
DateTime.DateFormat = df
Return res
End Sub
Private Sub FormatDate(Ticks As Long, TimeOnly As Boolean) As String
Dim df As String = DateTime.DateFormat
Dim Tf As String = DateTime.TimeFormat
Dim psFmt As String = ""
If Ticks < 1 Then
Return ""
End If
DateTime.DateFormat = "MM/dd/yyyy"
DateTime.TimeFormat = "hh:mm:ss a"
If TimeOnly = False Then
psFmt = DateTime.Date(Ticks) & " "
End If
psFmt = psFmt & DateTime.Time(Ticks)
DateTime.DateFormat = df
DateTime.TimeFormat = Tf
Return psFmt
End Sub
Private Sub NumbersOnly(sNumbers As String, IncludeDecimal As Boolean) As Double
Dim psNew As String = ""
Dim piIndex As Int
Dim pdNew As Double
Dim pdSign As Boolean = False
Dim psChar As String
For piIndex = 0 To sNumbers.Length - 1
psChar = sNumbers.SubString2(piIndex, piIndex + 1)
If psChar = "-" And pdSign = False And (piIndex = 0 Or piIndex = sNumbers.Length - 1) Then
psNew = "-" & psNew
pdSign = True
Else
If IsNumber(psChar) Or (IncludeDecimal = True And psChar = ".") Then
psNew = psNew & sNumbers.SubString2(piIndex, piIndex + 1)
End If
End If
Next
If psNew = "" Or psNew = "-" Then
Return 0.0
Else
pdNew = psNew
Return pdNew
End If
End Sub
Private Sub FormatElapsed(TotalSeconds As Long) As String
Dim piDays As Int
Dim piHours As Int
Dim piMins As Int
Dim piSeconds As Long
Dim piCurr As Long
Dim psTemp As String
piCurr = TotalSeconds
piDays = piCurr / 86400 ' (60 seconds * 60 mins in an hour times 24 hours in a day)
piCurr = piCurr - (piDays * 86400)
piHours = piCurr / 3600 ' 3600 seconds in an hour
piCurr = piCurr - (piHours * 3600)
piMins = piCurr / 60 ' 60 seconds in a minute
piCurr = piCurr - (piMins * 60)
piSeconds = piCurr
psTemp = ""
If piDays > 0 Then
If piHours > 0 Or piMins > 0 Then
If piDays = 1 Then
psTemp = psTemp & "1 day, "
Else
psTemp = psTemp & NumberFormat(piDays, 1, 0) & " days, "
End If
Else
If piDays = 1 Then
psTemp = psTemp & "1 day"
Else
psTemp = psTemp & NumberFormat(piDays, 1, 0) & " days"
End If
End If
End If
If piHours > 0 Then
psTemp = psTemp & NumberFormat(piHours, 1, 0)
If piMins > 0 Or piSeconds > 0 Then
If piSeconds > 0 Then
If piHours = 1 Then
psTemp = psTemp & " hour"
Else
psTemp = psTemp & " hours, "
End If
Else
If piHours = 1 Then
psTemp = psTemp & " hour and "
Else
psTemp = psTemp & " hours and "
End If
End If
Else
If piHours = 1 Then
psTemp = psTemp & " hour"
Else
psTemp = psTemp & " hours"
End If
End If
End If
If piMins > 0 Then
psTemp = psTemp & NumberFormat(piMins, 1, 0)
If piSeconds > 0 Then
If piMins = 1 Then
psTemp = psTemp & " minute and "
Else
psTemp = psTemp & " minutes and "
End If
Else
If piMins = 1 Then
psTemp = psTemp & " minute"
Else
psTemp = psTemp & "minutes"
End If
End If
End If
If piSeconds > 0 Then
psTemp = psTemp & NumberFormat(piSeconds, 1, 0)
If piSeconds = 1 Then
psTemp = psTemp & " second"
Else
psTemp = psTemp & " seconds"
End If
Else
If psTemp = "" Then
psTemp = " less than a second"
End If
End If
Return psTemp
End SubWe use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?