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
Immer her damit
Edit: Obwohl mir jetzt grade auffällt... die Modulform wäre gar nicht wirklich notwendig gewesen.... hach, das alter
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.