Aktuelle Zeit: 28.03.2020 19:44

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste
Autor Nachricht
 Betreff des Beitrags: Application Registry (Module)
BeitragVerfasst: 15.02.2014 15:12 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
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:
;/ ===== 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$, "&lt;", "<")
    txt$ = ReplaceString(txt$, "&gt;", ">")
    txt$ = ReplaceString(txt$, "&apos;", "'")
    txt$ = ReplaceString(txt$, "&quot;", Chr(34))
    txt$ = ReplaceString(txt$, "&#128", "€")
    ProcedureReturn Trim(txt$)
  EndProcedure
 
  Procedure.s XMLEncode(txt$)
    Define xml$
    xml$ = ReplaceString(txt$, "&", "&amp;")
    xml$ = ReplaceString(xml$, "<", "&lt;")
    xml$ = ReplaceString(xml$, ">", "&gt;")
    xml$ = ReplaceString(xml$, "'", "&apos;")
    xml$ = ReplaceString(xml$, "€", "&#128")
    xml$ = ReplaceString(xml$, Chr(34), "&quot;")
    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

_________________
Download der Module

Bild


Zuletzt geändert von Thorsten1867 am 24.09.2017 16:50, insgesamt 6-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 15.02.2014 16:00 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
:allright:

Kannst Du folgenden Code noch modifizieren und einbauen?
Code:
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

_________________
PureBasic 5.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild


Zuletzt geändert von ts-soft am 15.02.2014 16:03, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 15.02.2014 16:03 
Offline
Admin
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
:allright:

_________________
BildBildBildBild BildBild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 15.02.2014 16:27 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
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 der Module

Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 15.02.2014 16:43 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
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.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 15.02.2014 16:51 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Ups, habe ich komplett übersehen. /:->
Brauche doch noch einmal ein installiertes PureBasic unter Linux.

_________________
Download der Module

Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 15.02.2014 17:27 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Nicht wirklich "lebensnotwendig", aber praktisch:
Code:
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 der Module

Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 18.02.2014 21:10 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
Anpassung des Standardpfades an den MAC (Code von poshu)

_________________
Download der Module

Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 18.02.2014 21:15 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
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.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Application Registry (Module)
BeitragVerfasst: 18.02.2014 21:20 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
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 der Module

Bild


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 13 Beiträge ]  Gehe zu Seite 1, 2  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye