Hier meine Include-Datei "AppRegistry.pbi":
Code: Alles auswählen
;/ Application Registry
;/ Eigene Registry (XML) anstatt Preferencedateien (INI) für Anwendung verwenden
;/ (c) 2009 by Thorsten Hoeppner
;- Definitionen
Structure AppRegStructure
id.l
File.s
EndStructure
;- Tools
Procedure.s XMLDecode(xml$) ; XML-eigene Zeichen ersetzen
txt$ = ReplaceString(xml$, "&", "&")
txt$ = ReplaceString(txt$, "<", "<")
txt$ = ReplaceString(txt$, ">", ">")
txt$ = ReplaceString(txt$, "'", "'")
txt$ = ReplaceString(txt$, """, Chr(34))
txt$ = ReplaceString(txt$, "€", "€")
ProcedureReturn Trim(txt$)
EndProcedure
Procedure.s XMLEncode(txt$) ; XML-eigene Zeichen ersetzen
xml$ = ReplaceString(txt$, "&", "&")
xml$ = ReplaceString(xml$, "<", "<")
xml$ = ReplaceString(xml$, ">", ">")
xml$ = ReplaceString(xml$, "'", "'")
xml$ = ReplaceString(xml$, "€", "€")
xml$ = ReplaceString(xml$, Chr(34), """)
ProcedureReturn xml$
EndProcedure
;- Lade & Speichern der Registry
Procedure.b Open_AppReg(FileName.s="Registry.xml") ; Registry öffnen bzw. neu anlegen
Protected *Node
Global AppReg.AppRegStructure
If FileSize(FileName) > 0 ;{ Registry vorhanden
AppReg\id = LoadXML(#PB_Any, FileName, #PB_UTF8)
If XMLStatus(AppReg\id) = #PB_XML_Success
AppReg\File = FileName
ProcedureReturn #True
Else
MessageRequester("Fehlermeldung", "Die Registry-Datei ist defekt und wird neu erstellt.", #MB_OK|#MB_ICONERROR)
EndIf
EndIf ;}
;{ Neue Registry anlegen
AppReg\id = CreateXML(#PB_Any, #PB_UTF8)
If AppReg\id
*Node = CreateXMLNode(RootXMLNode(AppReg\id))
If *Node
SetXMLNodeName(*Node, "Registry")
AppReg\File = FileName
ProcedureReturn #True
EndIf
EndIf
; --- fehlgeschlagen ---
AppReg\File = ""
ProcedureReturn #False
;}
EndProcedure
Procedure.b Close_AppReg() ; Registry speichern und schließen
If IsXML(AppReg\id) And AppReg\File
If SaveXML(AppReg\id, AppReg\File)
FreeXML(AppReg\id)
ProcedureReturn #True
Else
Debug "AppReg: Speichern fehlgeschlagen"
FreeXML(AppReg\id)
ProcedureReturn #False
EndIf
ElseIf IsXML(AppReg\id)
Debug "AppReg: Dateiname fehlt"
FreeXML(AppReg\id)
ProcedureReturn #False
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.b Save_AppReg() ; aktuellen Stand sichern
If IsXML(AppReg\id) And AppReg\File
If SaveXML(AppReg\id, AppReg\File)
ProcedureReturn #True
Else
Debug "AppReg: Speichern fehlgeschlagen"
EndIf
EndIf
ProcedureReturn #False
EndProcedure
;- Abfragen / Schreiben
Procedure.s GetAppRegPath(hKey.s, key.s, Name.s) ; Ermitteln des Pfades für den Node
If hKey And key
If Name
ProcedureReturn hKey+"/"+ReplaceString(key, "\", "/")+"/"+Name
Else
ProcedureReturn hKey+"/"+ReplaceString(key, "\", "/")
EndIf
ElseIf hKey
If Name
ProcedureReturn hKey+"/"+Name
Else
ProcedureReturn hKey
EndIf
ElseIf key
If Name
ProcedureReturn ReplaceString(key, "\", "/")+"/"+Name
Else
ProcedureReturn ReplaceString(key, "\", "/")
EndIf
Else
ProcedureReturn Name
EndIf
EndProcedure
Procedure Set_AppReg(hKey.s, key.s, Name.s, Value.s) ; Wert in Registry schreiben
Protected RegPath.s, NodeName.s, *MainNode, *Node
RegPath = GetAppRegPath(hKey.s, key.s, Name.s)
If IsXML(AppReg\id) And RegPath
*MainNode = MainXMLNode(AppReg\id)
If *MainNode
*Node = XMLNodeFromPath(*MainNode, RegPath)
If Not *Node ;{ Neuen Node erzeugen
*LastNode = *MainNode
For n = 1 To CountString(RegPath, "/")+1
NodeName = StringField(RegPath, n, "/")
*Node = XMLNodeFromPath(*LastNode, NodeName)
If Not *Node
*Node = CreateXMLNode(*LastNode, -1)
If *Node
SetXMLNodeName(*Node, NodeName)
*LastNode = *Node
EndIf
Else
*LastNode = *Node
EndIf
Next
EndIf ;}
If *Node ; Wert für Node setzen
SetXMLNodeText(*Node, XMLEncode(Value))
EndIf
EndIf
EndIf
EndProcedure
Procedure.s Get_AppReg(hKey.s, key.s, Name.s, DefaultValue.s="", min.s="", max.s="") ; Wert aus Registry auslesen
Protected *MainNode, *Node, RegPath.s
RegPath = GetAppRegPath(hKey.s, key.s, Name.s)
If IsXML(AppReg\id)
*MainNode = MainXMLNode(AppReg\id)
If *MainNode
*Node = XMLNodeFromPath(*MainNode, RegPath)
If *Node And GetXMLNodeText(*Node)
If min And max
wert = Val(GetXMLNodeText(*Node))
If wert >= Val(min) And wert <= Val(max)
ProcedureReturn XMLDecode(GetXMLNodeText(*Node))
Else
ProcedureReturn DefaultValue
EndIf
Else
ProcedureReturn XMLDecode(GetXMLNodeText(*Node))
EndIf
EndIf
EndIf
EndIf
ProcedureReturn DefaultValue
EndProcedure
; Inhalte löschen
Procedure ClearChilds_AppReg(*CurrentNode)
If XMLNodeType(*CurrentNode) = #PB_XML_Normal
*ChildNode = ChildXMLNode(*CurrentNode)
While *ChildNode <> 0
If XMLChildCount(*ChildNode)
ClearChilds_AppReg(*ChildNode)
Else
SetXMLNodeText(*ChildNode, "")
EndIf
*ChildNode = NextXMLNode(*ChildNode)
Wend
EndIf
EndProcedure
Procedure Clear_AppReg(hKey.s, key.s="") ; Wert(e) in Registry löschen (=> DefaultValue)
Protected *MainNode, *Node, RegPath.s
If IsXML(AppReg\id)
*MainNode = MainXMLNode(AppReg\id)
If *MainNode
If hKey And key ;{ RegPath ermitteln
RegPath = hKey+"/"+ReplaceString(key, "\", "/")
ElseIf hKey
RegPath = hKey
EndIf ;}
If RegPath
*Node = XMLNodeFromPath(*MainNode, RegPath)
If *Node
If XMLChildCount(*Node)
ClearChilds_AppReg(*Node)
Else
SetXMLNodeText(*Node, "")
EndIf
EndIf
EndIf
EndIf
EndIf
EndProcedure
Procedure.b Delete_AppReg(hKey.s, key.s, Name.s) ; Eintrag komplett löschen
Protected *MainNode, *Node, RegPath.s
RegPath = GetAppRegPath(hKey.s, key.s, Name.s)
If IsXML(AppReg\id)
*MainNode = MainXMLNode(AppReg\id)
If *MainNode
*Node = XMLNodeFromPath(*MainNode, RegPath)
If *Node
DeleteXMLNode(*Node)
ProcedureReturn #True
EndIf
EndIf
EndIf
ProcedureReturn #False
EndProcedureCode: Alles auswählen
Open_AppReg("MeinProgramm.reg")
;
; ... Programmcode ------
;
Set_AppReg("Einstellungen", "Benutzer", "Name", "Thorsten Hoeppner")
Set_AppReg("Einstellungen", "Benutzer", "Ort", "Kaufbeuren")
Set_AppReg("Last", "Path", "Load", "C:\MeinProgramm\Daten\") ; letzten Pfad merken
Set_AppReg("Last", "Path", "Save", "C:\MeinProgramm\Export\") ; letzten Pfad merken
;
; ... Programmcode ------
;
Debug "Benutzer: "+Get_AppReg("Einstellungen", "Benutzer", "Name", "unbekannt")+" aus "+Set_AppReg("Einstellungen", "Benutzer", "Ort", "")
File$ = OpenFileRequester("Bitte Datei auswählen", Get_AppReg("Last", "Path", "Load", "C:\"), "(*.*)|*.*", 0)
;
; ... Programmcode ------
;
Close_AppReg()