TOUT POUR LA BASE DE REGISTRE (REGEDIT) - COMPLET !!!

'##################################################
'#                                                #
'# Conception Date   : 02/06/2005                 #
'# Class Name        : Reg ver.1.0                #
'# Programmer(s)     : Francis Gendron            #
'#                                                #
'##################################################

'######################################################################################
'#                                                                                    #
'#                          Main Declarations And Subs                                #
'#                                                                                    #
'######################################################################################

Option Explicit

Public Event Error(ByVal sError As String)

Private Const BUFFER_SIZE As Long = 255 'Longueur du Buffer

'Constante pour les permissions
Private Const READ_CONTROL = &H20000
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_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Private Const KEY_EXECUTE = KEY_READ
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

'Enum pour la clé primaire
Public Enum HkeyCst
       HKEY_CLASS_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

'Enum pour les permissions
Public Enum PermCst
       pKEY_READ_ACCESS = KEY_READ
       pKEY_WRITE_ACCESS = KEY_WRITE
       pKEY_ALL_ACCESS = KEY_ALL_ACCESS
End Enum

'Enum pour les types de données
Public Enum TypeCst
       REG_NONE = 0
       REG_SZ = 1
       REG_EXPAND = 2
       REG_BINARY = 3
       REG_DWORD = 4
       REG_DWORD_BIG_ENDIAN = 5
       REG_LINK = 6
       REG_MULTI_SZ = 7
       REG_RESSOURCE_LIST = 8
       REG_FULL_RESSOURCE_DESCRIPTOR = 9
       REG_RESOURCE_REQUIREMENTS_LIST = 10
       REG_QWORD = 11
End Enum

'Type pour la sécurité
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 'Ferme une clé
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long 'Créé une clé (si existe déja, on l'ouvre)
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long 'Supprime une clé
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long 'Supprime une valeur
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long 'Énumère des sous-clés
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, lpData As Any, lpcbData As Long) As Long 'Énumère des valeurs
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long 'Ouvre une clé
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long 'Lit une valeur
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 'Créé ou modifie une valeur

Dim sError As String 'Variable qui va contenir les messages d'erreur

'######################################################################################
'#                                                                                    #
'#                                 Private Subs                                       #
'#                                                                                    #
'######################################################################################

'Vérifie si un api a retourner un erreur
Private Function CheckErr(ByVal Result As Long) As Long

       Select Case Result
              Case 0, 259: sError = Empty 'Aucune erreur, Pas d'autre item (pour EnumKey)
              Case 2: sError = "Invalid key" 'Clé invalide
              Case 8: sError = "Access denied" 'Acces refuser
              Case Else: sError = "Unknow error" 'Erreur inconnu
       End Select
       If Not sError = Empty Then RaiseEvent Error(sError) 'Si erreur, on active l'event Error
       CheckErr = Result 'On retourne le résultat recus (permet au Sub de savoir si on continue)
       
End Function

'######################################################################################
'#                                                                                    #
'#                                  Public Subs                                       #
'#                                                                                    #
'######################################################################################

'Efface le message d'erreur
Public Sub ClearError()
       sError = Empty
End Sub

'Créer une clé
Public Sub CreateKey(ByVal hKey As HkeyCst, ByVal Key As String, Optional ByVal Permission As PermCst = pKEY_ALL_ACCESS)
       Dim lHKey As Long, pAttr As SECURITY_ATTRIBUTES
       
       With pAttr 'Attributs de sécurités par défault
              .bInheritHandle = True
              .nLength = 50
       End With
       
       'Créer la clé et vérifie si erreur
       CheckErr RegCreateKeyEx(hKey, Key, ByVal 0&, vbNullString, 0&, Permission, pAttr, lHKey, 0&)
       RegCloseKey lHKey 'Ferme la clé
       
End Sub

'Efface une clé
Public Sub DeleteKey(ByVal hKey As HkeyCst, ByVal Key As String)

       CheckErr RegDeleteKey(hKey, Key) 'Supprime la clé et vérifie si erreur
       
End Sub

'Efface une valeur
Public Sub DeleteValue(ByVal hKey As HkeyCst, ByVal Key As String, ByVal Value As String)

       Dim lHKey As Long
       
       If CheckErr(RegOpenKeyEx(hKey, Key, ByVal 0&, WRITE_ACCESS, lHKey)) = 0 Then 'Ouvre la clé et vérifie si erreur
              CheckErr RegDeleteValue(lHKey, Value) 'Supprime la clé et vérifie si erreur
              RegCloseKey lHKey 'Ferme la clé
       End If
       
End Sub

'Énumère les sous-clés d'une clé
Public Sub EnumKey(ByVal hKey As HkeyCst, ByVal Key As String, ByRef sKey() As String, ByRef NbData As Long)

       Dim lHKey As Long, strKey As String, lKey As Long, lCnt As Long
       
       If CheckErr(RegOpenKeyEx(hKey, Key, ByVal 0&, KEY_READ, lHKey)) = 0 Then 'Ouvre la clé et vérifie si erreur
              strKey = Space$(BUFFER_SIZE) 'Buffer qui va contenir les donnés
              lKey = BUFFER_SIZE 'Longueur du buffer
              
              'Énumère les clés une par une et arrete si erreur (NO_MORE_ITEMS)
              While CheckErr(RegEnumKeyEx(lHKey, lCnt, strKey, lKey, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&)) = 0
                     'On ajoute la nouvelle donnée dans sKey
                     ReDim Preserve sKey(lCnt)
                     sKey(lCnt) = Left$(strKey, lKey)
                     lCnt = lCnt + 1
                     strKey = Space$(BUFFER_SIZE) 'On refait le buffer
                     lKey = BUFFER_SIZE
              Wend
              NbData = lCnt 'On indique le nombre de clés trouvés
       End If
       
      RegCloseKey lHKey 'On ferme la clé
      
