Tout pour la base de registre (regedit) - complet !!!

Soyez le premier à donner votre avis sur cette source.

Vue 27 465 fois - Téléchargée 1 888 fois

Description

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!!

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
2
Date d'inscription
lundi 19 décembre 2005
Statut
Membre
Dernière intervention
18 mars 2006

Merci patalo
c'est bien se que je voulais !!!!
Messages postés
1466
Date d'inscription
vendredi 2 janvier 2004
Statut
Modérateur
Dernière intervention
14 février 2014
1
re,

pour la perte du clavier, tu as une copie de ta base de registre dans WINDOWS\repair

@++
Messages postés
1466
Date d'inscription
vendredi 2 janvier 2004
Statut
Modérateur
Dernière intervention
14 février 2014
1
salut,

pour la structure REG_FULL_RESOURCE_DESCRIPTOR, elle est definie dans ntddk.h
et cfgmgr32.h pour le configuration manager

typedef struct _CM_FULL_RESOURCE_DESCRIPTOR {
INTERFACE_TYPE InterfaceType; // unused for WDM
ULONG BusNumber; // unused for WDM
CM_PARTIAL_RESOURCE_LIST PartialResourceList;
} CM_FULL_RESOURCE_DESCRIPTOR, *PCM_FULL_RESOURCE_DESCRIPTOR;

je te laisse convertir de C at VB...

@++
Messages postés
101
Date d'inscription
jeudi 31 janvier 2002
Statut
Membre
Dernière intervention
11 avril 2008

karibou, tu peut être plus explicite j'ai pas compris ce que tu voulais faire. Si tu veux obtenir de l'aide exprime-toi correctement, stp.
registre et clavier, c'est un drôle de mariage, çà.
Messages postés
2
Date d'inscription
lundi 19 décembre 2005
Statut
Membre
Dernière intervention
18 mars 2006

salut
peutite kestion ...
seuré til possib de recuperer un registre complet de ma machine sous xp sp2
un registre clean (g perdu mon clavier en farfouillant =()
merci
Afficher les 15 commentaires

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.