Registry Module (windows only)

Share your advanced PureBasic knowledge/code with the community.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Registry Module (windows only)

Post by ts-soft »

fixed! thanks to Crusiatus Black

and sorry for the delay.
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Sundance
User
User
Posts: 16
Joined: Sat Jun 07, 2014 10:12 am

Re: Registry Module (windows only)

Post by Sundance »

Hi ts-soft,

i have written a program which uses your registry.pb. Sometimes my programs halts with the following error:

Image

I isolated my problem till the line of code within the procedure WriteValue in the registry.pb.
When trying to free memory the pc stops:

Code: Select all

FreeMemory(*lpData)
I don't know what is the cause of the problem nor how i can prevent it. Do you have any hint for me?


thanks in advance
Sundance

PS: I can run the program only on a non developer pc. I think i need to run/debug the exe with the purifier. ATM i don't know how to achieve this...
Sundance
User
User
Posts: 16
Joined: Sat Jun 07, 2014 10:12 am

Re: Registry Module (windows only)

Post by Sundance »

Hi.

It seems i have found the problem. I made a mistake when allocating memory in the first lines of the program.
With the help of some lines of code i had found the heap problem i had created.
I have found a link to it somewhere in the internet here is the url to it:

http://www.purebasic.fr/blog/?p=55

