Android Question How to access real-time weather data by GPS coordinates?

Lakhtin_V

Active Member
Licensed User
Longtime User
I hope there are already examples or options for solving problem the real-time weather. I want, based on GPS coordinates, to have temperature, wind speed and wind direction data in ON-Line mode from Internet.
 

drgottjr

Expert
Licensed User
Longtime User
openweathermap.org will provide the data you want from the coordinates you supply. it is very unlikely you will ever get "real time" weather unless you are running a space launch complex for a landing on mars. if you want to pay some commercial service for their data, the best you could expect would be maybe a 15 minute delay (unless you just happen to ask for some location's weather at the particular moment the data were received). but even then, the reporting station may be functioning on an automated system every x minutes. openweathermap's api is a simple rest call.
 
Upvote 0

Lakhtin_V

Active Member
Licensed User
Longtime User
It will vary based on what service you are talking to. Which one did you have in mind?
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.
 
Last edited:
Upvote 0

josejad

Expert
Licensed User
Longtime User
there are already examples
Change what you need



 
Last edited:
Upvote 0

Jeffrey Cameron

Well-Known Member
Licensed User
Longtime User
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.
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.

The class is designed to raise events supplying itself as a parameter so you can query its properties. This way, you can create multiple instances for different locations to monitor.

I'll also apologize for the code, it's messy. The code is almost a direct port from an even older VB.NET class and it was for a quick-and-dirty smart-mirror project a friend of mine was making. Enjoy!

clsOpenWeather:
    #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 Sub
 
Upvote 0

Similar Threads

D
  • Question
Android Question Check GPS-Location
Replies
11
Views
2K
Deleted member 103
D
Replies
216
Views
83K
Top