Une class pour le registre
Description
V'là une class pour le registre
Elle gére pratiquement tous les types de valeurs
G becaup chercher mais j'y suis parvenu
Au début je voulais les REG_MULTI_SZ et les REG_DWORD mais avec les APIs.
Pas d'erreur connu.
Elle gére pratiquement tous les types de valeurs
G becaup chercher mais j'y suis parvenu
Au début je voulais les REG_MULTI_SZ et les REG_DWORD mais avec les APIs.
Source / Exemple :
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 ' _
} _
}
Conclusion :
Pas d'erreur connu.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.