Schulferien als XML (Download & Konvertierung iCal)
Verfasst: 04.01.2013 21:09
Nachdem ich an der Berechnung der Winterferientermine gescheitert bin (geht wohl nur mit Mondkalender usw.), habe ich beschlossen, die Ferientermine einfach komplett aus dem Internet zu holen und entsprechend aufzubereiten.
Vielleicht hat ja noch jemand Verwendung dafür. Mit kleineren Änderungen könnte man die Proceduren bestimmt auch für andere iCal-Kalender anpassen.
Vielleicht hat ja noch jemand Verwendung dafür. Mit kleineren Änderungen könnte man die Proceduren bestimmt auch für andere iCal-Kalender anpassen.
Code: Alles auswählen
;/ Schulferien als XML
;/ [ Download & iCal -> XML ]
;/ (c) 2013 Thorsten Hoeppner
#File = 0
#XML = 0
#Pfad = "D:\Temp\" ; entsprechend anpassen!
#Bundesland = "Bayern" ; siehe www.schulferien.org (entsprechend Dateiname -> Ferien_Bayern_2013.ics)
#FerienURL = "http://www.schulferien.org/iCal/Ferien/icals/"
InitNetwork()
Structure FerienStructure
Name.s
start.l
ende.l
EndStructure
Procedure.s DownloadFerien() ; Download Ferien.ics, wenn XML nicht existiert
jahr$ = Str(Year(Date()))
ics$ = "Ferien_"+#Bundesland+"_"+jahr$+".ics"
If FileSize(#Pfad+"Ferien_"+jahr$+".xml") <= 0
If ReceiveHTTPFile(#FerienURL+ics$, #Pfad+ics$)
ProcedureReturn #Pfad+ics$
EndIf
EndIf
ProcedureReturn ""
EndProcedure
Procedure.s ConvertICal(File.s)
NewList Ferien.FerienStructure()
XMLFile$ = #Pfad+"Ferien.xml"
If ReadFile(#File, File)
While Eof(#File) = #Null
If UCase(ReadString(#File)) = "BEGIN:VEVENT"
AddElement(Ferien())
Repeat
ical$ = ReadString(#File)
Select UCase(StringField(ical$,1,":"))
Case "SUMMARY"
Ferien()\Name = StringField(StringField(ical$,2,":"),1," ")
Case "DTSTART;VALUE=DATE"
Ferien()\start = ParseDate("%yyyy%mm%dd", StringField(ical$,2,":"))
Case "DTEND;VALUE=DATE"
Ferien()\ende = AddDate(ParseDate("%yyyy%mm%dd", StringField(ical$,2,":")), #PB_Date_Day, -1)
EndSelect
Until UCase(ical$) = "END:VEVENT" Or Eof(#File)
EndIf
Wend
CloseFile(#File)
EndIf
If ListSize(Ferien()) ; nach Datum sortieren
SortStructuredList(Ferien(), #PB_Sort_Ascending, OffsetOf(FerienStructure\start), #PB_Sort_Long)
EndIf
If CreateXML(#XML) ; XML-Datei erstellen
*MainNode = CreateXMLNode(RootXMLNode(#XML))
If *MainNode
SetXMLNodeName(*MainNode, "Ferien")
ForEach Ferien()
*Node = CreateXMLNode(*MainNode, -1)
If *Node
Select Ferien()\Name ;{ Nodename
Case "Winterferien"
SetXMLNodeName(*Node, "Winter")
Case "Osterferien"
SetXMLNodeName(*Node, "Ostern")
Case "Pfingstferien"
SetXMLNodeName(*Node, "Pfingsten")
Case "Sommerferien"
SetXMLNodeName(*Node, "Sommer")
Case "Herbstferien"
SetXMLNodeName(*Node, "Herbst")
Case "Weihnachtsferien"
If Year(Ferien()\start) = Year(Ferien()\ende)
SetXMLNodeName(*Node, "Neujahr")
Else
SetXMLNodeName(*Node, "Weihnachten")
EndIf
Default ; Fehler
SetXMLNodeName(*Node, "Fehler")
EndSelect ;}
SetXMLAttribute(*Node, "name", Ferien()\Name)
SetXMLAttribute(*Node, "start", Str(Ferien()\start))
SetXMLAttribute(*Node, "ende", Str(Ferien()\ende))
SetXMLNodeText(*Node, FormatDate("%dd.%mm.%yyyy",Ferien()\start)+" - "+FormatDate("%dd.%mm.%yyyy",Ferien()\ende))
EndIf
Next
If ListSize(Ferien())
jahr$ = Str(Year(Ferien()\start))
SetXMLAttribute(*MainNode, "jahr", jahr$)
XMLFile$ = #Pfad+"Ferien_"+jahr$+".xml"
EndIf
SaveXML(#XML, XMLFile$)
EndIf
FreeXML(#XML)
EndIf
ProcedureReturn XMLFile$
EndProcedure
;- ***** Test *****
File$ = DownloadFerien() ; iCal-Datei ggf. downloaden
If File$
XMLFile$ = ConvertICal(File$) ; Konvertiere nach XML
DeleteFile(File$)
Else
XMLFile$ = #Pfad+"Ferien_"+Str(Year(Date()))+".xml"
EndIf
If LoadXML(#XML, XMLFile$) ; XML mit Ferien auslesen
*MainNode = MainXMLNode(#XML)
If *MainNode
Debug " --- Ferientermine "+GetXMLAttribute(*MainNode, "jahr")+" ---"
*Node = ChildXMLNode(*MainNode)
While *Node ; alle Ferien auslesen
Debug "-> "+GetXMLAttribute(*Node, "name")+": "+GetXMLNodeText(*Node)
*Node = NextXMLNode(*Node)
Wend
Debug ""
Debug " --- einzelner Ferientermin ---"
*Node = XMLNodeFromPath(*MainNode, "Winter") ; Winterferien auslesen
If *Node
Debug "-> "+GetXMLAttribute(*Node, "name")+": "+GetXMLNodeText(*Node)
EndIf
EndIf
FreeXML(#XML)
EndIf