UNE CLASS POUR LE REGISTRE

Option Explicit

'// Register _
{
  Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
  Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
  Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
  Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
  
  '// Registry section definitions
  Public Enum eHKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
  End Enum
 
  '// Registry value type definitions
  Public Enum eRegMode
    REG_NONE = 0 '// No value type
    REG_SZ = 1 '// Unicode nul terminated string
    REG_EXPAND_SZ = 2 '// Unicode nul terminated string
    REG_BINARY = 3 '// Free form binary
    REG_DWORD = 4 '// 32-bit number
    REG_DWORD_LITTLE_ENDIAN = 4 '// 32-bit number (same as REG_DWORD)
    REG_DWORD_BIG_ENDIAN = 5 '// 32-bit number
    REG_LINK = 6 '// Symbolic Link (unicode)
    REG_MULTI_SZ = 7 '// Multiple Unicode strings
    REG_RESOURCE_LIST = 8 '// Resource list in the resource map
    REG_FULL_RESOURCE_DESCRIPTOR = 9 '// Resource list in the hardware description
    REG_RESOURCE_REQUIREMENTS_LIST = 10
  End Enum
  
  Public Type tValue
    Name As String
    Type As eRegMode
    Value As Variant
  End Type
  
  '// Security Mask constants
  Private Const READ_CONTROL = &H20000
  Private Const SYNCHRONIZE = &H100000
  Private Const STANDARD_RIGHTS_ALL = &H1F0000
  Private Const STANDARD_RIGHTS_READ = READ_CONTROL
  Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
  Private Const KEY_QUERY_VALUE = &H1
  Private Const KEY_SET_VALUE = &H2
  Private Const KEY_CREATE_SUB_KEY = &H4
  Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  Private Const KEY_NOTIFY = &H10
  Private Const KEY_CREATE_LINK = &H20
  Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
  Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
  Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
  Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
  
  '// Codes returned by Reg API calls
  Private Const ERROR_NONE = 0
  Private Const ERROR_BADDB = 1
  Private Const ERROR_BADKEY = 2
  Private Const ERROR_CANTOPEN = 3
  Private Const ERROR_CANTREAD = 4
  Private Const ERROR_CANTWRITE = 5
  Private Const ERROR_OUTOFMEMORY = 6
  Private Const ERROR_INVALID_PARAMETER = 7
  Private Const ERROR_ACCESS_DENIED = 8
  Private Const ERROR_INVALID_PARAMETERS = 87
  Private Const ERROR_NO_MORE_ITEMS = 259  ' _
}