End Sub

'Énumère les valeurs d'une clé
Public Sub EnumValue(ByVal hKey As HkeyCst, ByVal Key As String, ByRef Value() As Variant, ByRef NbData As Long, Optional ByVal pType As TypeCst = REG_SZ)

       Dim lHKey As Long, strValue As String, lVal As Long, lValue As Long, lCnt As Long, lData As Long
       
       If CheckErr(RegOpenKeyEx(hKey, Key, ByVal 0&, KEY_READ, lHKey)) = 0 Then 'Ouvre la clé et vérifie si erreur
              lValue = BUFFER_SIZE 'Longueur du buffer
                     Select Case pType
                            Case 1, 2, 6, 7: 'Données de type String
                                   strValue = Space$(BUFFER_SIZE) 'Buffer qui va contenir les données
                                   
                                   'Énumère les valeurs une par une et arrete si erreur (NO_MORE_ITEMS)
                                   While CheckErr(RegEnumValue(lHKey, lCnt, ByVal strValue, lValue, 0&, pType, ByVal lData, 0&)) = 0
                                          'On ajoute la nouvelle donnée dans Value
                                          ReDim Preserve Value(lCnt)
                                          Value(lCnt) = Left$(strValue, lValue)
                                          strValue = Space$(BUFFER_SIZE) 'On refait le buffer
                                          lValue = BUFFER_SIZE
                                          lCnt = lCnt + 1
                                   Wend
                            Case 0, 3, 4, 5, 8, 9, 10, 11: 'Données de type Nombre
                                   'Ici on a pas besoin de buffer pcq la donnée est un nombre et non un string
                                   'Énumère les valeurs une par une et arrete si erreur (NO_MORE_ITEMS)
                                   While CheckErr(RegEnumValue(lHKey, lCnt, lVal, lValue, 0&, pType, ByVal lData, 0&)) = 0
                                          'On ajoute la nouvelle donnée dans Value
                                          ReDim Preserve Value(lCnt)
                                          Value(lCnt) = lVal
                                          lValue = BUFFER_SIZE
                                          lCnt = lCnt + 1
                                   Wend
                     End Select
              NbData = lCnt 'On indique le nombre de valeur trouvés
       End If
       
       RegCloseKey lHKey 'On ferme la clé
       
End Sub

'Lit une valeur
Public Function GetValue(ByVal hKey As HkeyCst, ByVal Key As String, ByVal Value As String, Optional ByVal lType As TypeCst = REG_SZ) As Variant

       Dim lHKey As Long, lResult As Long, lValue As Long, lType2 As Long, sData As String, lData As Long

       If CheckErr(RegOpenKeyEx(hKey, Key, ByVal 0&, KEY_READ, lHKey)) = 0 Then 'Ouvre la clé et vérifie si erreur
              lValue = BUFFER_SIZE 'Longueur du buffer
              If CheckErr(RegQueryValueEx(lHKey, Value, ByVal 0&, lType2, ByVal 0&, lValue)) = 0 And lType = lType2 Then 'L'api permet de savoir quelle type de donnée il s'agit, si ce n'est pas ce qu'on cherche, on ignore
                     Select Case lType
                            Case 1, 2, 6, 7: 'Données de type String
                                   sData = Space$(lValue) 'Buffer qui va contenir les données
                                   If CheckErr(RegQueryValueEx(lHKey, Value, ByVal 0&, ByVal 0&, ByVal sData, lValue)) = 0 Then GetValue = sData 'On lit les données et on vérifie si erreur
                            Case 0, 3, 4, 5, 8, 9, 10, 11: 'Données de type Nombre
                                   If CheckErr(RegQueryValueEx(lHKey, Value, ByVal 0&, ByVal 0&, lData, lValue)) = 0 Then GetValue = lData 'On lit les données et on vérifie si erreur
                     End Select
              End If
              
       End If
       
       RegCloseKey lHKey 'On ferme la clé
       
End Function

'Créé ou modifie une valeur
Public Sub SetValue(ByVal hKey As HkeyCst, ByVal Key As String, ByVal Value As String, ByVal Data As Variant, Optional ByVal lType As TypeCst = REG_SZ)

       Dim lHKey As Long, sData As String, lData As Long
       
       If CheckErr(RegOpenKeyEx(hKey, Key, 0&, KEY_SET_VALUE, lHKey)) = 0 Then 'Ouvre la clé et vérifie si erreur
              Select Case lType
                     Case 1, 2, 6, 7: 'Données de type String
                            sData = Data 'On met les données dans une string (sinon l'api fait un erreur)
                            CheckErr RegSetValueEx(lHKey, Value, ByVal 0&, lType, ByVal sData, Len(sData)) 'On modifie la donnée et on vérifie si erreur
                     Case 0, 3, 4, 5, 8, 9, 10, 11: 'Données de type Nombre
                            lData = Data 'On met les données dans une variable de type nombre
                            CheckErr RegSetValueEx(lHKey, Value, ByVal 0&, lType, lData, Len(lData)) 'On modifie la donnée et on vérifie si erreur
              End Select
       End If
       
       RegCloseKey lHKey 'On ferme la clé
       
End Sub

'#####################################################################################
'#                                                                                   #
'#                                Public Propertys                                   #
'#                                                                                   #
'#####################################################################################

Public Property Get Error() As String
       Error = sError
End Property