Application Registry (Module)

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
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Application Registry (Module)

Beitrag von Thorsten1867 »

Registry für für eigene Andwendungen

Damit können alle benötigten programmspezifischen Werte und Einstellungen abgelegt werden und stehen dann beim nächsten Programmstart wieder zur Verfügung.

Beispiele:
- Programmeinstellungen speichern
- letztes Verzeichnis merken für Datei-Auswahldialoge
- letzte Benutzeraktion merken (weitermachen, wo man aufgehört hat)
- .....

Code: Alles auswählen

;/ ===== AppRegistryModule.pbi [ PureBasic V5.6x ]
;/
;/ Registry (XML) for your program (e.g. for preferences)
;/ (c) 2017 by Thorsten Hoeppner
;/

DeclareModule AppReg
    Declare   Open(AppName.s, File.s="Registry.xml", Publisher.s="")
    Declare   Close()
    Declare   Save()
    Declare   SetValue(hKey.s, key.s, Name.s, Value.s)
    Declare.s GetValue(hKey.s, key.s, Name.s, DefaultValue.s="")
    Declare   SetInteger(hKey.s, key.s, Name.s, Value.i)
    Declare.i GetInteger(hKey.s, key.s, Name.s, DefaultValue.i=#Null)
    Declare   SetFloat(hKey.s, key.s, Name.s, Value.f)
    Declare.f GetFloat(hKey.s, key.s, Name.s, DefaultValue.f=#Null)
    Declare   Clear(hKey.s, key.s="")
    Declare   Delete(hKey.s, key.s, Name.s)
EndDeclareModule

Module AppReg

  EnableExplicit

  Structure AppRegStructure
    id.i
    File.s
  EndStructure  

  Procedure.s XMLDecode(xml$)
    Define txt$
    txt$ = ReplaceString(xml$, "&", "&")
    txt$ = ReplaceString(txt$, "<", "<")
    txt$ = ReplaceString(txt$, ">", ">")
    txt$ = ReplaceString(txt$, "&apos;", "'")
    txt$ = ReplaceString(txt$, """, Chr(34))
    txt$ = ReplaceString(txt$, "&#128", "€")
    ProcedureReturn Trim(txt$)
  EndProcedure
  
  Procedure.s XMLEncode(txt$)
    Define xml$
    xml$ = ReplaceString(txt$, "&", "&")
    xml$ = ReplaceString(xml$, "<", "<")
    xml$ = ReplaceString(xml$, ">", ">")
    xml$ = ReplaceString(xml$, "'", "&apos;")
    xml$ = ReplaceString(xml$, "€", "&#128")
    xml$ = ReplaceString(xml$, Chr(34), """)
    ProcedureReturn xml$
  EndProcedure
  
  ;- Open / Close Registry
  
  Procedure.s GetDefaultPath(AppName.s, Publisher.s = "")
    Protected Path.s, Slash.s
    CompilerSelect #PB_Compiler_OS
      CompilerCase #PB_OS_Windows
        Slash = "\"
        Path = GetEnvironmentVariable("APPDATA") + "\"
      CompilerCase #PB_OS_MacOS
        Slash = "/"
        Path = GetHomeDirectory() + "Library/Application Support/"
      CompilerCase #PB_OS_Linux
        Slash = "/"
        Path = GetHomeDirectory() + "."   
    CompilerEndSelect
    If Publisher
      Path + Publisher + Slash
      If Not FileSize(Path) = - 2
        CreateDirectory(Path)
      EndIf
    EndIf
    Path + AppName + Slash
    If Not FileSize(Path) = - 2
      CreateDirectory(Path)
    EndIf
    If FileSize(Path) = -2
      ProcedureReturn Path
    EndIf
  EndProcedure
  
  Procedure Open(AppName.s, File.s="Registry.xml", Publisher.s="")
    Protected *Node
    Global AppReg.AppRegStructure
    If GetPathPart(File) = "" ;{ Default Path
      File = GetDefaultPath(AppName, Publisher) + File
    EndIf ;}
    If FileSize(File) > 0 ;{ Registry vorhanden
      AppReg\id = LoadXML(#PB_Any, File, #PB_UTF8)
      If XMLStatus(AppReg\id) = #PB_XML_Success
        AppReg\File = File
        ProcedureReturn #True
      EndIf 
    EndIf ;}
    ;{ New Registry
    AppReg\id = CreateXML(#PB_Any, #PB_UTF8)
    If AppReg\id
      CompilerIf #PB_Compiler_Version >= 530
        *Node = CreateXMLNode(RootXMLNode(AppReg\id), "Registry")
        If *Node
          AppReg\File = File
          ProcedureReturn #True
        EndIf
      CompilerElse  
        *Node = CreateXMLNode(RootXMLNode(AppReg\id))
        If *Node
          SetXMLNodeName(*Node, "Registry") 
          AppReg\File = File
          ProcedureReturn #True
        EndIf
      CompilerEndIf  
    EndIf
    AppReg\File = ""
    ProcedureReturn #False
    ;}
  EndProcedure
  
  Procedure Close()
    If IsXML(AppReg\id) And AppReg\File
      If SaveXML(AppReg\id, AppReg\File)
        FreeXML(AppReg\id)
        ProcedureReturn #True
      Else
        FreeXML(AppReg\id)
        ProcedureReturn #False
      EndIf
    ElseIf IsXML(AppReg\id)
      FreeXML(AppReg\id)
      ProcedureReturn #False
    Else
      ProcedureReturn #False 
    EndIf
  EndProcedure
  
  Procedure Save()
    If IsXML(AppReg\id) And AppReg\File
      If SaveXML(AppReg\id, AppReg\File)
        ProcedureReturn #True
      EndIf
    EndIf
    ProcedureReturn #False 
  EndProcedure
  
  ;- Set / Get Value
  
  Procedure.s GetAppRegPath(hKey.s, key.s, Name.s)
    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 SetValue(hKey.s, key.s, Name.s, Value.s)
    Protected n.i, RegPath.s, NodeName.s, *MainNode, *Node, *LastNode
    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 ;{ New Node
          *LastNode = *MainNode
          For n = 1 To CountString(RegPath, "/")+1
            NodeName = StringField(RegPath, n, "/")
            *Node = XMLNodeFromPath(*LastNode, NodeName)
            If Not *Node
              CompilerIf #PB_Compiler_Version >= 530
                *Node = CreateXMLNode(*LastNode, NodeName, -1)
                If *Node
                  *LastNode = *Node
                EndIf
              CompilerElse
                *Node = CreateXMLNode(*LastNode, -1)
                If *Node
                  SetXMLNodeName(*Node, NodeName)
                  *LastNode = *Node
                EndIf
              CompilerEndIf
            Else
              *LastNode = *Node
            EndIf
          Next
        EndIf ;}
        If *Node
          SetXMLNodeText(*Node, XMLEncode(Value))
        EndIf
      EndIf
    EndIf
  EndProcedure
  
  Procedure SetInteger(hKey.s, key.s, Name.s, Value.i)
    SetValue(hKey, key, Name, Str(Value))
  EndProcedure
  
  Procedure SetFloat(hKey.s, key.s, Name.s, Value.f)
    SetValue(hKey, key, Name, StrF(Value))
  EndProcedure  
  
  Procedure.s GetValue(hKey.s, key.s, Name.s, DefaultValue.s="")
    Protected *MainNode, *Node, RegPath.s, Result.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
          Result = XMLDecode(GetXMLNodeText(*Node))
          If Result
            ProcedureReturn Result
          EndIf
        EndIf
      EndIf
    EndIf
    ProcedureReturn DefaultValue
  EndProcedure
  
  Procedure.i GetInteger(hKey.s, key.s, Name.s, DefaultValue.i=#Null)
    Protected Value.s = GetValue(hKey, key, Name, Str(DefaultValue))
    ProcedureReturn Val(Value)
  EndProcedure
  
  Procedure.f GetFloat(hKey.s, key.s, Name.s, DefaultValue.f=#Null)
    Protected Value.s = GetValue(hKey, key, Name, StrF(DefaultValue))
    ProcedureReturn ValF(Value)
  EndProcedure
  
  ;- Delete
  
  Procedure ClearChilds_AppReg(*CurrentNode)
    Protected *ChildNode
    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(hKey.s, key.s="")
    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 Delete(hKey.s, key.s, Name.s)
    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
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  Define Combo.i, Check.i, quitAppReg.l = #False
  #Window = 0
  Enumeration 1
    #Gadget_Frame1
    #Gadget_Frame2
    #Gadget_File
    #Gadget_Button
    #Gadget_ComboBox
    #Gadget_CheckBox
  EndEnumeration
  
  AppReg::Open("MyProg")
  
  If OpenWindow(#Window,90,96,240,124," Application Registry",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
    FrameGadget(#Gadget_Frame1,10,5,220,50,"Preference")
    FrameGadget(#Gadget_Frame2,10,65,220,50,"Remember Last Path")
    StringGadget(#Gadget_File,20,85,145,20,"",#PB_String_ReadOnly)
    ButtonGadget(#Gadget_Button,170,85,50,20,"Select")
    ComboBoxGadget(#Gadget_ComboBox,20,25,120,20)
    AddGadgetItem(#Gadget_ComboBox, 0, "Option 1")
    AddGadgetItem(#Gadget_ComboBox, 1, "Option 2")
    CheckBoxGadget(#Gadget_CheckBox,155,25,65,20," Option 3")
    HideWindow(#Window,0)
    
    Combo = AppReg::GetInteger("Preference", "General", "ComboBox", -1)
    SetGadgetState(#Gadget_ComboBox, Combo)
    Check = AppReg::GetInteger("Preference", "General", "CheckBox", 0)
    SetGadgetState(#Gadget_CheckBox, Check)
    
    Repeat 
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          AppReg::SetInteger("Preference", "General", "ComboBox", GetGadgetState(#Gadget_ComboBox))
          AppReg::SetInteger("Preference", "General", "CheckBox", GetGadgetState(#Gadget_CheckBox))
          quitAppReg = #True
        Case #PB_Event_Gadget
          If EventGadget() = #Gadget_Button
            File$ = OpenFileRequester("Open File", AppReg::GetValue("Intern", "Last", "Path", "C:\"), "All Files (*.*)|*.*", 0)
            If File$
              SetGadgetText(#Gadget_File, GetFilePart(File$))
              AppReg::SetValue("Intern", "Last", "Path", GetPathPart(File$))
            EndIf
          EndIf
      EndSelect
    Until quitAppReg
    CloseWindow(#Window)
  EndIf
  
  AppReg::Close()
  
CompilerEndIf
Zuletzt geändert von Thorsten1867 am 24.09.2017 16:50, insgesamt 6-mal geändert.
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Application Registry (Module)

Beitrag von ts-soft »

:allright:

Kannst Du folgenden Code noch modifizieren und einbauen?

Code: Alles auswählen

Procedure.s GetRegistryFile(AppName.s, FileName.s = "registry.xml", Publisher.s = "")
  Protected Path.s, slash.s
  
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Windows
      slash = "\"
      Path = GetEnvironmentVariable("APPDATA") + "\"
    CompilerDefault
      slash = "/"
      Path = GetHomeDirectory() + "."    
  CompilerEndSelect
  If Publisher
    Path + Publisher + slash
    If Not FileSize(Path) = - 2
      CreateDirectory(Path)
    EndIf
  EndIf
  Path + AppName + slash
  If Not FileSize(Path) = - 2
    CreateDirectory(Path)
  EndIf
  If FileSize(Path) = -2
    ProcedureReturn Path + FileName
  EndIf
EndProcedure
Weil dann wird dort gespeichert, wo man darf, es vom OS bestimmt ist und Dein Modul wird bei "ohne Schreibrechte" nicht versagen :mrgreen:
(ausserdem werden die Einsteiger gleich dazu genötigt, den richtigen Speicherort zu nutzen und nicht irgendwelche Angewohnheiten
des letzen Jahrzehnts beizubehalten :mrgreen: )


Gruß
Thomas
Zuletzt geändert von ts-soft am 15.02.2014 16:03, insgesamt 1-mal geändert.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Application Registry (Module)

Beitrag von RSBasic »

:allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Re: Application Registry (Module)

Beitrag von Thorsten1867 »

ts-soft hat geschrieben:Weil dann wird dort gespeichert, wo man darf, es vom OS bestimmt ist und Dein Modul wird bei "ohne Schreibrechte" nicht versagen :mrgreen:
Falls kein Pfad angegeben wird, wird nun der ermittelte Standard-Pfad verwendet.
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Application Registry (Module)

Beitrag von ts-soft »

Thorsten1867 hat geschrieben:Falls kein Pfad angegeben wird, wird nun der ermittelte Standard-Pfad verwendet.
Danke

Deine ErrorMessageBox macht das ganze WindowsOnly (nur wegen der beiden #MB_ Konstanten), das tut auch nicht not :wink:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Re: Application Registry (Module)

Beitrag von Thorsten1867 »

Ups, habe ich komplett übersehen. /:->
Brauche doch noch einmal ein installiertes PureBasic unter Linux.
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Re: Application Registry (Module)

Beitrag von Thorsten1867 »

Nicht wirklich "lebensnotwendig", aber praktisch:

Code: Alles auswählen

SetInteger(hKey.s, key.s, Name.s, Value.i)
GetInteger(hKey.s, key.s, Name.s, DefaultValue.i=#Null)
SetFloat(hKey.s, key.s, Name.s, Value.f)
GetFloat(hKey.s, key.s, Name.s, DefaultValue.f=#Null)
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Re: Application Registry (Module)

Beitrag von Thorsten1867 »

Anpassung des Standardpfades an den MAC (Code von poshu)
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Application Registry (Module)

Beitrag von ts-soft »

Thorsten1867 hat geschrieben:Anpassung des Standardpfades an den MAC (Code von poshu)
Naja, ich möchte mal bezweifeln, das PB 2 Verzeichnisebenen mit einem CreateDirectory erstellt :wink:
Oder existieren diese Verzeichnisse bereits?

Gruß
Thomas
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

Re: Application Registry (Module)

Beitrag von Thorsten1867 »

ts-soft hat geschrieben:Naja, ich möchte mal bezweifeln, das PB 2 Verzeichnisebenen mit einem CreateDirectory erstellt :wink:
Oder existieren diese Verzeichnisse bereits?
Habe keinen Mac und somit schlichtweg keine Ahnung. :wink:
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild
Antworten