Bon voila jai commenter le code! bon bah la source permet de créer, modifier, supprimer ou lister des valeurs ou des clés.
tester sur xp pro sp2 mais ca devrait marcher ak les autres versions.
si ya kek'chose vous comprener pas gener vous pas a le demander
Source / Exemple :
'##################################################
'# #
'# 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
Conclusion :
ya pas vraiment des bugs mais jai pas trouver d'information sur les types de valeurs REG_RESSOURCE_LIST , REG_FULL_RESSOURCE_DESCRIPTOR et REG_RESOURCE_REQUIREMENTS_LIST
Vb est capable de les écrire et de les lire sans probleme mais dans la bdr si tu ouvre la valeur regedit peut geler!!
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.