Registry Module (windows only)

Share your advanced PureBasic knowledge/code with the community.
ZX80
Enthusiast
Enthusiast
Posts: 330
Joined: Mon Dec 12, 2016 1:37 pm

Re: Registry Module (windows only)

Post by ZX80 »

ts-soft & HeX0R, please could you fix your code to work without unicode. I used Registry::ListSubKey and got not correct value of hive (name). With turn on unicode all is okay.
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: Registry Module (windows only)

Post by Thunder93 »

I personally don't see any reason why It shouldn't work regardless. Anyways, this'll definitely work regardless.

Code: Select all

  Procedure.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
    Protected error, samDesired = #KEY_READ
    Protected hKey, size, result.s, *iPtr
   
    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
      Debug GetLastErrorStr(error)
      RegCloseKey_(hKey)
      ProcedureReturn ""
    EndIf
    
    size*2+1
    
    *iPtr = AllocateMemory(size+1)
    
    error = RegEnumKeyEx(hKey, index, *iPtr, @size, 0, 0, 0, 0)
    RegCloseKey_(hKey)
    If error
      If *Ret <> 0
        *Ret\ERROR = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn ""
    EndIf
    
    result = PeekS(*iPtr, -1, #PB_Unicode)
    
    If *iPtr : FreeMemory(*iPtr) : EndIf
    
    ProcedureReturn result
  EndProcedure
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: Registry Module (windows only)

Post by Thunder93 »

Never mind, I see that RegEnumKeyEx is prototyped. That is why.. :p

In the ListSubKey() procedure, change RegEnumKeyEx() to RegEnumKeyEx_(). :wink:
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
ZX80
Enthusiast
Enthusiast
Posts: 330
Joined: Mon Dec 12, 2016 1:37 pm

Re: Registry Module (windows only)

Post by ZX80 »

Thunder93
Many thanks! It works.
Dude
Addict
Addict
Posts: 1907
Joined: Mon Feb 16, 2015 2:49 pm

Re: Registry Module (windows only)

Post by Dude »

Is the code in the first post still valid, or need updating? I see so many corrections throughout these 5 pages of discussion that I don't know if I'm using valid code for it. It's too confusing to reconcile it all.
User avatar
blueb
Addict
Addict
Posts: 1041
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: Registry Module (windows only)

Post by blueb »

Dude
I show...

Code: Select all

; History:
; Version 1.5.1, May 27, 2016
; fixed ExpandEnvironmentStrings()
; + CopyTree()
Not sure how I got it, but it's here if you need it.
- It was too lonely at the top.

System : PB 6.10 Beta 9 (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
Dude
Addict
Addict
Posts: 1907
Joined: Mon Feb 16, 2015 2:49 pm

Re: Registry Module (windows only)

Post by Dude »

blueb wrote:; Version 1.5.1, May 27, 2016
; fixed ExpandEnvironmentStrings()
it's here if you need it.
Yes, it's the error with ExpandEnvironmentStrings() that I'm getting.

I found the 1.5.1 version hidden in the middle of this thread:

http://www.purebasic.fr/english/viewtop ... 11#p488711

The first post really needs to be edited to show this latest version.
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: Registry Module (windows only)

Post by Thunder93 »

Code: Select all

;======================================================================
; Module:          Registry.pbi
;
; Author:          Thomas (ts-soft) Schulz
; Date:            Feb 25, 2017
; Version:         1.5.2
; Target Compiler: PureBasic 5.2+
; Target OS:       Windows
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;======================================================================

; History:
; Version 1.5.2, Feb 25, 2017  (by Thunder93)
; fixed ListSubKey() to work under ASCII mode

; Version 1.5.1, May 27, 2016  (by HeX0R)
; fixed ExpandEnvironmentStrings()
; + CopyTree()

; Version 1.5.0, Sep 04, 2015
; fixed for Use with PB5.40 and higher

; 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 Registry
  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
  
  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)
  ; result "" = error
  
  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 DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
  ; Deletes the subkeys and values of the specified key recursively.
  ; result 0 = error
  
  Declare.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
  ; result 0 = error
  
  Declare.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
  ; result 0 = error
  
  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 CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
  
EndDeclareModule

Module Registry
  EnableExplicit
  
  Prototype RegDeleteKey(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
  Prototype RegSetValue(hKey.i, lpValueName.p-Unicode, Reserved.l, dwType.l, *lpData, cbData.l)
  Prototype RegDeleteTree(hKey.i, lpSubKey.p-Unicode = 0)
  Prototype RegEnumKeyEx(hKey.i, dwIndex.l, *lpName, *lpcName, *lpReserved, *lpClass, *lpcClass, *lpftLastWriteTime)
  Prototype RegCopyTree(hKeySrc.i, *lpSubKey, hKeyDest.i)
  
  Global RegDeleteKey.RegDeleteKey
  Global RegSetValue.RegSetValue
  Global RegDeleteTree.RegDeleteTree
  Global RegEnumKeyEx.RegEnumKeyEx
  Global RegCopyTree.RegCopyTree
  
  Define dll.i
  
  dll = OpenLibrary(#PB_Any, "Advapi32.dll")
  If dll
    
    RegDeleteKey             = GetFunction(dll, "RegDeleteKeyExW")
    RegSetValue              = GetFunction(dll, "RegSetValueExW")
    RegDeleteTree            = GetFunction(dll, "RegDeleteTreeW")
    RegEnumKeyEx             = GetFunction(dll, "RegEnumKeyExW")
    RegCopyTree              = GetFunction(dll, "RegCopyTreeW")
    
    
  EndIf
  
  #KEY_WOW64_64KEY = $100
  #KEY_WOW64_32KEY = $200
  
  Macro OpenKey()
    If WOW64
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
        samDesired | #KEY_WOW64_64KEY
      CompilerElse
        samDesired | #KEY_WOW64_32KEY
      CompilerEndIf
    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
      Debug GetLastErrorStr(error)
      If hKey
        RegCloseKey_(hKey)
      EndIf
      ProcedureReturn #False
    EndIf
  EndMacro
  
  Macro OpenKeyS()
    If WOW64
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
        samDesired | #KEY_WOW64_64KEY
      CompilerElse
        samDesired | #KEY_WOW64_32KEY
      CompilerEndIf
    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
      Debug GetLastErrorStr(error)
      If hKey
        RegCloseKey_(hKey)
      EndIf
      ProcedureReturn ""
    EndIf
  EndMacro
  
  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)
      
      ProcedureReturn result
    EndIf
  EndProcedure
  
  Procedure.i XP_DeleteTree(topKey, KeyName.s, *Ret.RegValue = 0)
    Protected hKey, error, dwSize.l, sBuf.s = Space(260)
    
    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
      Debug 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)
      EndIf
    Until error
    RegCloseKey_(hKey)
    error = RegDeleteKey_(topKey, KeyName)
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected error, samDesired = #KEY_ALL_ACCESS
    Protected hKey
    
    If RegDeleteTree = 0
      ProcedureReturn XP_DeleteTree(topKey, KeyName, *Ret)
    EndIf
    
    OpenKey()
    
    error = RegDeleteTree(hKey)
    RegCloseKey_(hKey)
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected error, samDesired, create
    Protected hKey, hKeyD, topKey, KeyName.s
    
    If OSVersion() < #PB_OS_Windows_Vista
      ProcedureReturn #False
    EndIf
    
    topKey     = topKeySource
    KeyName    = KeyNameSource
    samDesired = #KEY_READ
    
    OpenKey()
    
    If hKey
      
      error = RegCreateKeyEx_(topKeyDestination, KeyNameDestination, 0, #Null$, 0, #KEY_ALL_ACCESS, 0, @hKeyD, @create)
      
      If hKeyD
        error = RegCopyTree(hKey, #Null, hKeyD)
        RegCloseKey_(hKeyD)
      EndIf
      
      RegCloseKey_(hKey)
    EndIf
    
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
  
  
  Procedure.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected error, samDesired = #KEY_WRITE
    
    If WOW64
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
        samDesired | #KEY_WOW64_64KEY
      CompilerElse
        samDesired | #KEY_WOW64_32KEY
      CompilerEndIf
    EndIf
    
    If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
    If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
    
    If RegDeleteKey
      error = RegDeleteKey(topKey, KeyName, samDesired)
    Else
      error = RegDeleteKey_(topKey, KeyName)
    EndIf
    If error
      If *Ret <> 0
        ClearStructure(*Ret, RegValue)
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    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
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    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
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    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
      Debug 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
      Debug GetLastErrorStr(error)
      ProcedureReturn ""
    EndIf
    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
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    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
      Debug 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
      Debug GetLastErrorStr(error)
      ProcedureReturn ""
    EndIf
    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
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    ProcedureReturn lpType
  EndProcedure
  
  Procedure.s ReadValue(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 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
      Debug 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
        Debug "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
      Debug 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
        result = Str(PeekL(*lpData))
        
      Case #REG_EXPAND_SZ
        ExSZlength = ExpandEnvironmentStrings_(*lpData, 0, 0)
        If ExSZlength > 0
          ExSZlength + 1
          CompilerIf #PB_Compiler_Unicode
            ExSZlength * 2
          CompilerEndIf
          *ExSZMem = AllocateMemory(ExSZlength)
          If *ExSZMem
            If ExpandEnvironmentStrings_(*lpData, *ExSZMem, ExSZlength)
              result = PeekS(*ExSZMem, ExSZlength)
              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
        result = PeekS(*lpData)
        If *Ret <> 0
          *Ret\STRING = result
          *Ret\SIZE   = Len(result)
        EndIf
    EndSelect
    
    FreeMemory(*lpData)
    
    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
    
    If WOW64
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
        samDesired | #KEY_WOW64_64KEY
      CompilerElse
        samDesired | #KEY_WOW64_32KEY
      CompilerEndIf
    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
      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, #Null$, 0, samDesired, 0, @hKey, @create)
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug 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
          Debug "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
          Debug "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 = RegSetValue(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
            Debug "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
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    
    ProcedureReturn create
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Define count, i
  
  count = Registry::CountSubValues(#HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices")
  For i = 0 To count - 1
    Debug Registry::ListSubValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", i)
  Next
  
  Debug "-----------------------"
  
  UseModule Registry
  
  Define.s Multi_SZ_Str = "ts-soft" + #LF$ + "Software-Development" + #LF$ + #LF$ + "Copyright 2013" + #LF$ + "Programmed in PureBasic"
  
  If  WriteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo", Multi_SZ_Str, #REG_MULTI_SZ)
    Debug ReadValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo")
    Select MessageRequester("Registry-Example", "Delete the demo Registry-Value?", #PB_MessageRequester_YesNo)
      Case #PB_MessageRequester_Yes
        If DeleteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo")
          Debug "Value deleted"
        Else
          Debug "Value not deleted"
        EndIf
    EndSelect
  EndIf
CompilerEndIf
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
Dude
Addict
Addict
Posts: 1907
Joined: Mon Feb 16, 2015 2:49 pm

Re: Registry Module (windows only)

Post by Dude »

Thanks, Thunder93!
User avatar
Thunder93
Addict
Addict
Posts: 1788
Joined: Tue Mar 21, 2006 12:31 am
Location: Canada

Re: Registry Module (windows only)

Post by Thunder93 »

Anytime Dude. :mrgreen:
ʽʽSuccess is almost totally dependent upon drive and persistence. The extra energy required to make another effort or try another approach is the secret of winning.ʾʾ --Dennis Waitley
camille
User
User
Posts: 66
Joined: Tue Nov 19, 2019 12:52 pm

Re: Registry Module (windows only)

Post by camille »

Regarding v1.5.2 from Thunder93:

Does DeleteTree() really work?

If I use the demo at the bottom of the code and change this line:

Code: Select all

If DeleteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo")
into this:

Code: Select all

If DeleteTree(#HKEY_CURRENT_USER, "Software\ts-soft")
It says that it was deleted but looking at HKEY_CURRENT_USER\Software afterwards it's still there

Windows 10 here...
jacky
User
User
Posts: 63
Joined: Mon Jan 21, 2019 1:41 pm

Re: Registry Module (windows only)

Post by jacky »

Is this a bug or should it work this way for DeleteTree()?

I create a key "HKEY_CURRENT_USER\Software\abc"
and add an empty string value to it, named "huhu"

Code: Select all

Registry::DeleteTree(#HKEY_CURRENT_USER, "Software\abc")
will delete the string value but it won't delete the "abc" (sub-) key...
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Registry Module (windows only)

Post by AZJIO »

How to enter data in the register?
Figured out!

Code: Select all

EnableExplicit

XIncludeFile "Registry.pbi"
UseModule Registry

 Define RegValue.RegValue
 RegValue\TYPE = #REG_BINARY
 

Define Key$ = "\Software\Microsoft\Windows\CurrentVersion\Explorer\Modules\GlobalSettings\Sizer"
 
; ShowMemoryViewer(?RegVal3, 16)
; CallDebugger
; End
; Debug ?RegVal3end - ?RegVal3


RegValue\BINARY = ?RegVal3
RegValue\SIZE = ?RegVal3end - ?RegVal3
WriteValue(#HKEY_CURRENT_USER, Key$, "DetailsContainerSizer", "", #REG_BINARY, #False, RegValue)
RegValue\BINARY = ?RegVal4
RegValue\SIZE = ?RegVal4end - ?RegVal4
WriteValue(#HKEY_CURRENT_USER, Key$, "PageSpaceControlSizer", "", #REG_BINARY, #False, RegValue)

Delay(700)
; Тут возвращаем старые значения реестра

DataSection
    RegVal1:
    Data.b $35,$00,$00,$00,$01,$00,$00,$00,$00,$00,$00,$00,$0f,$02,$00,$00
    RegVal1end:
    
    RegVal2:
    Data.b $a0,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$10,$03,$00,$00
    RegVal2end:
   
    RegVal3:
    Data.b $15,$01,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$5b,$03,$00,$00
    RegVal3end:
    
    RegVal4:
    Data.b $e9,$00,$00,$00,$01,$00,$00,$00,$00,$00,$00,$00,$fa,$02,$00,$00
    RegVal4end:
EndDataSection
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Registry Module (windows only)

Post by AZJIO »

How to verify that a key exists and a parameter exists (not a parameter value because it may be empty)?
ExistsKey() --- ?
ExistsValue() --- ?

I check using enumeration and it doesn't work for me.

Code: Select all

count2 = CountSubValues(HK2, RegPath4$)
If count2 And count2 < 5
	k + 1
	Fine = 0
	For e = 0 To count2 - 1
		tmp$ = ListSubValue(HK2, RegPath4$, e)
		Debug tmp$
		Debug count2
		If tmp$ = "SubCommands"
			Fine = 1
			Break
		EndIf
	Next
EndIf
Previously, I did it using this function, but I hoped that there is something similar in the module

Code: Select all

Procedure RegExistsName(Root, KeyPath$, ValueName$)
	Protected hKey
	If #ERROR_SUCCESS = RegOpenKeyEx_(Root,KeyPath$,0,#KEY_READ,@hKey)
		If #ERROR_SUCCESS = RegQueryValueEx_(hKey,ValueName$,0,0,0,0)
			ProcedureReturn 1
		Else
			ProcedureReturn 0
		EndIf
		RegCloseKey_(hKey)
	Else
		ProcedureReturn -1 ; 0, if necessary boolean
	EndIf
EndProcedure
AZJIO
Addict
Addict
Posts: 1318
Joined: Sun May 14, 2017 1:48 am

Re: Registry Module (windows only)

Post by AZJIO »

Made help "Registry Module" in Russian language using the AutoIt3 compiler.
Post Reply