[Modul] OWM - OpenWeatherMap (Wetterdaten)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

[Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von Bisonte »

Hallo.

Da Google seine Wetter-API eingestellt hat, musste ich mich nach einem Ersatz umsehen,
der es einem ermöglicht, Wetterdaten zu organisieren... und das für lau ;)

Da stiess ich auf OpenWeatherMap und versuchte mich daran.

Herausgekommen ist dabei ein Modul das auf allen OS funktionieren sollte (keine OS-API Nutzung).

Ein kleines Beispiel, wie man die Daten anwenden könnte ist dabei.

Die Nutzungsbedingungen für die Wetterdaten findet ihr bei OpenWeatherMap.org
Ausserdem auch weitere Infos, da noch viel mehr Daten herauszuholen sind, als die, die ich hier extrahiere.

Nun gut. Lange Rede, kurzer Code ;) mit Dank an ts-soft für sein ReceiveHTTPMemory() ...

Code: Alles auswählen

DeclareModule OWM

  ;:--------------------------------------------------------------------------
  ;:-
  ;:- Modul   : OpenWeatherMap (OWM)
  ;:- Author  : George Bisonte
  ;:- Date    : 15. Jan 2015
  ;:- PB      : 5.31
  ;:- OS      : Windows/Linux/MacOS
  ;:-           For License and more infos go to
  ;:-           http://www.openweathermap.org/API
  ;:- Credits : thx to ts-soft for ReceiveHTTPMemory()
  ;:-
  ;:- Compile it without Purifier (cause of a Purifier-Bug)
  ;:--------------------------------------------------------------------------
 
  Structure WEATHERDATA
   
    dwSize.l
   
    City.s
   
    Temp.i
    minTemp.i
    maxTemp.i
    unitTemp.s
   
    Humidity.i
    unitHumidity.s
   
    Pressure.i
    unitPressure.s
   
    IconUrl.s
    Icon.i
    Code.i
   
    Text.s
   
    LastUpdate.l
   
  EndStructure
 
  Declare GetWeatherData(City.s, *Weather.WEATHERDATA)
 
EndDeclareModule
Module OWM
 
  ;:--------------------------------------------------------------------------
  ;:-
  ;:- Modul   : OpenWeatherMap (OWM)
  ;:- Author  : George Bisonte
  ;:- Date    : 15. Jan 2015
  ;:- PB      : 5.31
  ;:- OS      : Windows/Linux/MacOS
  ;:-           For License and more infos go to
  ;:-           http://www.openweathermap.org/API
  ;:- Credits : thx to ts-soft for ReceiveHTTPMemory()
  ;:-
  ;:- Compile it without Purifier (cause of a Purifier-Bug)
  ;:--------------------------------------------------------------------------
 
  EnableExplicit
 
  Procedure ReceiveHTTPMemory(URL.s, BufferSize = 4096, Timeout = 5000)
   
    ;:- Original Author : TS-Soft
   
    If InitNetwork() = 0 : ProcedureReturn #False : EndIf
   
    Protected Connection, Time, Time2, Event, Size, Size2, SizeAll, pos
    Protected.s Server
    Protected *Mem, *Buffer, *Mem2
   
    Size = 1
   
    If LCase(Left(URL, 7)) <> "http://" : URL = "http://" + URL : EndIf
    Server = GetURLPart(URL, #PB_URL_Site)
    If Server = "" : ProcedureReturn #False : EndIf
    Connection = OpenNetworkConnection(Server, 80, #PB_Network_TCP)
    If Not Connection : ProcedureReturn #False : EndIf
    If BufferSize <= 0 : BufferSize = 4096 : EndIf
    *Buffer = AllocateMemory(BufferSize)
    If Not *Buffer
      ProcedureReturn #False
    EndIf
   
    SendNetworkString(Connection, "GET " + URL + " HTTP/1.0" + #LFCR$ + #LFCR$)
    Time = ElapsedMilliseconds()
    Repeat
      Event = NetworkClientEvent(Connection)
      If Event = #PB_NetworkEvent_Data
        Repeat
          Size = ReceiveNetworkData(Connection, *Buffer, BufferSize)
          If Size > 0
            Time = ElapsedMilliseconds()
            SizeAll + Size
            *Mem = ReAllocateMemory(*Mem, SizeAll)
            If *Mem
              CopyMemory(*Buffer, *Mem + (SizeAll - Size), Size)
            Else
              CloseNetworkConnection(Connection)
              FreeMemory(*Buffer)
              ProcedureReturn #False
            EndIf
          EndIf
        Until Size <= 0
      EndIf
      Time2 = ElapsedMilliseconds() - Time
    Until Time2 > Timeout Or Size <= 0
    CloseNetworkConnection(Connection)
    FreeMemory(*Buffer)
    If Time2 > Timeout
      If *Mem : FreeMemory(*Mem) : EndIf
      ProcedureReturn #False
    EndIf
    pos = FindString(PeekS(*mem, -1, #PB_UTF8), #CRLF$ + #CRLF$, 1) - 1
    pos = Len(#CRLF$ + #CRLF$) + pos
    Size2 = MemorySize(*Mem) - pos
    *Mem2 = AllocateMemory(Size2)
    If *Mem2
      CopyMemory(*Mem + pos, *Mem2, Size2)
      FreeMemory(*Mem)
      ProcedureReturn *Mem2
    EndIf
    FreeMemory(*Mem)
   
    ProcedureReturn #False
  EndProcedure
  Procedure RFindString(String.s, StringToFind.s, StartPosition = 1)

    Protected Found
   
    Repeat
      Found = FindString(String, StringToFind, StartPosition)
      If Found
        StartPosition = Found + 1
      EndIf
    Until Found = 0
   
    ProcedureReturn StartPosition - 1
   
  EndProcedure
  
  Procedure.s GetCityName(Name.s)
    
    If Name <> ""
      Name = LCase(ReplaceString(UCase(Name), "Ü", "UE"))
      Name = LCase(ReplaceString(UCase(Name), "Ö", "OE"))
      Name = LCase(ReplaceString(UCase(Name), "Ä", "AE"))
      Name = LCase(ReplaceString(UCase(Name), "ß", "SS"))
    EndIf
    
    ProcedureReturn Name
    
  EndProcedure
  
  Procedure GetWeatherData(City.s, *Weather.WEATHERDATA)
   
    Protected *Mem, xmlString.s, *ChildNode, *Node, Weather, XML, h.s, i, oCity.s
    Protected NewMap Nodes()
    
    oCity = City : City = GetCityName(oCity)
    
    Debug City
    If Not *Weather : ProcedureReturn #False : EndIf
    If *Weather\dwSize <> SizeOf(WEATHERDATA) : ProcedureReturn #False : EndIf
   
    *Mem = ReceiveHTTPMemory("http://api.openweathermap.org/data/2.5/weather?q=" + City + "&mode=xml&units=metric")
    If Not *Mem : ProcedureReturn #False : EndIf
   
    xmlString = PeekS(*Mem, -1, #PB_Ascii) : FreeMemory(*Mem)   
   
    ;:- If the city is not found
    If FindString(LCase(xmlString), "message") And FindString(LCase(xmlString), "error:")
      *Weather\City = "Error : Not found city"
      ProcedureReturn #False
    EndIf
   
    ;:- Cut off some characters at the end of the string.
    xmlString = Left(xmlString, RFindString(LCase(xmlString), "</current>") + Len("</current>"))
   
    ;:- parse the xml data
    XML = ParseXML(#PB_Any, xmlString)
   
    If XML
     
      ;:- get all nodes
      *ChildNode = ChildXMLNode(MainXMLNode(XML))
      While *ChildNode <> 0
        Nodes(LCase(GetXMLNodeName(*ChildNode))) = *ChildNode
        *ChildNode = NextXMLNode(*ChildNode)
      Wend
     
      With *Weather
       
        \City = City
        i = FindString(City, ",") : If i : \City = Left(City, i-1) : EndIf
       
        ;:- parse it
        *Node = Nodes("temperature")
        If *Node
          If ExamineXMLAttributes(*Node)
            While NextXMLAttribute(*Node)
              Select LCase(XMLAttributeName(*Node))
                Case "value"
                  \Temp = Val(XMLAttributeValue(*Node))
                Case "min"
                  \minTemp = Val(XMLAttributeValue(*Node))
                Case "max"
                  \maxTemp = Val(XMLAttributeValue(*Node))
                Case "unit"
                  \unitTemp = XMLAttributeValue(*Node)
                  \unitTemp = UCase(Left(\unitTemp,1)) + Mid(\unitTemp, 2)
              EndSelect     
            Wend
          EndIf   
        EndIf
       
        *Node = Nodes("humidity")
        If *Node
          If ExamineXMLAttributes(*Node)
            While NextXMLAttribute(*Node)
              Select LCase(XMLAttributeName(*Node))
                Case "value"
                  \Humidity = Val(XMLAttributeValue(*Node))
                Case "unit"
                  \unitHumidity = XMLAttributeValue(*Node)
              EndSelect     
            Wend
          EndIf   
        EndIf
       
        *Node = Nodes("weather")
        If *Node
          If ExamineXMLAttributes(*Node)
            While NextXMLAttribute(*Node)
              Select LCase(XMLAttributeName(*Node))
                Case "value"
                  \Text = XMLAttributeValue(*Node)
                Case "icon"
                  \IconUrl = "http://openweathermap.org/img/w/" + XMLAttributeValue(*Node) + ".png"
                  *Mem = ReceiveHTTPMemory(\IconUrl)
                  If *Mem
                    \Icon = CatchImage(#PB_Any, *Mem)
                    FreeMemory(*Mem)
                  EndIf
                Case "number"
                  \Code = Val(XMLAttributeValue(*Node))
              EndSelect     
            Wend
          EndIf   
        EndIf
       
        *Node = Nodes("pressure")
        If *Node
          If ExamineXMLAttributes(*Node)
            While NextXMLAttribute(*Node)
              Select LCase(XMLAttributeName(*Node))
                Case "value"
                  \Pressure = Val(XMLAttributeValue(*Node))
                Case "unit"
                  \unitPressure = XMLAttributeValue(*Node)
              EndSelect     
            Wend
          EndIf   
        EndIf
       
        *Node = Nodes("lastupdate")
        If *Node
          If ExamineXMLAttributes(*Node)
            While NextXMLAttribute(*Node)
              Select LCase(XMLAttributeName(*Node))
                Case "value"
                  h = LCase(XMLAttributeValue(*Node))
                  Debug h
                  \LastUpdate = ParseDate("%yyyy-%mm-%ddt%hh:%ii:%ss", h)
                  Debug \LastUpdate
              EndSelect     
            Wend
          EndIf   
        EndIf
        *Weather\City = oCity
      EndWith
     
      ProcedureReturn #True
     
    Else
      ProcedureReturn #False
    EndIf
   
   
  EndProcedure
 
EndModule

;:- Demo

CompilerIf #PB_Compiler_IsMainFile
EnableExplicit

Define x, y, Event, Font1 = LoadFont(#PB_Any, "Verdana", 12, #PB_Font_Bold), Font2 = LoadFont(#PB_Any, "Verdana", 8, #PB_Font_Bold)

Define Weather.OWM::WEATHERDATA

UsePNGImageDecoder()

Weather\dwSize = SizeOf(OWM::WEATHERDATA)

If OWM::GetWeatherData("Neumünster,de", @Weather)
 
 
  OpenWindow(0, 0, 0, 320, 120, "Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
 
  CanvasGadget(0, 10, 10, 300, 100)
 
  If StartDrawing(CanvasOutput(0))
   
    Box(0, 0, OutputWidth(), OutputHeight(), 0)
    DrawingMode(#PB_2DDrawing_Gradient)
    BackColor($F0F0F0) : FrontColor($F0F0F0)
    GradientColor(0.500, $A0A0A0)
    LinearGradient(0,0,0,OutputHeight())
    Box(1,1,OutputWidth()-2,OutputHeight()-2, RGB(255,0,0))
    If IsImage(Weather\Icon) : DrawAlphaImage(ImageID(Weather\Icon), 1, 1, 255) : EndIf
    DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_Transparent)
    DrawingFont(FontID(Font1))
    DrawText(5, 48, Weather\City, 0)
    DrawingFont(FontID(Font2))
    DrawText(70, 5, "Temp : " + Str(Weather\Temp) + Chr(176) + " " +Left(Weather\unitTemp,1), 0)
    DrawText(70, 5 + TextHeight("T"), "at " + FormatDate("%hh:%ii", Weather\LastUpdate), 0)
    y = OutputHeight() - TextHeight("O") - 2
    x = OutputWidth() - TextWidth("by OpenWeatherMap.org") - 2
    DrawText(x, y, "by OpenWeatherMap.org", RGB( 80, 80, 80))
    StopDrawing()
   
  EndIf
 
  GadgetToolTip(0, Weather\Text)
 
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
 
EndIf
CompilerEndIf
Verbesserungsvorschläge / Erweiterungen / Kritik ?
Immer her damit ;)

Edit: Obwohl mir jetzt grade auffällt... die Modulform wäre gar nicht wirklich notwendig gewesen.... hach, das alter :roll:
Edit :
15.01.2015 - Code geändert : Deutsche Umlaute werden nun vor dem XML Aufruf umgewandelt (Nur im ASCIIModus erforderlich)
Für andere Sprachen die Prozedur GetCityName() anpassen.
Zuletzt geändert von Bisonte am 15.01.2015 09:10, insgesamt 3-mal geändert.
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
Rings
Beiträge: 971
Registriert: 29.08.2004 08:48

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von Rings »

danke fürs teilen, kann ich sehr gut brauchen.
Rings hat geschrieben:ziert sich nich beim zitieren
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von hjbremer »

Neumünster gibt Error

Neumuenster hingegen nicht
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Nino
Beiträge: 1300
Registriert: 13.05.2010 09:26
Wohnort: Berlin

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von Nino »

Hallo,

danke für's teilen.
Aber ich kann den Code leider nicht ausprobieren.
Bisonte hat geschrieben:

Code: Alles auswählen

  ;:- PB      : 5.22 LTS
PB 5.22 hat geschrieben:Zeile 164: ParseXML() ist keine Funktion, Array, Makro oder LinkedList.
ParseXML() gibt es erst seit PB 5.30. :-)


Also mit PB 5.30 x64 unter Windows (PB 5.30 x86 hab ich nicht installiert) versucht ... Absturz:

Code: Alles auswählen

  *Mem = ReAllocateMemory(*Mem, SizeAll)   ; Zeile 94
[ERROR] Trying to free or to reallocate a non-allocated memory block
//edit:
Purifier abgeschaltet => Programm läuft. 8)
Also entweder ein Bug im Purifier oder in Deinem Code. :mrgreen:
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von STARGÅTE »

Nino hat geschrieben:Purifier abgeschaltet => Programm läuft. 8)
Also entweder ein Bug im Purifier oder in Deinem Code. :mrgreen:
Liegt am Purifier von Version 5.30 ... habs mal im englischen Forum gepostet
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von NicTheQuick »

Drei Dinge:
1. Auf Linux funktioniert es so nicht, da die Konstante #Red nicht existiert, da sie WinAPI ist.
2. Mit "Saarbrücken,de" bekomme ich den Fehler "Ungültiger XML-Knoten. (0)" in Zeile 169.
3. Mit "Saarbruecken,de" bekomme ich den Fehler "Trying to free or to reallocate a non-allocated memory block" in Zeile 94. Mit "Berlin,de" jetzt auch der selbe Fehler.

Also das Programm hat nur beim allerersten mal bei mir funktioniert. /:->

Edit:
Okay, ohne Purifier geht es jetzt auch mit "Saarbruecken,de". Trotzdem blöd ohne Umlaute. ;)
Bild
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von Bisonte »

Ok, das mit dem #Red hatte ich übersehen, das ParseXML() Fehler meinerseits im Kommentar.

Aber für die Sache mit den Umlauten kann ich nix... das ist OpenWeatherMap ;)
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
Chimorin
Beiträge: 451
Registriert: 30.01.2013 16:11
Computerausstattung: MSI GTX 660 OC mit TwinFrozr III
6Gb DDR 3 RAM
AMD Phenom II X4 B55 @ 3,6GHz
Windows 7 Home Premium 64-bit

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von Chimorin »

Super!
Ist bestimmt irgendwann mal nützlich :)
Bild

- formerly known as Bananenfreak -
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von NicTheQuick »

Bisonte hat geschrieben:Aber für die Sache mit den Umlauten kann ich nix... das ist OpenWeatherMap ;)
Aber dann wäre es trotzdem besser, wenn das Modul einen Fehler zurück gibt und nicht einfach ab stürzt. ;)
Bild
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: [Modul] OWM - OpenWeatherMap (Wetterdaten)

Beitrag von Bisonte »

So nach langer Zeit ;)

Nach eingehenden Test habe ich herausgefunden das der "Umlaut-Absturz" nur im Ascii Modus auftritt.
Im Unicodemodus keine Probleme (deswegen fiel mir das auch anfangs nicht auf).
Nun hab ich dann halt eine Behelfsprozedur eingefügt, die Umlaute (und das ß) umwandelt, sofern sie vorhanden sind.

Desweiteren ist das #RED aus dem Beispiel entfernt, nun sollte es ohne Modifikationen Crossplattform laufen.
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Antworten