It is currently Fri May 29, 2020 9:33 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 71 posts ]  Go to page Previous  1, 2, 3, 4, 5  Next
Author Message
 Post subject: Re: Registry Module (windows only)
PostPosted: Fri Jun 27, 2014 11:13 am 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
fixed! thanks to Crusiatus Black

and sorry for the delay.

_________________
PureBasic 5.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Tue Sep 02, 2014 6:48 am 
Offline
User
User

Joined: Sat Jun 07, 2014 10:12 am
Posts: 16
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:
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...


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Sep 04, 2014 10:09 am 
Offline
User
User

Joined: Sat Jun 07, 2014 10:12 am
Posts: 16
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:

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Sep 18, 2014 11:47 am 
Offline
User
User

Joined: Thu Mar 13, 2014 4:31 pm
Posts: 27
Hello.
Big Thanks @ ts-soft for the Code on the First page. i made a few changes :) Look in the Source
Code:

;======================================================================
; 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())
   


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Mon Jan 19, 2015 5:47 pm 
Offline
User
User

Joined: Sat Jan 17, 2015 5:24 pm
Posts: 20
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?


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Mon Jan 19, 2015 6:06 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4678
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Mon Jan 19, 2015 7:37 pm 
Offline
User
User

Joined: Sat Jan 17, 2015 5:24 pm
Posts: 20
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Fri Sep 04, 2015 4:05 pm 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
Update for some API, to use the new PB5.40

_________________
PureBasic 5.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Sep 24, 2015 10:34 am 
Offline
Addict
Addict

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 4710
Location: Germany
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:
  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


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Tue Apr 19, 2016 10:55 am 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4678
Location: Lyon - France
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:
Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState")
I have this result
Quote:
$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:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Tue Apr 19, 2016 2:05 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Dec 21, 2015 8:12 pm
Posts: 166
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)


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Tue Apr 19, 2016 2:59 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4678
Location: Lyon - France
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:
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:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Tue Apr 19, 2016 3:22 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Dec 21, 2015 8:12 pm
Posts: 166
Hi KCC,

how about this?
Code:
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.

Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Tue Apr 19, 2016 3:57 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4678
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Apr 21, 2016 11:50 am 
Offline
Addict
Addict

Joined: Sat Jun 30, 2007 8:04 pm
Posts: 3362
Another solution I wrote some time ago: http://purebasic.fr/english/viewtopic.php?f=12&t=43994


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 71 posts ]  Go to page Previous  1, 2, 3, 4, 5  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 16 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye