Programme Base de registre

[brossden]

Bonjour à tous
Il y a pas mal de temps j'avais trouvé un programme pour rechercher des clés dans la base de registre, j'ai perdu ce programme est ce que quelqu'un aurait ce programme et aurait la gentillesse de me le donner.
Merci à tous ceux qui liront se topic

[Jacobus]

Bonjour Brossden,
tu parles d'un programme complet avec GUI, ou de fonctions PB de lecture de la BDR ?

[Ar-S]

Y'en a pas mal de différents. En voilà un de Ts-Soft

Code : Tout sélectionner

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

    ; History:
    ; 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)
     
    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)
     
      Global RegDeleteKey.RegDeleteKey
      Global RegSetValue.RegSetValue
      Global RegDeleteTree.RegDeleteTree
     
      Define dll.i
     
      dll = OpenLibrary(#PB_Any, "Advapi32.dll")
      If dll
        RegDeleteKey = GetFunction(dll, "RegDeleteKeyExW")
        RegSetValue = GetFunction(dll, "RegSetValueExW")
        RegDeleteTree = GetFunction(dll, "RegDeleteTreeW")
      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 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
              *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
            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, 0, 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

[Jacobus]

Code actualisé et fonctionnel avec PB 6.21

Code : Tout sélectionner

; German forum: http://www.purebasic.fr/german/archive/viewtopic.php?t=1301&highlight=
; Author: Manne (updated for PB4.00 by blbltheworm)
; Date: 10. June 2003
; OS: Windows
; Demo: No

; Werte local oder remote aus der Registry lesen      ; Utilisé localement ou à distance via le registre
; Liest REG-SZ oder REG_DWORD local und remote.  ; Comme REG-SZ ou REG_DWORD local et distant.


Global lRetVal.i         ;used To hold Return value For all API calls 

Global sRemMachName.s    ;used by RegConnectRegistry 
Global lTopLevelKey.i    ;used by RegConnectRegistry 
Global lHKeyhandle.i     ;used by RegConnectRegistry & RegOpenKeyEx 

Global sKeyName.s        ;used by RegOpenKeyEx 
Global lhkey.i           ;used by RegOpenKeyEx & RegQueryValueEx & RegCloseKey 

Global sValueName.s      ;used by RegQueryValueEx 
Global vValue.s          ;used by RegQueryValueEx 
Global msg.s             ; used to hold errormessage 

#REG_SZ = 1 
#REG_DWORD = 4 
; 
; #HKEY_CLASSES_ROOT = $80000000 
; #HKEY_CURRENT_USER = $80000001 
#HKEY_LOCAL_MACHINE = $80000002 
#HKEY_USERS = $80000003 
; 
#ERROR_NONE = 0 
; #ERROR_BADDB = 1 
; #ERROR_BADKEY = 2 
; #ERROR_CANTOPEN = 3 
; #ERROR_CANTREAD = 4 
; #ERROR_CANTWRITE = 5 
; #ERROR_OUTOFMEMORY = 6 
; #ERROR_INVALID_PARAMETER = 7 
; #ERROR_ACCESS_DENIED = 8 
; #ERROR_INVALID_PARAMETERS = 87 
; #ERROR_NO_MORE_ITEMS = 259 
; 
; #KEY_ALL_ACCESS = $3F 
; 
; #REG_OPTION_NON_VOLATILE = 0 

Procedure.i SetValueEx(topKey.i, sKeyName.s, sValueName.s, lType.i, vValue.s) 
    lValue.i 
    sValue.s 
    Select lType 
        Case #REG_SZ 
            sValue = vValue 
            size.i = Len(sValue) 
            RegCreateKey_(topKey,sKeyName,@hKey) 
            SetValueEx = RegSetValueEx_(hKey, sValueName, 0, #REG_SZ, @sValue, size) 
        Case #REG_DWORD 
            lValue = Val(vValue) 
            SetValueEx = RegSetValueEx_(hKey, @sValueName, 0, #REG_DWORD, @lValue, 4) 
        EndSelect 
        ProcedureReturn SetValueEx 
EndProcedure 

Procedure.i QueryValueEx(lhkey.i, szValueName.s) 
    Define.i cch, lrc, lType, lValue 
    Define.s sValue
    Shared vValue 
    cch = 255 
    sValue = Space(255) 
    
    ;Determine the size And type of Data To be Read 
    lrc = RegQueryValueEx_(lhkey, szValueName, 0, @lType, 0, @cch) 
        
    Select lType 
        ;For strings 
        Case #REG_SZ 
            lrc = RegQueryValueEx_(lhkey, szValueName, 0, @lType, @sValue, @cch) 
            If lrc = #ERROR_NONE 
                vValue = Left(sValue, cch-1) 
            Else 
                vValue = "Empty" 
            EndIf 
        ;For DWORDS 
        Case #REG_DWORD 
            lrc = RegQueryValueEx_(lhkey, szValueName, 0, @lType, @lValue, @cch) 
            If lrc = #ERROR_NONE 
              vValue = Str(lValue) 
            EndIf 
        Default 
            ;all other Data types not supported 
            lrc = -1 
    EndSelect 
    ProcedureReturn lrc 
EndProcedure 

;- Window Constants 
Enumeration
#Window_0 = 0 
EndEnumeration
;- Gadget Constants 
Enumeration 
#Gadget_0 = 0 
#Gadget_1 = 1 
#Gadget_2 = 2 
#Gadget_3 = 3 
#Gadget_4 = 4 
#Gadget_5 = 5 
#Gadget_6 = 6 
#Gadget_7 = 7 
#Gadget_8 = 8 
#Gadget_9 = 9 
#Gadget_10 = 10 
#Gadget_11 = 11 
EndEnumeration

Procedure Open_Window_0() 
  
  If OpenWindow(#Window_0, 0, 0, 500, 300, "RegConnectRegistry Sample",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered ) 
  
      TextGadget(#Gadget_0, 11, 18, 140, 20, "Remote machine name:") 
      StringGadget(#Gadget_1, 160, 16, 140, 20, "")
      
      FrameGadget(#Gadget_2, 10, 46, 473, 65, "Select Top Level Key to Open") 
      OptionGadget(#Gadget_3, 20, 75, 160, 20, "HKEY_LOCAL_MACHINE") 
      OptionGadget(#Gadget_4, 200, 75, 140, 20, "HKEY_USERS") 
      
      TextGadget(#Gadget_5, 10, 115, 200, 17, "SubKey you wish to query:") ;Sous-clé que vous souhaitez interroger
      StringGadget(#Gadget_6, 10, 132, 473, 20, "") 
      
      TextGadget(#Gadget_7, 10, 158, 250, 17, "Value under SubKey you wish to query:") ;Valeur sous la sous-clé que vous souhaitez interroger
      StringGadget(#Gadget_8, 10, 175, 473, 20, "") 
      
      TextGadget(#Gadget_9, 10, 205, 190, 17, "Result:") 
      StringGadget(#Gadget_10, 10, 222, 473, 20, "") 
      
      ButtonGadget(#Gadget_11, 383, 260, 100, 30, "Query Value") 
      
  EndIf 
EndProcedure 

Open_Window_0() 
SetGadgetState(#Gadget_3, 1) 
SetGadgetText(#Gadget_1, "") ; laisser vide pour utiliser la BDR du PC local, sinon mettre le nom du PC distant qui doit être connecté.
SetGadgetText(#Gadget_6, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Drivers32") 
SetGadgetText(#Gadget_8, "msacm.msg711") 

Repeat 
  
  Event = WaitWindowEvent() 
  
  If Event = #PB_Event_Gadget 
    
    ;Debug "WindowID: " + Str(EventWindowID()) 
    
    GadgetID = EventGadget() 
    
    If GadgetID = #Gadget_11 
      
      If GetGadgetState(#Gadget_3) = #True 
        lTopLevelKey = #HKEY_LOCAL_MACHINE 
      EndIf
      
      If  GetGadgetState(#Gadget_4) = #True 
        lTopLevelKey = #HKEY_USERS 
      EndIf 
      
      sRemMachName = GetGadgetText(#Gadget_1) 
      sKeyName     = GetGadgetText(#Gadget_6) 
      sValueName   = GetGadgetText(#Gadget_8) 
      
      lRetVal = RegConnectRegistry_(sRemMachName, lTopLevelKey, @lHKeyhandle) 
      
      lRetVal = RegOpenKeyEx_(lHKeyhandle, sKeyName, 0, #KEY_READ, @lhkey)  ; utiliser le mode lecture
     
      lRetVal = QueryValueEx(lhkey, sValueName) 
      
      RegCloseKey_(lhkey) 
      
      If lRetVal = 0 
        SetGadgetText(#Gadget_10, vValue) 
      Else 
        msg = "An Error occured, Return value = " + Str(lRetVal) 
        SetGadgetText(#Gadget_10, msg) 
      EndIf 
      
    EndIf 
    
  EndIf 
  
Until Event = #PB_Event_CloseWindow 

End 

[Ar-S]

J'ai testé ton code j'ai un

Code : Tout sélectionner

[16 :13 :09] [ERREUR] Registry_PB6.pb (Ligne: 172)
[16 :13 :09] [ERREUR] Overflow in the global data block.

[Jacobus]

Salut Ar-S, je n'ai pas eu ce type d'erreur et je ne saurais te dire d'où cela vient.
J'ai quand même modifié le code qui était pour accès à PC distant. Pour que cela fonctionne sur le PC local il y avait une ou deux bricoles à changer (j'ai commenté où il faut modifier pour aller sur PC distant et les droits d'accès)
Testé sur Win11 pro 64 et PB 6.21 x64. Pas d'erreur et résultat conforme à l'éditeur de registre de Windows.