This is really a cool thing and i think i will use it more often then i think. :-(

Made a module for easier usage:

Code: Select all


DeclareModule HeapTest
	Declare _TestHeaps(File$, Line)
EndDeclareModule

Module HeapTest

Procedure _TestHeaps(File$, Line)
      Protected StringHeap, MemoryBase, MemoryHeap

      CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
        !extrn _PB_StringHeap
        !extrn _PB_Memory_Heap         

        !mov eax, dword [_PB_StringHeap]
        !mov [p.v_StringHeap], eax
        !mov eax, dword [_PB_MemoryBase]
        !mov [p.v_MemoryBase], eax
        !mov eax, dword [_PB_Memory_Heap]
        !mov [p.v_MemoryHeap], eax
      CompilerElse
        !extrn PB_StringHeap
        !extrn PB_Memory_Heap

        !mov rax, qword [PB_StringHeap]
        !mov [p.v_StringHeap], rax
        !mov rax, qword [_PB_MemoryBase]
        !mov [p.v_MemoryBase], rax
        !mov rax, qword [PB_Memory_Heap]
        !mov [p.v_MemoryHeap], rax
      CompilerEndIf

      If HeapValidate_(StringHeap, 0, 0) = 0
        MessageRequester("StringHeap corrupted !", File$+" : "+Str(Line))
      EndIf

      If HeapValidate_(MemoryBase, 0, 0) = 0
        MessageRequester("MemoryBase heap corrupted !", File$+" : "+Str(Line))
      EndIf

      If HeapValidate_(MemoryHeap, 0, 0) = 0
        MessageRequester("AllocateMemory heap corrupted !", File$+" : "+Str(Line))
      EndIf
    EndProcedure

    Macro TestHeaps
      _TestHeaps(#PB_Compiler_File, #PB_Compiler_Line)
    EndMacro 
    
EndModule

see you guys
Sundance
Marty2PB
User
User
Posts: 47
Joined: Thu Mar 13, 2014 4:31 pm

Re: Registry Module (windows only)

Post by Marty2PB »

Hello.
Big Thanks @ ts-soft for the Code on the First page. i made a few changes :) Look in the Source

Code: Select all


;======================================================================
; Module:          Registry.pbi
;
; Author:          Thomas (ts-soft) Schulz, Martin Schäfer
; Date:            September 18, 2014
; Version:         1.4.2.1
; Target Compiler: PureBasic 5.2+
; Target OS:       Windows
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
; Target Test OS   Windows 7 (64Bit), Windows 8 (32Bit), WindowsXP (32Bit)
;======================================================================

; History:
; Version 1.4.2.2 Sep 18, 2014
; Module changed to RegEditEX
; Return Codes fixed
; + Reg File Import
; + Reg File Export (Using Original Microsoft Structure)
; DeleteTree works IN 64Bit mode on 32Bit Hive
; + Dynamic Hive Redirection
; + SubKeyExists
; Deletekey. it use only DeletKeyEX_ for Windows Version >=60
; and the old variant for Windows Version <= 53
; 

; Version 1.4.2, Jun 27, 2014
; fixed WriteValue

; Version 1.4.1, Sep 02, 2013
; fixed XP_DeleteTree()

; Version 1.4, Sep 02, 2013
; fixed Clear Resultstructure
; + compatibility to WinXP

; Version 1.3.3, Sep 01, 2013
; + Clear Resultstructure

; Version 1.3.2, Aug 31, 2013
; fixed a Bug with WriteValue and Unicode

; Version 1.3.1, Aug 30, 2013
; + DeleteTree() ; Deletes the subkeys and values of the specified key recursively.

; Version 1.3, Aug 30, 2013
; + ErrorString to RegValue Structure
; + RegValue to all Functions
; RegValue holds Errornumber and Errorstring!
; Renamed CountValues to CountSubValues

; Version 1.2.1, Aug 25, 2013
; source length reduced with macros

; Version 1.2, Aug 25, 2013
; + CountSubKeys()
; + CountValues()
; + ListSubKey()
; + ListSubValue()
; + updated example
;
; Version 1.1, Aug 25, 2013
; + ReadValue for #REG_BINARY returns a comma separate string with hexvalues (limited to 2096 bytes)
; + small example


;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;    
DeclareModule RegEditEX
        
     Structure RegValue
        TYPE.l                                                      ; like: #REG_BINARY, #REG_DWORD ...
        SIZE.l
        ERROR.l
        ERRORSTR.s
        DWORD.l                                                     ; #REG_DWORD
        QWORD.q                                                     ; #REG_QWORD
        *BINARY                                                     ; #REG_BINARY
        STRING.s                                                    ; #REG_EXPAND_SZ, #REG_MULTI_SZ, #REG_SZ
    EndStructure   

    Enumeration -1 Step -1
        #REG_ERR_ALLOCATE_MEMORY
        #REG_ERR_BINARYPOINTER_MISSING
        #REG_ERR_REGVALUE_VAR_MISSING
    EndEnumeration
    
    #LH_REGISTRYFILE=303
    Declare.i GetErrorCode()
    Declare.s GetErrorMsg()
        

    
    Declare.i ReadType(topKey,              ; like #HKEY_LOCAL_MACHINE, #HKEY_CURRENT_USER, #HKEY_CLASSES_ROOT ...
                       KeyName.s,           ; KeyName without topKey
                       ValueName.s = "",    ; ValueName, "" for Default
                       WOW64 = #False,      ; If #TRUE, uses the 'Wow6432Node' path for Key
                       *Ret.RegValue = 0)   ; result 0 = error or #REG_NONE (not supported)
    
    Declare.s ReadValue(topKey,KeyName.s,ValueName.s = "",WOW64 = #False,*Ret.RegValue = 0,FileExport=0)    
        
    Declare.i WriteValue(topKey,
                         KeyName.s,
                         ValueName.s,
                         Value.s,           ; Value as string
                         Type.l,            ; Type like: #REG_DWORD, #REG_EXPAND_SZ, #REG_SZ
                         WOW64 = #False,
                         *Ret.RegValue = 0) ; to return more infos, is required for #REG_BINARY!

    ; result 0 = error, > 0 = successfull (1 = key created, 2 = key opened)
 

    Declare.i CreateSubKey(topKey, SubKeyName.s ,WOW64 = #False, *Ret.RegValue = 0)
    
    Declare.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Declare.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Declare.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
    
    Declare.i CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Declare.i CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
 
    Declare.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)       ; the index is 0-based! 
    Declare.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0) 
    
    Declare.i SubKeyExists(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    
    Declare.i FileImport(RegistryFile$, WOW64 = #False) 
    Declare.i FileExport(RegistryFile$, ManagedKeyPath$,WOW64 = #False)
    
    Declare.s WindowsVersion(iSelect=0)                 
    
    ;Der Export keyPath auf 64Bit System wird ohne \WOW6432Node\ geschrieben, Kann man sich aber anpassen ;)
    
EndDeclareModule
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;    
Module RegEditEX         
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;  
        
  Prototype RegDeleteKeyEXW(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
  Prototype RegSetValueEXW(hKey.i, lpValueName.p-Unicode, Reserved.l, dwType.l, *lpData, cbData.l)
  Prototype RegDeleteTreeW(hKey.i, lpSubKey.p-Unicode = 0)    
  
  Global RegDeleteKeyEXW.RegDeleteKeyEXW
  Global RegSetValueEXW.RegSetValueEXW
  Global RegDeleteTreeW.RegDeleteTreeW
  
  Structure KEY_ITEM_COUNT
    KeyNames.l
    KeyPaths.l
  EndStructure

  Structure KEYS_NAME
    KeyValueID.l
    KeyName.s
    KeyData.s
  EndStructure

  Structure PATH_NAME
    KeyValueID.l
    KeyName.s
    KeyFullPath.s
  EndStructure
  
  Global NewList FullKeyPath.PATH_NAME()                          ; Alle gefundenen Dateien mit kompletten Pfad
  Global NewList FullKeyName.KEYS_NAME() 
  Global KEYCOUNT.KEY_ITEM_COUNT
            
  Structure REGCODES
          ERROR.l
          ERRORSTR.s
  EndStructure
  Global NewList RegCodes.REGCODES()
        AddElement(RegCodes()): RegCodes()\ERROR = 0
        AddElement(RegCodes()): RegCodes()\ERRORSTR.s = ""
  
  Define Advapi32dll.i
  
  Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
  If Advapi32dll
    RegDeleteKeyEXW  = GetFunction(Advapi32dll, "RegDeleteKeyExW")
    RegSetValueEXW   = GetFunction(Advapi32dll, "RegSetValueExW")
    RegDeleteTreeW   = GetFunction(Advapi32dll, "RegDeleteTreeW")
  EndIf 

  #KEY_WOW64_64KEY = $100
  #KEY_WOW64_32KEY = $200
  
  Macro OpenKey()
        If  #PB_Processor_x64
            If WOW64 = #True
                samDesired | #KEY_WOW64_64KEY
            Else
                samDesired | #KEY_WOW64_32KEY
            EndIf  
        Else
            samDesired | #KEY_WOW64_32KEY
        EndIf
   
        If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
        If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
   
        If *Ret <> 0: ClearStructure(*Ret, RegValue): EndIf
   
        error = RegOpenKeyEx_(topKey, KeyName, 0, samDesired, @hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            If hKey: RegCloseKey_(hKey): EndIf
            ProcedureReturn #False
        EndIf
  EndMacro 
  
  Macro OpenKeyS()
        If  #PB_Processor_x64
            If WOW64 = #True
                samDesired | #KEY_WOW64_64KEY
            Else
                samDesired | #KEY_WOW64_32KEY
            EndIf  
        Else
            samDesired | #KEY_WOW64_32KEY
        EndIf  
   
        If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
        If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
   
        If *Ret <> 0: ClearStructure(*Ret, RegValue): EndIf
   
        error = RegOpenKeyEx_(topKey, KeyName, 0, samDesired, @hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            If hKey: RegCloseKey_(hKey): EndIf
            ProcedureReturn ""
        EndIf
 EndMacro 

;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
    Procedure.s WindowsVersion(iSelect=0)
    Protected sMajor$, sMinor$, sBuild$, Version$, sPlatform$, SystemRoot$, iResult.l
    Define Os.OSVERSIONINFO
    Define WinVersion$


    Os\dwOSVersionInfoSize = SizeOf(OSVERSIONINFO)
    GetVersionEx_(@Os.OSVERSIONINFO)
    
    Select iSelect
    Case 0:
          sMajor$ = Str(Os\dwMajorVersion)
          sMinor$ = Str(Os\dwMinorVersion)
          ProcedureReturn sMajor$+sMinor$
    Case 1:
          sBuild$ = Str(Os\dwBuildNumber)
          ProcedureReturn sBuild$
    Case 2:
          sSPack$ = PeekS(@Os\szCSDVersion)
          ProcedureReturn sSPack$
    Case 4:
          sPlatform$    = Str(Os\dwPlatformId)
          sMajor$       = Str(Os\dwMajorVersion)
          sMinor$       = Str(Os\dwMinorVersion)        
          
          Version$= sPlatform$+"."+sMajor$+"."+sMinor$
          Select Version$
                  
              Case "1.0.0":     ProcedureReturn "Windows 95"
              Case "1.1.0":     ProcedureReturn "Windows 98"
              Case "1.9.0":     ProcedureReturn "Windows Millenium"
              Case "2.3.0":     ProcedureReturn "Windows NT 3.51"
              Case "2.4.0":     ProcedureReturn "Windows NT 4.0"
              Case "2.5.0":     ProcedureReturn "Windows 2000"
              Case "2.5.1":     ProcedureReturn "Windows XP"
              Case "2.5.3":     ProcedureReturn "Windows 2003 (SERVER)"
              Case "2.6.0":     ProcedureReturn "Windows Vista"
              Case "2.6.1":     ProcedureReturn "Windows 7"
              Case "2.6.2":     ProcedureReturn "Windows 8"             ;Build 9200                 
              Default:          ProcedureReturn "Unknown"
          EndSelect
          
      Case 5:
          If ExamineEnvironmentVariables()
              While NextEnvironmentVariable()
                  SystemRoot$ = EnvironmentVariableName()
                  If (LCase(SystemRoot$)="systemroot")
                      ProcedureReturn EnvironmentVariableValue() 
                          
                  EndIf
              Wend
          EndIf
          
      Case 6:
          If ExamineEnvironmentVariables()
               While NextEnvironmentVariable()
                  SystemRoot$ = EnvironmentVariableName()
                  If (LCase(SystemRoot$)="systemroot")
                      
                      iResult = FileSize(SystemRoot$+"SYSWOW64\")
                      If (iResult = -2)                        
                          ProcedureReturn EnvironmentVariableValue()+"\SYSWOW64\"
                      Else
                          ProcedureReturn EnvironmentVariableValue()+"\SYSTEM32\"
                      EndIf                                                
                  EndIf
              Wend
          EndIf          
                      
    EndSelect
    
      ;-----------------------------------------------------------------------------------------------        
      ; Get_WindowsVersion(iSelect=0), Holt die Aktuelle Windows Version, via iSelect lässt sich
      ; mehrere Information zurückgeben
      ; iSelect=5 gibt das Windows Root Verzeichnis Zurück
      ; iSelect=6 gibt das Windows System Verzeichnis Zurück
      ;-----------------------------------------------------------------------------------------------    
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
; 
    Procedure HiveFSRedirection(samDesired,WOW64)
   If  #PB_Processor_x64
        If WOW64 = #True
            ProcedureReturn samDesired | #KEY_WOW64_64KEY
        Else
            ProcedureReturn samDesired | #KEY_WOW64_32KEY
        EndIf   
    Else
      ProcedureReturn samDesired | #KEY_WOW64_32KEY
    EndIf  
    EndProcedure   
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;       
    Procedure.s GetLastErrorStr(error)
        Protected Buffer.i, result.s
   
            If FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER | #FORMAT_MESSAGE_FROM_SYSTEM, 0, error, 0, @Buffer, 0, 0)
            result = PeekS(Buffer)
            LocalFree_(Buffer)

            SelectElement(RegCodes(),0)
            RegCodes()\ERROR = error
            SelectElement(RegCodes(),1)
            RegCodes()\ERRORSTR = result
            
      ProcedureReturn result
    EndIf
  EndProcedure  
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;                                                                                              
    Procedure.i GetErrorCode(): SelectElement(RegCodes(),0): ProcedureReturn Regcodes()\ERROR: EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;  
    Procedure.s GetErrorMsg(): SelectElement(RegCodes(),1): ProcedureReturn Regcodes()\ERRORSTR: EndProcedure           
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;          
    Procedure CreateSubKey(topKey, SubKeyName.s ,WOW64 = #False, *Ret.RegValue = 0)
        
        Protected error, lpSecurityAttributes.SECURITY_ATTRIBUTES, hKey, create,samDesired = #KEY_ALL_ACCESS

        samDesired = HiveFSRedirection(samDesired,WOW64)  
               
        error = RegCreateKeyEx_(topKey, SubKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, samDesired, @lpSecurityAttributes, @hKey, @create)
        If *Ret <> 0
           *Ret\ERROR = error
           *Ret\ERRORSTR = GetLastErrorStr(error)
        EndIf
        GetLastErrorStr(error)    
        If hKey: RegCloseKey_(hKey): EndIf: ProcedureReturn createKey         
    EndProcedure    
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;     
    Procedure.i XP_DeleteTree(topKey, KeyName.s,WOW64, *RET.RegValue = 0)
        Protected hKey, error, dwSize.l, sBuf.s = Space(260), samDesired = #KEY_ENUMERATE_SUB_KEYS 
        
        samDesired = HiveFSRedirection(samDesired,WOW64)
        
        OpenKey()
        
;         If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
;         If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
;    
;         If *Ret <> 0: ClearStructure(*Ret, RegValue): EndIf
;         
;         error = RegOpenKeyEx_(topKey, @KeyName, 0, #KEY_ENUMERATE_SUB_KEYS, @hKey)
;         If error
;             If *Ret <> 0
;                 *Ret\ERROR = error
;                 *Ret\ERRORSTR = GetLastErrorStr(error)
;             EndIf
;             GetLastErrorStr(error)
;             
;             If hKey: RegCloseKey_(hKey): EndIf: ProcedureReturn #False
;         EndIf
        
       
        Repeat
            dwSize.l = 260
            error = RegEnumKeyEx_(hKey, 0, @sBuf, @dwSize, 0, 0, 0, 0)
            If Not error: XP_DeleteTree(hKey, sBuf,WOW64): EndIf
        Until error
        
        RegCloseKey_(hKey)
        error = RegDeleteKey_(topKey, KeyName)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn #True   
  EndProcedure      
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;      
    Procedure.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_ALL_ACCESS
        Protected hKey
        Protected SubKeyToRemove$
        
        samDesired = HiveFSRedirection(samDesired,WOW64)
        
        If RegDeleteTree = 0
            ProcedureReturn XP_DeleteTree(topKey, KeyName,WOW64, *RET)
        EndIf
   
        OpenKey()
   
        error = RegDeleteTreeW(hKey)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn #True   
    EndProcedure   
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;   
    Procedure.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_WRITE, WinVersion.i
   
        samDesired = HiveFSRedirection(samDesired,WOW64)
   
        If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
        If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
   
        WinVersion.i = Val(WindowsVersion())
        If (WinVersion.i >= 60)
            error = RegDeleteKeyEXW(topKey, KeyName, samDesired)
        ElseIf (WinVersion.i <= 53)
            error = RegDeleteKey_(topKey, KeyName) 
        EndIf
        
        If error
            If *Ret <> 0
                ClearStructure(*Ret, RegValue)
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn #True
    EndProcedure  
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;   
    Procedure.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_WRITE
        Protected hKey
   
        OpenKey()
   
        error = RegDeleteValue_(hKey, ValueName)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn #True         
    EndProcedure     
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
; 
    Procedure.i CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_READ
        Protected hKey, count
   
        OpenKey()
   
        error = RegQueryInfoKey_(hKey, 0, 0, 0, @count, 0, 0, 0, 0, 0, 0, 0)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn count
    EndProcedure    
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
; 
    Procedure.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_READ
        Protected hKey, size, result.s
   
        OpenKeyS()
   
        error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, @size, 0, 0, 0, 0, 0, 0)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            RegCloseKey_(hKey): ProcedureReturn ""
        EndIf
        
        size + 1
        result = Space(size)
        error = RegEnumKeyEx_(hKey, index, @result, @size, 0, 0, 0, 0)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): ProcedureReturn ""
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn result   
    EndProcedure    
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;  
    Procedure.i CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_READ
        Protected hKey, count
   
        OpenKey()
   
        error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, 0, 0, @count, 0, 0, 0, 0)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn count
    EndProcedure   
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;   
    Procedure.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_READ
        Protected hKey, size, result.s
   
        OpenKeyS()
   
        error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, 0, 0, 0, @size, 0, 0, 0)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            RegCloseKey_(hKey): ProcedureReturn ""
        EndIf
        
        size + 1
        result = Space(size)
        error = RegEnumValue_(hKey, index, @result, @size, 0, 0, 0, 0)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): ProcedureReturn ""
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn result   
    EndProcedure       
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;    
    Procedure.i ReadType(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_READ
        Protected hKey, lpType
   
        OpenKey()
   
        error = RegQueryValueEx_(hKey, ValueName, 0, @lpType, 0, 0)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            ProcedureReturn #False
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn lpType                
    EndProcedure  
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;         
    Procedure.s ReadValue(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 0,FileExport=0)                
        Protected error, result.s, samDesired = #KEY_READ
        Protected hKey, lpType.l, *lpData, lpcbData.l, ExSZlength, *ExSZMem, i
   
        OpenKeyS()
   
        error = RegQueryValueEx_(hKey, ValueName, 0, 0, 0, @lpcbData)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): RegCloseKey_(hKey): ProcedureReturn ""
        EndIf
   
        If lpcbData
            *lpData = AllocateMemory(lpcbData)
            If *lpData = 0
                If *Ret <> 0
                    *Ret\ERROR = #REG_ERR_ALLOCATE_MEMORY
                    *Ret\ERRORSTR = "Error: Can't allocate memory"
                EndIf
                SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_ALLOCATE_MEMORY
                SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: Can't allocate memory"
                RegCloseKey_(hKey): ProcedureReturn ""
            EndIf
        EndIf
   
        error = RegQueryValueEx_(hKey, ValueName, 0, @lpType, *lpData, @lpcbData)
        RegCloseKey_(hKey)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error): FreeMemory(*lpData): ProcedureReturn ""
        EndIf   
   
        If *Ret <> 0: *Ret\TYPE = lpType: EndIf
   
        Select lpType
            Case #REG_BINARY
                If lpcbData <= 2096
                    For i = 0 To lpcbData - 1
                        result + "$" + RSet(Hex(PeekA(*lpData + i)), 2, "0") + ","
                    Next
                Else
                    
                    For i = 0 To 2095
                        result + "$" + RSet(Hex(PeekA(*lpData + i)), 2, "0") + ","
                    Next
                EndIf
                result = Left(result, Len(result) - 1)
                
                If *Ret <> 0: *Ret\BINARY = *lpData: *Ret\SIZE = lpcbData :EndIf: ProcedureReturn result ; we don't free the memory!
       
            Case #REG_DWORD
                If *Ret <> 0
                    *Ret\DWORD = PeekL(*lpData)
                    *Ret\SIZE = SizeOf(Long)
                EndIf
                If FileExport=0
                    result = Str(PeekL(*lpData))
                EndIf
                If FileExport=1
                    result = Str(PeekL(*lpData))
                    iLenght = Len(result)
                    If (iLenght = 1)
                        result = "dword:0000000"+Str(PeekL(*lpData))
                     ElseIf (iLenght = 2)
                        result = "dword:000000"+Str(PeekL(*lpData))
                     ElseIf (iLenght = 3)
                        result = "dword:00000"+Str(PeekL(*lpData))                        
                     ElseIf (iLenght = 4)
                        result = "dword:0000"+Str(PeekL(*lpData))                        
                     ElseIf (iLenght = 5)
                        result = "dword:000"+Str(PeekL(*lpData))                        
                     ElseIf (iLenght = 6)
                        result = "dword:00"+Str(PeekL(*lpData))                        
                     ElseIf (iLenght = 7)
                        result = "dword:0"+Str(PeekL(*lpData))                        
                    EndIf
                      
                EndIf
       
            Case #REG_EXPAND_SZ
                ExSZlength = ExpandEnvironmentStrings_(*lpData, 0, 0)
                If ExSZlength > 0
                    *ExSZMem = AllocateMemory(ExSZlength)
                    If *ExSZMem
                        If ExpandEnvironmentStrings_(*lpData, *ExSZMem, ExSZlength)
                            result = PeekS(*ExSZMem)
                            If *Ret <> 0
                                *Ret\STRING = result
                                *Ret\SIZE = Len(result)
                            EndIf
                        EndIf
                        FreeMemory(*ExSZMem)
                    EndIf
                Else
                Debug "Error: Can't allocate memory"
                EndIf
       
            Case #REG_MULTI_SZ
                While i < lpcbData
                    If PeekS(*lpData + i, 1) = ""
                        result + #LF$
                    Else
                        result + PeekS(*lpData + i, 1)
                    EndIf
                    i + SizeOf(Character)
                Wend
                
                If Right(result, 1) = #LF$: result = Left(result, Len(result) - 1): EndIf
                If *Ret <> 0: *Ret\STRING = result: *Ret\SIZE = Len(result): EndIf
       
            Case #REG_QWORD
                If *Ret <> 0 :*Ret\QWORD = PeekQ(*lpData): *Ret\SIZE = SizeOf(Quad): EndIf
                  result = Str(PeekQ(*lpData))

       
            Case #REG_SZ
                If (*lpData <> 0)
                  result = PeekS(*lpData)
                EndIf
                If *Ret <> 0: *Ret\STRING = result: *Ret\SIZE = Len(result): EndIf
        EndSelect
        If (*lpData <> 0)
          FreeMemory(*lpData)
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn result
    EndProcedure    
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;    
    Procedure.i WriteValue(topKey, KeyName.s, ValueName.s, Value.s, Type.l, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_WRITE
        Protected hKey, *lpData, lpcbData.q, count, create, i, tmp.s, pos, temp1.l, temp2.q
   
        samDesired = HiveFSRedirection(samDesired,WOW64)  
   
        If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
        If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
   
        If *Ret <> 0
            If Type <> #REG_BINARY: ClearStructure(*Ret, RegValue)
            Else
                *Ret\TYPE = 0
                *Ret\ERROR = 0
                *Ret\ERRORSTR = ""
                *Ret\DWORD = 0
                *Ret\QWORD = 0
                *Ret\STRING = ""
            EndIf
        EndIf
   
        error = RegCreateKeyEx_(topKey, KeyName, 0, 0, 0, samDesired, 0, @hKey, @create)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            If hKey: RegCloseKey_(hKey): EndIf: ProcedureReturn #False
        EndIf
   
        Select Type
            Case #REG_BINARY
                If *Ret = 0
                    If *Ret <> 0
                        *Ret\ERROR = #REG_ERR_REGVALUE_VAR_MISSING
                        *Ret\ERRORSTR = "Error: Required *Ret.RegValue parameter not found!"
                    EndIf
                    SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_REGVALUE_VAR_MISSING
                    SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: Required *Ret.RegValue parameter not found!"
                    RegCloseKey_(hKey): ProcedureReturn #False
                EndIf
                
                lpcbData = *Ret\SIZE
                *lpData = *Ret\BINARY
                If *lpData = 0
                    If *Ret <> 0
                        *Ret\ERROR = #REG_ERR_BINARYPOINTER_MISSING
                        *Ret\ERRORSTR = "Error: No Pointer to BINARY defined!"
                    EndIf
                    SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_BINARYPOINTER_MISSING
                    SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: No Pointer to BINARY defined!" 
                    RegCloseKey_(hKey): ProcedureReturn #False         
                EndIf
                
                If lpcbData = 0: lpcbData = MemorySize(*lpData): EndIf
                
                error = RegSetValueEx_(hKey, ValueName, 0, #REG_BINARY, *lpData, lpcbData)
       
            Case #REG_DWORD
                temp1 = Val(Value)
                error = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @temp1, 4)
       
            Case #REG_QWORD
                temp2 = Val(Value)
                error = RegSetValueEx_(hKey, ValueName, 0, #REG_QWORD, @temp2, 8)
       
            Case #REG_EXPAND_SZ, #REG_SZ
                error = RegSetValueEx_(hKey, ValueName, 0, Type, @Value, StringByteLength(Value) + SizeOf(Character))
       
            Case #REG_MULTI_SZ
                count = CountString(Value, #LF$)
                For i = 0 To count
                    tmp = StringField(Value, i + 1, #LF$)
                    lpcbData + StringByteLength(tmp, #PB_Unicode) + 2
                Next
                
                If lpcbData
                    *lpData = AllocateMemory(lpcbData)
                    If *lpData
                        For i = 0 To count
                            tmp = StringField(Value, i + 1, #LF$)
                            PokeS(*lpData + pos, tmp, -1, #PB_Unicode)
                            pos + StringByteLength(tmp, #PB_Unicode) + 2
                        Next
                        error = RegSetValueEXW(hKey, ValueName, 0, Type, *lpData, lpcbData)
                        FreeMemory(*lpData)
                    Else
                        If *Ret <> 0
                            *Ret\ERROR = #REG_ERR_ALLOCATE_MEMORY
                            *Ret\ERRORSTR = "Error: Can't allocate memory"
                        EndIf
                        SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_ALLOCATE_MEMORY
                        SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: Can't allocate memory"
                        RegCloseKey_(hKey): ProcedureReturn #False           
                    EndIf
                EndIf       
            EndSelect
   
            RegCloseKey_(hKey)
            If error
                If *Ret <> 0
                    *Ret\ERROR = error
                    *Ret\ERRORSTR = GetLastErrorStr(error)
                EndIf
                GetLastErrorStr(error): ProcedureReturn #False
            EndIf
            GetLastErrorStr(error)
            ProcedureReturn create         
        EndProcedure         
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;
    Procedure.i SubKeyExists(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
        Protected error, samDesired = #KEY_READ
        Protected hKey, lpType, hKeyLabel
   
        OpenKey()
   
        error = RegOpenKeyEx_(hKey, ValueName, 0, samDesired, @hKeyLabel)
        RegCloseKey_(hKeyLabel)
        If error
            If *Ret <> 0
                *Ret\ERROR = error
                *Ret\ERRORSTR = GetLastErrorStr(error)
            EndIf
            GetLastErrorStr(error)
            ProcedureReturn error
        EndIf
        GetLastErrorStr(error)
        ProcedureReturn error                
    EndProcedure         
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;
    Procedure.i ConvertRegKey2TopAndKeyName(key$)
        Protected iPos.i
        
        Structure RegConverted
            TopKey.q
            Keyname$
        EndStructure
        
        Global NewList RegConverted.RegConverted()
        
        AddElement(RegConverted()): RegConverted()\TopKey.q = 0
        AddElement(RegConverted()): RegConverted()\Keyname$ = ""    
        
        iPos = FindString(key$,"HKEY_CLASSES_ROOT\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_CLASSES_ROOT
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_CLASSES_ROOT\","")
            ProcedureReturn
        EndIf 
        
        iPos = FindString(key$,"HKEY_CURRENT_CONFIG\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_CURRENT_CONFIG
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_CURRENT_CONFIG\","")
            ProcedureReturn
        EndIf            
        
        iPos = FindString(key$,"HKEY_CURRENT_USER\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_CURRENT_USER
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_CURRENT_USER\","")
            ProcedureReturn
        EndIf
        
        iPos = FindString(key$,"HKEY_DYN_DATA\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_DYN_DATA
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_DYN_DATA\","")
            ProcedureReturn
        EndIf
        
        iPos = FindString(key$,"HKEY_LOCAL_MACHINE\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_LOCAL_MACHINE
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_LOCAL_MACHINE\","")
            ProcedureReturn
        EndIf
        
        iPos = FindString(key$,"HKEY_PERFORMANCE_DATA\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_PERFORMANCE_DATA
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_PERFORMANCE_DATA\","")
            ProcedureReturn
        EndIf
        
        iPos = FindString(key$,"HKEY_USERS\")    
        If iPos <> 0
            SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_USERS
            SelectElement(RegConverted(),1)
            RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_USERS\","")
            ProcedureReturn
        EndIf
        Debug "Unknown: "+ key$
    EndProcedure 
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
; 
    Procedure FileImport_GetTypes(iSection$,iSectionsKey$,iRegistryFile$,topKey,WOW64=#False)
        
        Protected StrLng, iValue$, iDatas$, iResult, iErrorCode, DWordPos
        
        iSection$ = ReplaceString(iSection$,Chr(34),"")
        
        HexPos = FindString(iSection$,"hex:",1)
        If HexPos <> 0
            StrLng = Len(iSection$)
            
            ;// Multiline Hex Strings : Settings101"=hex:01,01,00,00,00,00,00,00,2f,04,00,00,01,00,00,00,00,00,00,00,\
            StrSlash = FindString(iSection$,"\",StrLng)
            If StrSlash <> 0
                iDatas$ = ""
                iBreak = #False
                If OpenFile(0,iRegistryFile$)
                    If ReadFile(0, iRegistryFile$)                 
                        
                        While Eof(0) = 0           
                            iLIneTC$ = ReadString(0, #PB_Unicode)
                            iLIneTC$ = ReplaceString(iLIneTC$,Chr(34),"")
                            iLIneLng = Len(iLIneTC$)
                            
                            If (iSection$ = iLIneTC$)
                                iDatas$ = iLIneTC$
                                
                                While Eof(0) = 0                
                                    iLIneTC$ = ReadString(0, #PB_Unicode):
                                    iLIneTC$ = ReplaceString(iLIneTC$,Chr(34),"")
                                    iLIneLng = Len(iLIneTC$)               
                                    iDatas$ = iDatas$+Trim(iLIneTC$)
                                    
                                    If (Len(iLIneTC$) = 0)
                                        iBreak = #True
                                        Break
                                    EndIf                          
                                    If (FindString(iLIneTC$,",\",iLIneLng-1) = 0)
                                        iBreak = #True
                                        Break
                                    EndIf
                                Wend
                            EndIf
                            If (iBreak = #True)
                                iSection$ = ReplaceString(iDatas$,Chr(92),"")
                                StrLng = Len(iSection$)
                                Break
                            EndIf
                        Wend
                    EndIf
                EndIf
                CloseFile(0)
            EndIf   
            
            iValue$ = Left(iSection$,HexPos-2): iDatas$ = Mid(iSection$,HexPos)
            iDatas$ = ReplaceString(iDatas$,"hex:",""): iDatas$ = ReplaceString(iDatas$,Chr(44),"")
            
            WriteValue(topKey, iSectionsKey$, iValue$, iDatas$,#REG_BINARY, WOW64): Debug GetErrorMsg(): ProcedureReturn
            
        Else
            DWordPos = FindString(iSection$,"dword:",1)
            If DWordPos <> 0
                StrLng = Len(iSection$)
                
                iValue$ = Left(iSection$,DWordPos-2): iDatas$ = Mid(iSection$,DWordPos)      
                iDatas$ = ReplaceString(iDatas$,"dword:",""): iDatasL = Val("$"+iDatas$)
                
                WriteValue(topKey, iSectionsKey$, iValue$, Str(iDatasL),#REG_DWORD, WOW64): Debug GetErrorMsg(): ProcedureReturn
                
            Else
                StrPos = FindString(iSection$,"=",1)
                If StrPos <> 0
                    StrLng = Len(iSection$)
                    
                    iValue$ = Left(iSection$,StrPos-1)
                    If Chr(64) = iValue$: iValue$ = "": EndIf
                    
                    iDatas$ = Mid(iSection$,StrPos+1): iDatas$ = ReplaceString(iDatas$,"\\","\")        
                    
                    WriteValue(topKey, iSectionsKey$, iValue$, iDatas$,#REG_SZ, WOW64): GetErrorMsg(): ProcedureReturn       
                EndIf
            EndIf
        EndIf       
EndProcedure  
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
; 
    Procedure FileImport_GetSectionsNames(path.s, List OutList.s())
        
        Protected  *adr, temp.s, 

        *buffer = AllocateMemory($4000)
        
        GetPrivateProfileSectionNames_(*buffer, $4000, path)
        *adr = *buffer
        Repeat
            temp = PeekS(*adr)
            If temp <> "": AddElement(OutList()): OutList() = temp: EndIf
            Debug temp
            *adr + Len(temp) + 1
        Until temp = ""
        FreeMemory(*buffer) 
    EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;         
    Procedure FileImport_GetSection(section.s, path.s, List OutList.s())
        
        Protected *buffer, *adr, temp.s
        
        *buffer = AllocateMemory($4000)
        
        GetPrivateProfileSection_(section, *buffer, $4000, path) 
        *adr = *buffer
        Repeat
            temp.s = PeekS(*adr)
            If temp <> "": AddElement(OutList()): OutList() = temp: EndIf
            *adr + Len(temp) + 1
        Until temp = ""
        FreeMemory(*buffer)
    EndProcedure        
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;         
    Procedure FileImport(RegistryFile$, WOW64=#False)        
        Protected Position.i, Size.i, HKey.q, SKey.s
        
        NewList SectionsNames.s()
        NewList Section.s()
        
        Size.i = FileSize(RegistryFile$)
        If (Size.i <> 0) Or (Size.i <> -1) 
            
            FileImport_GetSectionsNames(RegistryFile$, SectionsNames())
            
            ForEach SectionsNames()                         
                ConvertRegKey2TopAndKeyName(SectionsNames())
                
                SelectElement(RegConverted(),0): HKey.q = Regconverted()\TopKey.q
                SelectElement(RegConverted(),1): SKey.s = Regconverted()\Keyname$
                FreeList(RegConverted())
                
                CreateSubKey(HKey.q,  SKey.s ,WOW64)
                
                ClearList(Section())   
                FileImport_GetSection(SectionsNames(), RegistryFile$, Section())
                ForEach Section()
                    
                    Position = FindString(Section(),"=",1)
                    If (Position <> 0)                        
                        FileImport_GetTypes(Section(),SKey.s,RegistryFile$,HKey.q,WOW64):Debug Section()   
                    EndIf	                    
                Next
            Next
        EndIf
        
        FreeList(SectionsNames()): FreeList(Section())
    EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;       
    Procedure FileExport_CRLF(File$)
        If OpenFile(#LH_REGISTRYFILE,File$)
            FileSeek(#LH_REGISTRYFILE, Lof(#LH_REGISTRYFILE))
            WriteStringN(#LH_REGISTRYFILE, "",#PB_Ascii)
            CloseFile(#LH_REGISTRYFILE)
        EndIf
    EndProcedure 
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;       
    Procedure FileExport_SECT(File$,RegistryData$)
        If OpenFile(#LH_REGISTRYFILE,File$)
            FileSeek(#LH_REGISTRYFILE, Lof(#LH_REGISTRYFILE))
            WriteStringN(#LH_REGISTRYFILE, RegistryData$,#PB_Ascii)
            CloseFile(#LH_REGISTRYFILE)
        EndIf
    EndProcedure  
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;         
    Procedure FileExport_ADD(KeyName$,ManagedPath$,IndexID.i,Count.i)
        If Len(KeyName$) = 0 :ProcedureReturn #False: EndIf 
        
        ResetList(FullKeyPath())
        If ListSize(FullKeyPath()) = 0 
                   
        Else
            ResetList(FullKeyPath())
            While NextElement(FullKeyPath())
                If (FullKeyPath()\KeyName = KeyName$)
                  ProcedureReturn #False
                EndIf
            Wend
        EndIf
                
        AddElement(FullKeyPath())
          FullKeyPath()\KeyValueID  = IndexID.i
          FullKeyPath()\KeyName     = KeyName$
          FullKeyPath()\KeyFullPath = ManagedPath$+KeyName$ 
          ;Debug Str(IndexID.i)+"/"+Count+" ["+ManagedPath$+KeyName$+"]" 
        ProcedureReturn #True
      EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;         
    Procedure FileExport_COUT(HKey.q, SKey.s,WOW64,ManagedPath$)
      Protected iResult
      
      ManagedPath$ = ReplaceString(ManagedPath$,SKey.s,"")
      
      Cout = CountSubKeys(HKey.q, SKey.s,WOW64)
      For i = 0 To Cout - 1
        
        If  Cout <> 0      
          KeyName$ = ListSubKey(HKey.q, SKey.s,i,WOW64)
          
          If Len(KeyName$) <> 0
            SKey.s = SKey.s+"\"+KeyName$
            
            iResult = FileExport_ADD(SKey.s,ManagedPath$,i,Cout)
            If iResult = 1
              FileExport_COUT(HKey.q, SKey.s,WOW64,ManagedPath$)
            EndIf  
          EndIf

          SKey.s = ReverseString(SKey.s)
          iPos = FindString(SKey.s,"\",1)
          SKey.s  = Mid(SKey.s,iPOs+1,Len(SKey.s))
          SKey.s = ReverseString(SKey.s)
        EndIf         
      Next
 EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;
    Procedure FileExport_PREP(File$,ManagedKeyPath$,WOW64,RegistryFile$)
      Protected cout
      ConvertRegKey2TopAndKeyName(ManagedKeyPath$)
      
      SelectElement(RegConverted(),0): HKey.q = Regconverted()\TopKey.q
      SelectElement(RegConverted(),1): LKey.s = Regconverted()\Keyname$
      FreeList(RegConverted())
      
      FileExport_CRLF(RegistryFile$)
      FileExport_SECT(RegistryFile$,"["+ManagedKeyPath$+"]")
      
      cout = CountSubValues(HKey.q, LKey.s,WOW64)
      If cout <> 0
        For i = 0 To Cout - 1
          KeyName$ = ListSubValue(HKey.q, LKey.s, i, WOW64)
          KeyData$ = ReadValue(HKey.q, LKey.s, KeyName$, WOW64,0,1)

          If (Len(KeyName$) <> 0) And (Len(KeyData$) <> 0)
            KeyName$ = Chr(34)+KeyName$+Chr(34)
            
            iPos = FindString(KeyData$,"dword:",1)
            If iPos = 0
               KeyData$ = Chr(34)+KeyData$+Chr(34)
               KeyData$ = ReplaceString(KeyData$,"\","\\",1)
            Else
               KeyData$ = KeyData$
            EndIf
          Else
          
            If (Len(KeyName$) = 0) And (Len(KeyData$) <> 0)
                KeyName$ = "@"
                KeyData$ = Chr(34)+KeyData$+Chr(34)
            Else
                If (Len(KeyName$) = 0) And (Len(KeyData$) = 0)
                    KeyName$ = "@"
                    KeyData$ = Chr(34)+""+Chr(34)
                EndIf
            EndIf
          EndIf
          FileExport_SECT(RegistryFile$,KeyName$+"="+KeyData$)
        Next
      EndIf
     EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////    
;         
    Procedure FileExport(RegistryFile$,ManagedKeyPath$,WOW64=#False) 
        Protected iSubKeys.i, HKey.q, SKey.s, KeyName$

          If OpenFile(#LH_REGISTRYFILE,RegistryFile$)            
              WriteStringN(#LH_REGISTRYFILE, "Windows Registry Editor Version 5.00",#PB_UTF8)
              CloseFile(#LH_REGISTRYFILE)
          EndIf
               
          ConvertRegKey2TopAndKeyName(ManagedKeyPath$)
                
          SelectElement(RegConverted(),0): HKey.q = Regconverted()\TopKey.q
          SelectElement(RegConverted(),1): SKey.s = Regconverted()\Keyname$
          FreeList(RegConverted())        

          FileExport_PREP(File$,ManagedKeyPath$,WOW64,RegistryFile$)         
          FileExport_COUT(HKey.q, SKey.s,WOW64,ManagedKeyPath$)
          
          ResetList(FullKeyPath())
          While NextElement(FullKeyPath())           
               FileExport_PREP(File$,FullKeyPath()\KeyFullPath,WOW64,RegistryFile$)
          Wend
          FileExport_CRLF(RegistryFile$)
    EndProcedure
EndModule  

;/////////////////////////////////////////////////////////////////////////////////////////

; Commands
; 
; RegEditEX::ReadType(HighKey.i,LowKey$, ValueName.s, WOW64 = #False/#True)
; RegeditEX::ReadValue(HighKey.i,LowKey$,ValueName.s, WOW64 = #False/#True,0,0)
; 
; RegEditEX::WriteValue(HighKey.i,LowKey$, ValueName.s,Value.s,Type.l,WOW64 = #False/#True)
; RegEditEX::CreateSubKey(HighKey.i,LowKey$)
; 
; RegEditEX::DeleteTree(HighKey.i,LowKey$, WOW64 = #False/#True)
; RegEditEX::DeleteKey(HighKey.i,LowKey$, WOW64 = #False/#True)
; RegEditEX::DeleteValue(HighKey.i,LowKey$, ValueName.s, WOW64 = #False/#True)
; 
; RegEditEX::CountSubKeys(HighKey.i,LowKey$, WOW64 = #False/#True)
; RegEditEX::CountSubValues(HighKey.i,LowKey$, WOW64 = #False/#True)
; 
; RegEditEX::ListSubKey(HighKey, LowKey$.s, index, WOW64 = #False/#True) 
; RegEditEX::ListSubValue(HighKey, LowKey$.s, index, WOW64 = #False/#True) 
; 
; RegEditEX::FileImport(RegistryFile$, WOW64 = #False/False)
; RegEditEX::FileExport(RegistryFile$, ManagedKeyPath$,WOW64 = #False/False)
; 
; Die Hive Redirection läuft voll Automatisch. Sobald sich DAS programm auf einem 32Bit Basierten System befindet
; hat der WOW64 = #False/#True Redirection Wert keine Bedeutung mehr und alle Keys werden normal IN dem 32Bit Baum  
; bearbeitet. WOW64 = #False/#True Wert funktioniert NUR auf 64Bit Systemen 
; 
; Beispiele, Bitte auskommentieren , Successfully  Testet WindowsXP (32Bit), Windows 7 (64Bit), Windows 8 (32Bit)
MessageRequester("","Key Wird Erstellt (64Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit")
RegEditEX::CreateSubKey(#HKEY_LOCAL_MACHINE,"Software\Test64Bit",#True)
MessageRequester("",RegEditEX::GetErrorMsg())

MessageRequester("","Key Wird Erstellt (32Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test32Bit")
RegEditEX::CreateSubKey(#HKEY_LOCAL_MACHINE,"Software\Test32Bit")
MessageRequester("",RegEditEX::GetErrorMsg())

MessageRequester("","Überprüfe Key (64Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit")
RegEditEX::SubKeyExists(#HKEY_LOCAL_MACHINE, "Software\Test64Bit",#True)
MessageRequester("",RegEditEX::GetErrorMsg())

MessageRequester("","Überprüfe Key (32Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit (Fehler unter 64Bit muss erscheinen)")
RegEditEX::SubKeyExists(#HKEY_LOCAL_MACHINE, "Software\Test64Bit")
MessageRequester("",RegEditEX::GetErrorMsg())

MessageRequester("","Lösche Key (64Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit")
RegEditEX::DeleteKey(#HKEY_LOCAL_MACHINE, "Software\Test64Bit",#True)  
MessageRequester("",RegEditEX::GetErrorMsg())

MessageRequester("","Lösche Key (32Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test32Bit")
RegEditEX::DeleteKey(#HKEY_LOCAL_MACHINE, "Software\Test32Bit")  
MessageRequester("",RegEditEX::GetErrorMsg())

MessageRequester("","LIste und Zähle Keys auf (32Bit Hive) DisplayName/DisplayVersion"+#CRLF$+sSubKey$ )
    sSubKey$ = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    iView$ = ""
    count = RegEditEX::CountSubKeys(#HKEY_LOCAL_MACHINE, sSubKey$)
    For i = 0 To count - 1
      Ordner$ = RegEditEX::ListSubKey(#HKEY_LOCAL_MACHINE, sSubKey$, i)
      
      DisplayName$ = RegEditEX::ReadValue(#HKEY_LOCAL_MACHINE,sSubKey$+Ordner$+"\","DisplayName")
      DisplayVers$ = RegEditEX::ReadValue(#HKEY_LOCAL_MACHINE,sSubKey$+Ordner$+"\","DisplayVersion")      
      If (Len(DisplayName$) <> 0) And (Len(DisplayVers$) <> 0)
          iView$ = iView$+Str(i)+"/"+Str(count)+" ["+DisplayName$+"  ;  "+DisplayVers$+"]"+#CRLF$
          
          ;Debug Str(i)+"/"+Str(count)+" ["+DisplayName$+"  ;  "+DisplayVers$+"]"
      EndIf
    Next
    MessageRequester("",iView$)
    
    MessageRequester("","Exportiere 'HKEY_LOCAL_MACHINE\SOFTWARE\Adobe' Nach C:\Adobe.Reg vom 32Bit Hive")
    RegEditEX::FileExport("C:\AdobeExport.reg","HKEY_LOCAL_MACHINE\SOFTWARE\Adobe")
    
    MessageRequester("", "Import aus Spass C:\AdobeExport.reg nach 'HKEY_LOCAL_MACHINE\SOFTWARE\Adobe' in den 64Bit Hive")
    RegEditEX::FileImport("C:\AdobeExport.reg")
    
    MessageRequester("","Löche den Baum 'HKEY_LOCAL_MACHINE\SOFTWARE\Adobe' (64Bit Hive)")
    RegEditEX::DeleteTree(#HKEY_LOCAL_MACHINE,"SOFTWARE\Adobe")
    If RegEditEX::GetErrorCode() = 2
        RegEditEX::DeleteKey(#HKEY_LOCAL_MACHINE, "SOFTWARE\Adobe",#True)
    EndIf
    MessageRequester("",RegEditEX::GetErrorMsg())
   
k3pto
User
User
Posts: 50
Joined: Sat Jan 17, 2015 5:24 pm

Re: Registry Module (windows only)

Post by k3pto »

Hi,

I am very new to PB, still evaluating the demo version, and would like to try accessing the registry. I tried to use this library ( Registry.pbi by ts-soft) and the example but keep getting errors like:
RegOpenKeyEx_ is not a function (or not available in the demo version) array, list, map or macro. Is it a case of "not available in the demo version" or is there something else I am missing?
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Registry Module (windows only)

Post by Kwai chang caine »

Hello

With demo version you can't use API :wink:
In PB an API terminate always by an underscore like this :
RegCreateKeyEx_()
ImageThe happiness is a road...
Not a destination
k3pto
User
User
Posts: 50
Joined: Sat Jan 17, 2015 5:24 pm

Re: Registry Module (windows only)

Post by k3pto »

Hi Kwai Chang Caine,

Thank you, I was afraid it might be that. Other than this issue I have found PB to be quite easy to use.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Registry Module (windows only)

Post by ts-soft »

Update for some API, to use the new PB5.40
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Registry Module (windows only)

Post by infratec »

Hi,

maybe I'm a bit to stupid, but...

I needed to check if a key is available.
I found nothing which does this so I implemented:

Code: Select all

  Procedure.i IsKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected error, samDesired = #KEY_READ, hKey
   
    OpenKey()
    
    RegCloseKey_(hKey)
    
    ProcedureReturn #True
  EndProcedure
Or is there an other way?

Bernd
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Registry Module (windows only)

Post by Kwai chang caine »

Hello at all

I try to change a binary value with the splendid code of TsSoft without succes :oops:
I have search but not found numerous example about this function

When i run this line

Code: Select all

Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState")
I have this result
$24,$00,$00,$00,$33,$A8,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$01,$00,$00,$00,$12,$00,$00,$00,$00,$00,$00,$00,$22,$00,$00,$00
and i whant replacing the "$24,$00,$00,$00,$33" by "$24,$00,$00,$00,$37"

Someone can help me to use the write value

Code: Select all

WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", Valeur$ , #REG_BINARY)
Have a good day
ImageThe happiness is a road...
Not a destination
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Registry Module (windows only)

Post by fryquez »

You are using string parameter, but the first post says:
ts-soft wrote:Supports for Read and Write:
#REG_BINARY (requires the *Ret.RegValue parameter)
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Registry Module (windows only)

Post by Kwai chang caine »

Hello FRYQUEZ

In fact i don't understand how use this function
How sending binary

i have found this code of WOLF, but he using DATA, and i prefer using variable

Code: Select all

DataSection 
regbin_data: 
Data.b 0,1,2,3,4,5,6,7,8,9,128,255 ;byte in decimal ! 
end_regbin_data: 
EndDataSection 

openkey = #HKEY_LOCAL_MACHINE 
subkey.s = "SOFTWARE" 
keyset.s = "test" 
hkey.l = 0 

RegCreateKey_(OpenKey,SubKey,@hKey) 
RegSetValueEx_(hKey,keyset,0,#REG_BINARY,?regbin_data,?end_regbin_data - ?regbin_data) 
RegCloseKey_(hKey) 
So i have tried this, but obviously that not works :oops:

Code: Select all

UseModule Registry
 
 SentenceHex$ = "24,00,00,00,37,A8,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,00,00,00,12,00,00,00,00,00,00,00,22,00,00,00" 
 Size = CountString(SentenceHex$, ",") + 1
 *PtrMem = AllocateMemory(Size)
 Offset = 0
 
 For i = 1 To Size
  
  Hex$ = StringField(SentenceHex$, i, ",")
  Bin = Hex2Dec(Hex$)
  PokeB(*PtrMem + Offset, Bin)
  Offset + 1
  
 Next
  
 If WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState", "", #REG_BINARY, #False, *PtrMem)
 
  Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState")
     
 EndIf
ImageThe happiness is a road...
Not a destination
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Registry Module (windows only)

Post by fryquez »

Hi KCC,

how about this?

Code: Select all

UseModule Registry


 RegValue.RegValue
 RegValue\TYPE = #REG_BINARY
 
 ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState", 0, RegValue)
 
If RegValue\SIZE >= 5
  
  ;change the bytes you want
  PokeB(RegValue\BINARY + 4, $37)
  
  If WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState", Valeur$, #REG_BINARY, #False, RegValue)
    
    Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState")
    
  EndIf
  
EndIf

ClearStructure(RegValue, RegValue)
BTW: be careful with "ShellState", it stores settings in bits. So changing 1 byte can effect more than one setting.
Last edited by fryquez on Tue Apr 19, 2016 5:03 pm, edited 1 time in total.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Registry Module (windows only)

Post by Kwai chang caine »

Waaaaaoouuuh !!! :shock:

Exactely what i search, since a long time :D
Thanks a lot for your precious first help to the worst programing man in the world (perhaps even the universe) :mrgreen:

Have a very good day FRYQUEZ 8)
ImageThe happiness is a road...
Not a destination
Mistrel
Addict
Addict
Posts: 3415
Joined: Sat Jun 30, 2007 8:04 pm

Re: Registry Module (windows only)

Post by Mistrel »

Another solution I wrote some time ago: http://purebasic.fr/english/viewtopic.php?f=12&t=43994
Post Reply