'/////////////////////////////////////////////////////////////////////////////
'// Fonctions pour les opèrations sur le registre {
  '/////////////////////////////////////////////////////////////////////////////
  '// Fonction pour sauver une donné dans le registre _
  {
    Public Function WriteRegistry(ByVal hKey As eHKey, ByVal Section As String, ByVal Key As String, ByVal RegMode As eRegMode, ByVal Value As Variant)
    Dim KeyValue As Long
    Call RegCreateKey(hKey, Section, KeyValue) '// Ouverture
    If RegMode = REG_DWORD Then '// Si c'est une valeur DWORD
      Call RegSetValueExLong(KeyValue, Key, 0&, RegMode, CLng(Value), 4) '// On écrit une valeur de type long
    Else
      If RegMode = REG_SZ Then Value = Value + Chr(0) '// Si c une SZ, on ajoute un 0
      Call RegSetValueExString(KeyValue, Key, 0&, RegMode, Value, Len(Value)) '// On écrit une valeur de type texte
    End If
    Call RegFlushKey(KeyValue)
    Call RegCloseKey(KeyValue)
    End Function ' _
  }

  '/////////////////////////////////////////////////////////////////////////////
  '// Fonction pour lire une donnée du registre _
  {
    Public Function ReadRegistry(ByVal hKey As eHKey, ByVal Section As String, ByVal Key As String) As String
    Dim KeyValue As Long
    Dim RegMode As eRegMode
    On Error Resume Next
    Call RegOpenKey(hKey, Section, KeyValue) '// Ouverture
    ReadRegistry = Space$(2048)
    Call RegQueryValueEx(KeyValue, Key, 0&, RegMode, ReadRegistry, Len(ReadRegistry))
    If Err.Number = 0 Then
      If RegMode = REG_DWORD Then '// Si c'est une valeur DWORD
        ReadRegistry = Format$(Asc(Mid$(ReadRegistry, 1, 1)) + &H100& * Asc(Mid$(ReadRegistry, 2, 1)) + &H10000 * Asc(Mid$(ReadRegistry, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(ReadRegistry, 4, 1))), "000") '// On converti le format en décimal
      ElseIf RegMode = REG_BINARY Then '// Si cest une valeur BINARY
        ReadRegistry = Left$(ReadRegistry, Len(ReadRegistry)) '// On lit la valeur
      Else '// Sinon
        ReadRegistry = Left$(ReadRegistry, InStr(ReadRegistry, Chr(0)) - 1) '// lit avant le 0
      End If
    End If
    Call RegCloseKey(KeyValue) '// Fermeture
    End Function ' _
  }

  '/////////////////////////////////////////////////////////////////////////////
  '// Fonction pour lire toute les clé contenu dans une clé _
  {
    Public Function ReadRegistryKeys(ByVal hKey As eHKey, ByVal Section As String, ByRef KeyName() As String)
    Dim KeyValue As Long
    Dim sValue As String
    Dim Idx As Long
    Call RegOpenKey(hKey, Section, KeyValue) '// Ouverture
    Do
      sValue = Space$(2048)
      If (RegEnumKey(KeyValue, Idx, sValue, Len(sValue)) = 0) And (Err.Number = 0) Then '// Si on trouve une clé ...
        ReDim Preserve KeyName(Idx) As String '// Redimmentionne le tableau
        KeyName(Idx) = Left$(sValue, InStr(sValue, Chr(0)) - 1) '// Extrait le nom de la clé
      Else '// Si on trouve pas de clé, c que c la fin
         Exit Do '// On quitte la boucle
      End If
      Idx = Idx + 1 '// Incrément de l'index de clé
    Loop
    Call RegCloseKey(KeyValue) '// Fermeture
    End Function ' _
  }

  '/////////////////////////////////////////////////////////////////////////////
  '// Fonction pour lire toute les valeur contenu dans une clé avec leur type et leur noms _
  {
    Public Function ReadRegistryValues(ByVal hKey As eHKey, ByVal Section As String, ByRef ValName() As tValue)
    Dim KeyValue As Long
    Dim RegMode As eRegMode
    Dim lValueLength As Long
    Dim lValueNameLength As Long
    Dim sValueName As String
    Dim sValue As String
    Dim Idx As Long
    Call RegOpenKey(hKey, Section, KeyValue) '// Ouverture
    Do '// Début de la boucle principale
      sValue = Space$(2048)
      sValueName = Space$(2048)
      lValueLength = Len(sValue)
      lValueNameLength = Len(sValueName)
      If (RegEnumValue(KeyValue, Idx, sValueName, lValueNameLength, 0&, RegMode, sValue, lValueLength) = 0) And (Err.Number = 0) Then '// Si on trouve une valeur ...
        sValueName = Left$(sValueName, lValueNameLength) '// On en extrait le nom
        sValue = ReadRegistry(hKey, Section, sValueName) '// et la valeur
        ReDim Preserve ValName(Idx) As tValue '// Redimmentionne le tableau
        ValName(Idx).Name = sValueName '// Nom de la valeur
        ValName(Idx).Type = RegMode '// Le type
        ValName(Idx).Value = sValue '// La valeur
      Else '// Si on trouve pas de valeur, c que c la fin
        Exit Do '// On quitte la boucle
      End If
      Idx = Idx + 1 '// Incrément de l'index de valeur
    Loop
    Call RegCloseKey(KeyValue) '// Fermeture
    End Function ' _
  }

  '/////////////////////////////////////////////////////////////////////////////
  '// Fonction pour supprimer une valeur du registre _
  {
    Public Function DeleteValue(ByVal hKey As eHKey, ByVal Section As String, ByVal Key As String)
    Dim KeyValue As Long
    Call RegOpenKey(hKey, Section, KeyValue) '// Ouverture
    Call RegDeleteValue(KeyValue, Key) '// Supprime la valeur
    Call RegCloseKey(KeyValue) '// Fermeture
    End Function ' _
  } _

  '/////////////////////////////////////////////////////////////////////////////
  '// Fonction pour supprimer une clé du registre avec toutes celle qui s'y trouve dedans _
  {
    Public Function DeleteKey(ByVal hKey As eHKey, ByVal Section As String)
    On Error Resume Next
    Dim KeyValue As Long
    Dim SubKey() As String
    Call ReadRegistryKeys(hKey, Section, SubKey) '// On cherhce les clés contenu dans la clé
    Dim i As Integer
    For i = 0 To UBound(SubKey) '// Boucle sur toutes les clés qui sont dans la clé
      If Err.Number = 9 Then Exit For '// Si li n'y a pas de clé on quitte la boucle
      Call DeleteKey(hKey, Section & "\" & SubKey(i)) '// Rapelle la fonction pour supprimer les clés qui sont dans les clés trouvé
      Err.Clear '// Efface les erreurs
      Call RegOpenKeyEx(hKey, vbNullChar, 0&, KEY_ALL_ACCESS, KeyValue) '// Ouverture
      Call RegDeleteKey(KeyValue, Section & "\" & SubKey(i)) '// Supprime la clé
      Call RegCloseKey(KeyValue) '// Fermeture
    Next i
    Call RegOpenKeyEx(hKey, vbNullChar, 0&, KEY_ALL_ACCESS, KeyValue) '// Ouverture
    Call RegDeleteKey(KeyValue, Section) '// Supprime la clé du début
    Call RegCloseKey(KeyValue) '// Fermeture
    End Function ' _
  } _
}