PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Registry Module (windows only)

https://www.purebasic.fr/english/viewtopic.php?t=56204

Page 6 of 7

Re: Registry Module (windows only)

Posted: Thu Jan 06, 2022 5:36 am
by AZJIO
Gives an error

Code: Select all

XIncludeFile "Registry.pbi"
UseModule Registry
Debug ReadValue(#HKEY_CLASSES_ROOT, "batfile\shell\runas\command", "")
Debug ReadValue(#HKEY_CLASSES_ROOT, "VBSFile\Shell\Open2", "")
On line 525

Code: Select all

      Case #REG_EXPAND_SZ
        ExSZlength = ExpandEnvironmentStrings(*lpData, 0, 0)
5.72 x32/x64
Win10 x64 1809

Re: Registry Module (windows only)

Posted: Thu Jan 06, 2022 12:19 pm
by ChrisR
It works without any problem here:

Code: Select all

C:\Windows\System32\cmd.exe /C "%1" %*
Open &with Command Prompt
Is it related to Russian Cyrillic characters for you ?

Re: Registry Module (windows only)

Posted: Thu Jan 06, 2022 2:53 pm
by AZJIO
1. there is no cyrillic alphabet in both registry keys. It's not the first time I use the module, it works fine with Cyrillic
2. I temporarily made the WinAPI function, given that I only need to get strings. Source (Line 217-222)

Code: Select all

Procedure.s RegRead(Root, KeyPath$, ValueName$)
	Protected Size, ValueData$, hKey, Type
	If #ERROR_SUCCESS = RegOpenKeyEx_(Root,KeyPath$,0,#KEY_READ,@hKey)
		If #ERROR_SUCCESS = RegQueryValueEx_(hKey,ValueName$,0,@Type,0,@Size)
			ValueData$=Space(Size)
			If #ERROR_SUCCESS = RegQueryValueEx_(hKey,ValueName$,0,0,@ValueData$,@Size)
			EndIf
		EndIf
		RegCloseKey_(hKey)
	EndIf
	ProcedureReturn ValueData$
EndProcedure
3. Rebooted for prevention. The problem was not eliminated.
4. There are no special differences, other file extensions work.
5. I was confused by the fact that I am reading the line #REG_SZ, and an error is issued on the data type #REG_EXPAND_SZ.

Re: Registry Module (windows only)

Posted: Thu Jan 06, 2022 3:55 pm
by fryquez
There are 2 bugs with #REG_EXPAND_SZ.

1. ExpandEnvironmentStringsW is not located in advapi32.dll
2. ExpandEnvironmentStringsW does expects the size in Characters

Change all calls from ExpandEnvironmentStringsW to ExpandEnvironmentStrings_

and change this line

*ExSZMem = AllocateMemory(ExSZlength)

to

*ExSZMem = AllocateMemory(ExSZlength * 2)

Re: Registry Module (windows only)

Posted: Sun Aug 25, 2024 2:44 pm
by hdt888
Why error Access is denied ?.

Code: Select all

DeleteKey(#HKEY_CURRENT_USER, "SOFTWARE\Classes\my-app", #True, 0)
Test on Win10 x64 + PB 6.0 32bit.

Re: Registry Module (windows only)

Posted: Tue Aug 27, 2024 3:21 pm
by Axolotl
hey hdt888, you have the source code. Look in there, use breakpoints or supplement it with debug output and then... You will find it yourself.

Re: Registry Module (windows only)

Posted: Thu Nov 21, 2024 1:52 am
by Randy Walker
olmak wrote: Thu Aug 11, 2016 4:37 am Hello at all
I'm trying to get a list of installed programs, with some parameters.
Can anyone help me?
I can't promise this will satisfy or even help. Might try researching that "wmic"
line command to see if/what other parameters are available.
Tested in PB 5.40 and 6.12 on Win 11.

Code: Select all

Debug "Please wait a moment while we collect the data ..."
  Exe=RunProgram("wmic","product get name, version","",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read|#PB_Program_Error)
  If Exe
    While ProgramRunning(Exe)
      If AvailableProgramOutput(Exe)
        Output$=ReadProgramString(Exe) ;trash first (header) line
        Debug Output$
        ;Output$=Left(ReadProgramString(Exe),5) ; Capture 2nd line
        CPU = Val(LTrim(Output$)) ; retain first word only
      EndIf
    Wend
  EndIf

Re: Registry Module (windows only)

Posted: Tue Dec 17, 2024 3:47 pm
by ChrisR
Small update to version 1.5.3, see history for changes

Code: Select all

;======================================================================
; Module:          Registry.pbi
;
; Author:          Thomas (ts-soft) Schulz
; Date:            Dec 15, 2024
; Version:         1.5.3
; Target Compiler: PureBasic 6.0+
; Target OS:       Windows
; Forum:           https://www.purebasic.fr/english/viewtopic.php?t=56204
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;======================================================================

; History:

; Version 1.5.3, Dec 15, 2024  (by ChrisR)
; remove unnecessary RegSetValueEx and RegEnumKeyEx Prototype, GetFunction. They are included in PB6.x
; OpenLibrary, GetFunction, CloseLibrary for RegDeleteTree,RegCopyTree,RegDeleteKeyEx done only when used. They are not the most frequently used ones
; Read Reg_Expand_SZ Value, AllocateMemory length * 2 For ExpandEnvironmentStrings

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

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

Module Registry
  EnableExplicit
  
  #KEY_WOW64_64KEY = $100
  #KEY_WOW64_32KEY = $200
  
  Prototype PRegDeleteKeyEx(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
  Prototype PRegDeleteTree(hKey.i, lpSubKey.p-Unicode = 0)
  Prototype PRegCopyTree(hKeySrc.i, *lpSubKey, hKeyDest.i)
  
  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
  
  ;Get Last Error
  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
  
  ;Deletes the subkeys and values of the specified key recursively (EnumKey & DeleteKey way)
  Procedure EnumDeleteTree(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
        EnumDeleteTree(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
  
  ;Deletes the subkeys and values of the specified key recursively
  Procedure DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected Advapi32dll, RegDeleteTree_.PRegDeleteTree
    Protected error, samDesired = #KEY_ALL_ACCESS
    Protected hKey
    
    Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
    If Advapi32dll
      RegDeleteTree_ = GetFunction(Advapi32dll, "RegDeleteTreeW")
      If RegDeleteTree_
        OpenKey()
        error = RegDeleteTree_(hKey)
        RegCloseKey_(hKey)
      Else
        CloseLibrary(Advapi32dll)
        ProcedureReturn EnumDeleteTree(topKey, KeyName, *Ret)
      EndIf
      CloseLibrary(Advapi32dll)
    Else
      ProcedureReturn EnumDeleteTree(topKey, KeyName, *Ret)
    EndIf
    
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  ;Copies the specified registry key, along with its values and subkeys, to the specified destination key
  Procedure CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected Advapi32dll, RegCopyTree_.PRegCopyTree
    Protected error, samDesired, create
    Protected hKey, hKeyD, topKey, KeyName.s
    
    If OSVersion() < #PB_OS_Windows_Vista
      ProcedureReturn #False
    EndIf
    
    Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
    If Advapi32dll
      RegCopyTree_ = GetFunction(Advapi32dll, "RegCopyTreeW")
      If RegCopyTree_
        topKey     = topKeySource
        KeyName    = KeyNameSource
        samDesired = #KEY_READ
        
        OpenKey()
        If hKey
          error = RegCreateKeyEx_(topKeyDestination, KeyNameDestination, 0, #Null$, 0, #KEY_ALL_ACCESS, 0, @hKeyD, @create)
          If error = #ERROR_SUCCESS And hKeyD
            error = RegCopyTree_(hKey, #Null, hKeyD)
            RegCloseKey_(hKeyD)
          EndIf
          RegCloseKey_(hKey)
        EndIf
        
      Else
        CloseLibrary(Advapi32dll)
        ProcedureReturn #False
      EndIf
      CloseLibrary(Advapi32dll)
      ProcedureReturn #False
    Else
      ProcedureReturn #False
    EndIf
    
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    
    ProcedureReturn #True
  EndProcedure
  
  ;Deletes a subkey and its values. Note that key names are not case sensitive
  Procedure DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
    Protected Advapi32dll, RegDeleteKeyEx_.PRegDeleteKeyEx
    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 *Ret <> 0
      ClearStructure(*Ret, RegValue)
    EndIf
    
    If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
    If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
    
    Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
    If Advapi32dll
      RegDeleteKeyEx_ = GetFunction(Advapi32dll, "RegDeleteKeyExW")
      If RegDeleteKeyEx_
        error = RegDeleteKeyEx_(topKey, KeyName, samDesired)
      Else
        error = RegDeleteKey_(topKey, KeyName)
      EndIf
      CloseLibrary(Advapi32dll)
    Else
      error = RegDeleteKey_(topKey, KeyName)
    EndIf
    
    If error
      If *Ret <> 0
        *Ret\ERROR    = error
        *Ret\ERRORSTR = GetLastErrorStr(error)
      EndIf
      Debug GetLastErrorStr(error)
      ProcedureReturn #False
    EndIf
    ProcedureReturn #True
  EndProcedure
  
  ;Removes a named value from the specified registry key. Note that value names are not case sensitive
  Procedure 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
  
  ;Returns the number of subkeys that are contained by the specified key
  Procedure 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
  
  ;Enumerates the subkeys of the specified open registry key
  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
  
  ;Returns the number of values that are associated with the key
  Procedure 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
  
  ;Enumerates the values for the specified open registry key
  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
  
  ;Retrieves the type for the specified value name
  Procedure 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
  
  ;Retrieves the data for the specified value name
  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 * 2)
          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
  
  ;Creates the specified registry key. Note that key names are not case sensitive
  Procedure 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
          Debug "Error: Required *Ret.RegValue parameter not found with *Ret\BINARY, *Ret\SIZE"
          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 = RegSetValueEx_(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

;- MainFile
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  UseModule Registry
  
  Define count, i
  Define RegValue.RegValue
  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")
    Debug "-----------------------"
    
    RegValue\TYPE = #REG_BINARY
    RegValue\BINARY = ?RegVal1
    RegValue\SIZE = ?RegVal1end - ?RegVal1
    WriteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "binary", "", #REG_BINARY, #False, RegValue)
    Debug ReadValue(#HKEY_CURRENT_USER, "Software\ts-soft", "binary")
    
    ClearStructure(RegValue, RegValue)
    ReadValue(#HKEY_CURRENT_USER, "Software\ts-soft", "binary", #False, RegValue)
    Debug PeekS(RegValue\BINARY, RegValue\SIZE, #PB_UTF8)
    
    Debug "-----------------------"
    
    CopyTree(#HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", #HKEY_CURRENT_USER, "Software\ts-soft\Devices")
    
    count = CountSubValues(#HKEY_CURRENT_USER, "Software\ts-soft\Devices") - 1
    For i = 0 To count
      Debug ListSubValue(#HKEY_CURRENT_USER, "Software\ts-soft\Devices", i)
    Next
    
    Debug "-----------------------"
    Select MessageRequester("Delete Registry-Example", "Delete the demo Registry Tree and Key?", #PB_MessageRequester_YesNo)
      Case #PB_MessageRequester_Yes
        If DeleteTree(#HKEY_CURRENT_USER, "Software\ts-soft")
          Debug "demo Registry Tree deleted"
        Else
          Debug "demo Registry Tree not deleted"
        EndIf
        If DeleteKey(#HKEY_CURRENT_USER, "Software\ts-soft")
          Debug "demo Registry Key deleted"
        Else
          Debug "demo Registry Key not deleted"
        EndIf
    EndSelect
  EndIf
  
  DataSection
    RegVal1:
    Data.b $50,$75,$72,$65,$42,$61,$73,$69,$63
    RegVal1end:
  EndDataSection
CompilerEndIf

Re: Registry Module (windows only)

Posted: Tue Dec 17, 2024 3:48 pm
by ChrisR
And the same, in user Library version for PureBasic 6.20+
Use Create Lib tool to compile the Registry Library.

Code: Select all

DisablePureLibrary Registry

;======================================================================
; Module:          Registry.pb
;
; Author:          Thomas (ts-soft) Schulz
; Date:            Dec 15, 2024
; Version:         1.5.3 Library
; Target Compiler: PureBasic 6.20 minimum
; Compile library: Use Create Lib tool - https://www.purebasic.fr/english/viewtopic.php?t=85882
; Target OS:       Windows
; Forum:           https://www.purebasic.fr/english/viewtopic.php?t=56204
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;======================================================================

; History:

; Version 1.5.3 Library, Dec 15, 2024  (by ChrisR)
; remove unnecessary RegSetValueEx and RegEnumKeyEx Prototype, GetFunction. They are included in PB6.x
; OpenLibrary, GetFunction, CloseLibrary for RegDeleteTree,RegCopyTree,RegDeleteKeyEx done only when used. They are not the most frequently used ones
; Read Reg_Expand_SZ Value, AllocateMemory length * 2 For ExpandEnvironmentStrings
;     
; Compile Registry user Library for PureBasic 6.20 and above:
;   Using the tool: Create Lib - https://www.purebasic.fr/english/viewtopic.php?t=85882

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

; 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()
; + ListSubKey()
; + CountSubValues()
; + 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

;Residents
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
;EndResidents

#KEY_WOW64_64KEY = $100
#KEY_WOW64_32KEY = $200

Enumeration - 1 Step - 1
  #REG_ERR_ALLOCATE_MEMORY
  #REG_ERR_BINARYPOINTER_MISSING
  #REG_ERR_REGVALUE_VAR_MISSING
EndEnumeration

Prototype PRegDeleteKeyEx(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
Prototype PRegDeleteTree(hKey.i, lpSubKey.p-Unicode = 0)
Prototype PRegCopyTree(hKeySrc.i, *lpSubKey, hKeyDest.i)

Declare.s GetLastErrorStr(error)

DeclareDLL   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)

DeclareDLL.s ReadValue(topKey,
                       KeyName.s,
                       ValueName.s   = "",
                       WOW64         = #False,
                       *Ret.RegValue = 0)
; result "" = error

DeclareDLL   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      EnumDeleteTree(topKey, KeyName.s, *Ret.RegValue = 0)
DeclareDLL   DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
; Deletes the subkeys and values of the specified key recursively. result 0 = error

DeclareDLL   CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)

DeclareDLL   DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
; result 0 = error

DeclareDLL   DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
; result 0 = error

DeclareDLL   CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)

DeclareDLL.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
; the index is 0-based!

DeclareDLL   CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)

DeclareDLL.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)

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

;Get Last Error
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

;Deletes the subkeys and values of the specified key recursively (EnumKey & DeleteKey way)
Procedure EnumDeleteTree(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
      EnumDeleteTree(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

;Deletes the subkeys and values of the specified key recursively
ProcedureDLL DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
  Protected Advapi32dll, RegDeleteTree_.PRegDeleteTree
  Protected error, samDesired = #KEY_ALL_ACCESS
  Protected hKey
  
  Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
  If Advapi32dll
    RegDeleteTree_ = GetFunction(Advapi32dll, "RegDeleteTreeW")
    If RegDeleteTree_
      OpenKey()
      error = RegDeleteTree_(hKey)
      RegCloseKey_(hKey)
    Else
      CloseLibrary(Advapi32dll)
      ProcedureReturn EnumDeleteTree(topKey, KeyName, *Ret)
    EndIf
    CloseLibrary(Advapi32dll)
  Else
    ProcedureReturn EnumDeleteTree(topKey, KeyName, *Ret)
  EndIf
  
  If error
    If *Ret <> 0
      *Ret\ERROR    = error
      *Ret\ERRORSTR = GetLastErrorStr(error)
    EndIf
    Debug GetLastErrorStr(error)
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure

;Copies the specified registry key, along with its values and subkeys, to the specified destination key
ProcedureDLL CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
  Protected Advapi32dll, RegCopyTree_.PRegCopyTree
  Protected error, samDesired, create
  Protected hKey, hKeyD, topKey, KeyName.s
  
  If OSVersion() < #PB_OS_Windows_Vista
    ProcedureReturn #False
  EndIf
  
  Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
  If Advapi32dll
    RegCopyTree_ = GetFunction(Advapi32dll, "RegCopyTreeW")
    If RegCopyTree_
      topKey     = topKeySource
      KeyName    = KeyNameSource
      samDesired = #KEY_READ
      
      OpenKey()
      If hKey
        error = RegCreateKeyEx_(topKeyDestination, KeyNameDestination, 0, #Null$, 0, #KEY_ALL_ACCESS, 0, @hKeyD, @create)
        If error = #ERROR_SUCCESS And hKeyD
          error = RegCopyTree_(hKey, #Null, hKeyD)
          RegCloseKey_(hKeyD)
        EndIf
        RegCloseKey_(hKey)
      EndIf
      
    Else
      CloseLibrary(Advapi32dll)
      ProcedureReturn #False
    EndIf
    CloseLibrary(Advapi32dll)
    ProcedureReturn #False
  Else
    ProcedureReturn #False
  EndIf
   
  If error
    If *Ret <> 0
      *Ret\ERROR    = error
      *Ret\ERRORSTR = GetLastErrorStr(error)
    EndIf
    Debug GetLastErrorStr(error)
    ProcedureReturn #False
  EndIf
  
  ProcedureReturn #True
EndProcedure

;Deletes a subkey and its values. Note that key names are not case sensitive
ProcedureDLL DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
  Protected Advapi32dll, RegDeleteKeyEx_.PRegDeleteKeyEx
  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 *Ret <> 0
    ClearStructure(*Ret, RegValue)
  EndIf
  
  If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
  If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf
  
  Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
  If Advapi32dll
    RegDeleteKeyEx_ = GetFunction(Advapi32dll, "RegDeleteKeyExW")
    If RegDeleteKeyEx_
      error = RegDeleteKeyEx_(topKey, KeyName, samDesired)
    Else
      error = RegDeleteKey_(topKey, KeyName)
    EndIf
    CloseLibrary(Advapi32dll)
  Else
    error = RegDeleteKey_(topKey, KeyName)
  EndIf
  
  If error
    If *Ret <> 0
      *Ret\ERROR    = error
      *Ret\ERRORSTR = GetLastErrorStr(error)
    EndIf
    Debug GetLastErrorStr(error)
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure

;Removes a named value from the specified registry key. Note that value names are not case sensitive
ProcedureDLL 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

;Returns the number of subkeys that are contained by the specified key
ProcedureDLL 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

;Enumerates the subkeys of the specified open registry key
ProcedureDLL.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

;Returns the number of values that are associated with the key
ProcedureDLL 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

;Enumerates the values for the specified open registry key
ProcedureDLL.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

;Retrieves the type for the specified value name
ProcedureDLL 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

;Retrieves the data for the specified value name
ProcedureDLL.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 * 2)
        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

;Creates the specified registry key. Note that key names are not case sensitive
ProcedureDLL 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
        Debug "Error: Required *Ret.RegValue parameter not found with *Ret\BINARY, *Ret\SIZE"
        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 = RegSetValueEx_(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

Re: Registry Module (windows only)

Posted: Tue Dec 17, 2024 4:03 pm
by ChrisR
And to test the Registry Library (without XIncludeFile "Registry.pbi" : UseModule Registry), as if it were native

Code: Select all

; To use with the Registry Library: https://www.purebasic.fr/english/viewtopic.php?p=632330#p632330
; Else, just use the Registry.pbi module, by adding: XIncludeFile "Registry.pbi" : UseModule Registry

Define count, i
Define RegValue.RegValue, RegBinary$
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")
  Debug "-----------------------"
  
  RegValue\TYPE = #REG_BINARY
  RegValue\BINARY = ?RegVal1
  RegValue\SIZE = ?RegVal1end - ?RegVal1
  WriteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "binary", "", #REG_BINARY, #False, RegValue)
  Debug ReadValue(#HKEY_CURRENT_USER, "Software\ts-soft", "binary")
  
  ClearStructure(RegValue, RegValue)
  ReadValue(#HKEY_CURRENT_USER, "Software\ts-soft", "binary", #False, RegValue)
  Debug PeekS(RegValue\BINARY, RegValue\SIZE, #PB_UTF8)

  Debug "-----------------------"
  
  CopyTree(#HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", #HKEY_CURRENT_USER, "Software\ts-soft\Devices")
  
  count = CountSubValues(#HKEY_CURRENT_USER, "Software\ts-soft\Devices") - 1
  For i = 0 To count
    Debug ListSubValue(#HKEY_CURRENT_USER, "Software\ts-soft\Devices", i)
  Next
  
  Debug "-----------------------"
  Select MessageRequester("Delete Registry-Example", "Delete the demo Registry Tree and Key?", #PB_MessageRequester_YesNo)
    Case #PB_MessageRequester_Yes
      If DeleteTree(#HKEY_CURRENT_USER, "Software\ts-soft")
        Debug "demo Registry Tree deleted"
      Else
        Debug "demo Registry Tree not deleted"
      EndIf
      If DeleteKey(#HKEY_CURRENT_USER, "Software\ts-soft")
        Debug "demo Registry Key deleted"
      Else
        Debug "demo Registry Key not deleted"
      EndIf
  EndSelect
EndIf

DataSection
  RegVal1:
  Data.b $50,$75,$72,$65,$42,$61,$73,$69,$63
  RegVal1end:
EndDataSection

Re: Registry Module (windows only)

Posted: Wed Dec 18, 2024 9:54 am
by Randy Walker
Randy Walker wrote: Thu Nov 21, 2024 1:52 am I can't promise this will satisfy or even help. Might try researching that "wmic"
line command to see if/what other parameters are available.
Tested in PB 6.12 on Win 11.

[NOTE] 12/18/24 -- It''s not 100% but I was partly right about that wmic command. I added a few more lines to get the computer name and modified the wmic parameters accordingly to get a list of installed programs ... BUT!!! The list is not complete for my PC. Maybe works better on yours. In theory it is supposed to work.

Code: Select all

param$ = "$env:computername"
Exe=RunProgram("powershell",param$,"",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read|#PB_Program_Error)
If Exe
  While ProgramRunning(Exe)
    If AvailableProgramOutput(Exe)
      CompName$=ReadProgramString(Exe) ;trash first (header) line
      Debug CompName$
    EndIf
  Wend
EndIf
param$ = "/node:"+CompName$+" product get name, version, vendor "
Debug "Please wait a moment while we collect the data ..."
Exe=RunProgram("wmic",param$,"",#PB_Program_Hide|#PB_Program_Open|#PB_Program_Read|#PB_Program_Error)
If Exe
  While ProgramRunning(Exe)
    If AvailableProgramOutput(Exe)
      Output$=ReadProgramString(Exe) ;trash first (header) line
      Debug Output$
      ;Output$=Left(ReadProgramString(Exe),5) ; Capture 2nd line
      CPU = Val(LTrim(Output$)) ; retain first word only
    EndIf
  Wend
EndIf

Re: Registry Module (windows only)

Posted: Wed Dec 18, 2024 3:49 pm
by ChrisR
olmak wrote: Thu Aug 11, 2016 4:37 am I'm trying to get a list of installed programs, with some parameters.
Randy Walker wrote: Thu Nov 21, 2024 1:52 am I can't promise this will satisfy or even help. Might try researching that "wmic"
More in link with the Registry.pbi module or Registry Library now:

Code: Select all

Macro ListInstalledPgm(InstalledPgmKey)
  count = CountSubKeys(#HKEY_LOCAL_MACHINE, InstalledPgmKey) - 1
  For i = 0 To count
    SubKey$ = InstalledPgmKey + "\" + ListSubKey(#HKEY_LOCAL_MACHINE, InstalledPgmKey, i)
    DisplayName$ = ReadValue(#HKEY_LOCAL_MACHINE, SubKey$, "DisplayName")
    If DisplayName$ > ""
      Debug DisplayName$ + " (v" + ReadValue(#HKEY_LOCAL_MACHINE, SubKey$, "DisplayVersion") +
            " - " + ReadValue(#HKEY_LOCAL_MACHINE, SubKey$, "Publisher") + ")"
    EndIf
  Next
EndMacro

Debug "ComputerName: " + ReadValue(#HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName", "ComputerName")
Debug "----- 64-bit programs installed -----"
ListInstalledPgm("SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall")
Debug "----- 32-bit programs installed -----"
ListInstalledPgm("\SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall")

Re: Registry Module (windows only)

Posted: Wed Dec 18, 2024 7:17 pm
by Randy Walker
@ChrisR You might be on the right track to get all installed programs, but I can't get past this error to know for sure, or if it even collects extra info:

:!: Line 13: ReadValue() is not a function, array, list, map or macro.

Re: Registry Module (windows only)

Posted: Wed Dec 18, 2024 11:30 pm
by ChrisR
The uninstall registry key is the location used to populate the application list in windows settings.

The above example is mainly intended to be related to this Registry topic.
And to use the snippet as it is, you need PB 6.20 and then you need to compile the Registry Library first. And so ReadValue(), CountSubKeys() or ListSubKey() are seen as if they were native

Otherwise, just use the Registry.pbi module, by adding:
XIncludeFile "Registry.pbi" : UseModule Registry

Re: Registry Module (windows only)

Posted: Thu Dec 19, 2024 5:17 am
by Randy Walker
OK, so that explains it, I guess. Over my head. All I know is stay away from the registry for best results. :oops:
All times are UTC+01:00
Page 6 of 7

Powered by phpBB® Forum Software © phpBB Limited