Lire et ecrire des clés dans la base de registre

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 889 fois - Téléchargée 41 fois

Contenu du snippet

Et voila mon deuxième code :-)

Décidemment aujourd'hui je suis en forme ;-)

Tous est dans le titre et le code. Je précide que le type de clé c'est par exemple HKeyCurrentUser, que l'adresse c'est ce qui vient derrière dans la base de registre et le nom....ben cela parle tous seul !

Source / Exemple :


Option Explicit

Dim lng As Long
Dim Buff As Long

'-------------------------------------------------------'
'ATTENTION : NE PAS METTRE DE \ AU DEBUT DU CHEMIN !!!!!'
'-------------------------------------------------------'

'-------------------------------------------------------'
'LAISSER VALEUR VIDE POUR LA CHAINE PAR DEFAUT            '
'-------------------------------------------------------'

'Constantes correspondant aux cinq clés
'à la base de la base de registres

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_DYN_DATA = &H80000004
Public Const SW_SHOW = 1
Public Enum HCle
    HKeyLocalMachine = 0
    HKeyCurrentUser = 1
    HKeyClassesRoot = 2
    HKeyUsers = 3
    HKeyDynamicData = 4
End Enum

'API nécessaires

'pour créer ou ouvrir une clé
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     phkResult As Long) As Long
     
'pour supprimer une clé
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String) As Long
     
'pour supprimer une valeur
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String) As Long
     
'pour lire une valeur
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
     
'pour fixer ou créer 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, _
     ByVal lpData As Any, _
     ByVal cbData As Long) As Long

Public Function CreerCle(HK As HCle, Chemin As String) As Long
RegCreateKey HKConvert(HK), Chemin, lng
CreerCle = lng
End Function

Private Function HKConvert(HK As HCle) As Long
If HK = 2 Then HKConvert = HKEY_CLASSES_ROOT
If HK = 1 Then HKConvert = HKEY_CURRENT_USER
If HK = 0 Then HKConvert = HKEY_LOCAL_MACHINE
If HK = 3 Then HKConvert = HKEY_USERS
If HK = 4 Then HKConvert = HKEY_DYN_DATA
End Function

Public Function SupprCle(HK As HCle, Chemin As String)
RegDeleteKey HKConvert(HK), Chemin
End Function

Public Function DonnerValeur(HK As HCle, Chemin As String, Valeur As String, Donnee As String)
RegCreateKey HKConvert(HK), Chemin, lng
RegSetValueEx lng, Valeur, 0&, 1, Donnee, Len(Donnee) + 1
End Function

Public Function LireValeur(HK As HCle, Chemin As String, Valeur As String) As String
On Error GoTo erreur
Buff = 0
Buff = RegCreateKey(HKConvert(HK), Chemin, lng)
If Buff = 0 Then RegQueryValueEx lng, Valeur, 0&, 1, 0&, Buff
If Buff < 2 Then
    LireValeur = ""
    Exit Function
End If
LireValeur = String(Buff + 1, " ")
RegQueryValueEx lng, Valeur, 0&, 1, ByVal LireValeur, Buff
LireValeur = Left(LireValeur, Buff - 1)
'mettre a la place de form1.tag l'emplacement où vous voulez écrire la valeur de la clé lu
form1.Tag = LireValeur
Exit Function
erreur:
    MsgBox "Configuration du port incorrect, impossible de lancer l'acquisition"
End Function

Public Function SupprValeur(HK As HCle, Chemin As String, Valeur As String)
Buff = 0
Buff = RegCreateKey(HKConvert(HK), Chemin, lng)
If Buff = 0 Then RegDeleteValue lng, ByVal Valeur
End Function

Public Sub Run(Parametre As String)
DonnerValeur type clé, "adresse clé", "nom clé", App.Path & "\" & App.EXEName & ".exe " & Parametre
End Sub

Public Function IsRun() As Boolean
If LireValeur(type clé, "adresse clé", "nom clé") <> "" Then IsRun = True Else IsRun = False
End Function

Public Sub DelRun()
SupprValeur Type clé, "adresse", "nom clé"
End Sub

Conclusion :


Si vous voulez plus d'info, dites-le moi

Stéphane

A voir également

Ajouter un commentaire

Commentaires

kronemburg
Messages postés
18
Date d'inscription
dimanche 25 mai 2003
Statut
Membre
Dernière intervention
3 décembre 2005
-
Cool les commentaires... Swman0 t'as oublié de relire deux fois (il le fallait pour censurer ^^)
C'est vrai qu'il y a beaucoup de sources la dessus, mais pour l'instant j'ai pas vu de truc clair (dans le vocabulaire) pour les pures débutants débiles !
sman0
Messages postés
39
Date d'inscription
mercredi 19 novembre 2003
Statut
Membre
Dernière intervention
3 novembre 2005
-
ouais mais Multiprise, regarde ici

http://www.vbfrance.com/code.aspx?ID=133

et leve la tete

Moi j'apelle ca ripper, le gars s'est meme pas donné la peine de changer les commentaires
regarde bien, apres on verra qui est le con.
thx
cs_Multiprise
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013
-
C'est vrai qu'il y a des dizaines de sources sur le même sujet. Et alors!, un éventail de choix n'est pas réducteur me semble-t'il. Chacun peut à sa guise tester et choisir la source qui correspond le mieux à ses besoins.
Ce site est créé pour échanger de manière constructive. Descendre en permanence ceux qui essaient d'y contribuer n'a aucun intérêt. Mais un con obtu restera toujours un con et il faut faire avec pusqu'on ne peut faire sans.
Ceci dit toute critique est bonne si elle est pertinente.
-----
Voici un autre code équivalent pour manipuler la base de registres:
'---------------------------------------------------------------------
Option Explicit
Dim lng As Long
Dim Buff As Long
'Constantes Types de clefs ClefRacine de la base de registres
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_DYN_DATA = &H80000004
'
'Type de données des valeurs de la base de registres
Private Const REG_SZ = 1 ' chaîne Unicode terminée par nul
Private Const REG_EXPAND_SZ = 2 ' chaîne Unicode terminée par nul
Private Const REG_DWORD = 4 ' nombre 32-bit (mot sur 4 octets)
'
' Valeurs de type de création
Private Const REG_OPTION_NON_VOLATILE = 0 'clef préservée lorsque le système est redémarré
'
'- Type Security_Attributes de la base de registres...
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
' Options de sécurité de clef de la base de registres.
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
'
' Valeurs renvoyées lors des opérations (écriture, lecture, suppression, création, actualisation)
Private Const ERROR_NONE = 0
Private Const ERROR_BADKEY = 2
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_SUCCESS = 0
'
'****************************************************
'**** API Windows de Gestion des REGISTRES ****
'****************************************************
'Créer ou ouvrir une clef
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

'Supprimer une clef
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long

'Supprimer une valeur et les données correspondantes dans une clef
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long

'Lire une valeur et les données correspondantes
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

'Fixer ou créer une valeur avec données ou modifier les données d'une Valeur string
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, _
ByVal lpData As Any, _
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


'*****************************************************************
'**** FONCTIONS ET PROCEDURES DE MANIPULATION DES REGISTRES ****
'*****************************************************************
'
'
'Convertis le nom de la ClefRacine (String ou entier) en entier long
'La valeur de la ClefRacine Pouvant être saisie en Numérique ou Alphanumérique
'-----------------------------------------------------------------------------
Private Function ConvertClef(ClefRacine As Variant) As Long
On Error Resume Next
If ClefRacine 0 Or ClefRacine "HKEY_LOCAL_MACHINE" Then ConvertClef = HKEY_LOCAL_MACHINE
If ClefRacine 1 Or ClefRacine "HKEY_CURRENT_USER" Then ConvertClef = HKEY_CURRENT_USER
If ClefRacine 2 Or ClefRacine "HKEY_CLASSES_ROOT" Then ConvertClef = HKEY_CLASSES_ROOT
If ClefRacine 3 Or ClefRacine "HKEY_USERS" Then ConvertClef = HKEY_USERS
If ClefRacine 4 Or ClefRacine "HKEY_DYN_DATA" Then ConvertClef = HKEY_DYN_DATA
End Function
'

'----------------------------------------------------------------
'Créer une nouvelle Clef (Subkey)
'----------------------------------------------------------------
Public Function RegCreateClef(ClefRacine As Variant, Chemin As String) As Long
Dim RetVal As Long
On Error Resume Next
'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
If Mid(Chemin, 1, 1) "" Then Chemin Mid(Chemin, 2)
'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
If Mid(Chemin, Len(Chemin), 1) <> "" Then Chemin = Chemin & ""
RetVal = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
RegCreateClef = lng
End Function
'

'-----------------------------------------------------------------
'Supprimer une Clef
'-----------------------------------------------------------------
Public Function RegDeleteClef(ClefRacine As Variant, Chemin As String)
Dim RetVal As Long
On Error Resume Next
'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
If Mid(Chemin, 1, 1) "" Then Chemin Mid(Chemin, 2)
'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
If Mid(Chemin, Len(Chemin), 1) <> "" Then Chemin = Chemin & ""
RetVal = RegDeleteKey(ConvertClef(ClefRacine), Chemin)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
End Function
'

'--------------------------------------------------------------------
'Ajouter une Valeur (String)
'--------------------------------------------------------------------
Public Function RegWriteVal(ClefRacine As Variant, Chemin As String, Valeur As String, Donnee As String)
Dim RetVal As Long
On Error Resume Next
If Trim(Donnee) "" Then Donnee " "
'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
If Mid(Chemin, 1, 1) "" Then Chemin Mid(Chemin, 2)
'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
If Mid(Chemin, Len(Chemin), 1) <> "" Then Chemin = Chemin & ""
RetVal = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
RetVal = RegSetValueEx(lng, Valeur, 0&, 1, Donnee, Len(Donnee) + 1)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
RegWriteVal = Donnee
End Function
'
'--------------------------------------------------------------------
'Ajouter une Valeur (Reg DWord)
'--------------------------------------------------------------------
Public Function RegWriteValDW(ClefRacine As Variant, Chemin As String, Valeur As String, Donnee As Long)
Dim RetVal As Long
On Error Resume Next
If Trim(Donnee) "" Then Donnee " "
'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
If Mid(Chemin, 1, 1) "" Then Chemin Mid(Chemin, 2)
'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
If Mid(Chemin, Len(Chemin), 1) <> "" Then Chemin = Chemin & ""
RetVal = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
Err.Clear
RetVal = RegSetValueExLong(lng, Valeur, 0&, 4, Donnee, 4)
If Err.Number <> 0 Then Debug.Print Err.Description; Err.Source
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
RegWriteValDW = Donnee
End Function
'

'----------------------------------------------------------------
'Lire une Valeur
'----------------------------------------------------------------
Public Function RegReadVal(ClefRacine As Variant, Chemin As String, Valeur As String) As String
Dim RetVal As Long
On Error Resume Next
'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
If Mid(Chemin, 1, 1) "" Then Chemin Mid(Chemin, 2)
'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
If Mid(Chemin, Len(Chemin), 1) <> "" Then Chemin = Chemin & ""
Buff = 0
Buff = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
If Buff 0 Then RetVal RegQueryValueEx(lng, Valeur, 0&, 1, 0&, Buff)
If Buff < 2 Then 'Si chaine vide
RegReadVal = ""
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
Exit Function
End If
RegReadVal = String(Buff + 1, " ")
RetVal = RegQueryValueEx(lng, Valeur, 0&, 1, ByVal RegReadVal, Buff)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
RegReadVal = Left(RegReadVal, Buff - 1)
End Function
'

'----------------------------------------------------------------
'Supprimer une Valeur
'----------------------------------------------------------------
Public Function RegDeleteVal(ClefRacine As Variant, Chemin As String, Valeur As String)
Dim RetVal As Long
On Error Resume Next
'Suppression éventuelle de l'Anti-Slash (\) qui précède le chemin
If Mid(Chemin, 1, 1) "" Then Chemin Mid(Chemin, 2)
'Ajout éventuel d'un Anti-Slash (\) pour terminer le chemin
If Mid(Chemin, Len(Chemin), 1) <> "" Then Chemin = Chemin & ""
Buff = 0
Buff = RegCreateKey(ConvertClef(ClefRacine), Chemin, lng)
If Buff 0 Then RetVal RegDeleteValue(lng, ByVal Valeur)
If RetVal = 2 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print ClefRacine & "" & Chemin & Valeur & " : " & "Accès Refusé (ERROR_ACCES_DENIED)"
End Function
'

'--------------------------------------------------------------------------------
'Activer l'Autorun de l'application en Cours avec passage de paramètres optionnel
'--------------------------------------------------------------------------------
Public Sub RegAutoRunWrite(Optional Parametres As String)
Dim RetVal As Long
On Error Resume Next
'RegWriteVal ConvertClef(ClefRacine), Chemin, Valeur, Donnees
RetVal = RegWriteVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", App.EXEName, App.Path & "" & App.EXEName & ".exe" & " " & Parametres)
If RetVal = 2 Then Debug.Print "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print "Accès Refusé (ERROR_ACCES_DENIED)"
End Sub
'

'----------------------------------------------------------------
'Vérifier si l'Autorun est activé pour l'application en cours
'----------------------------------------------------------------
Public Function RegAutoRunIsActif() As Boolean
On Error Resume Next
'
If RegReadVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", App.EXEName) <> "" Then RegAutoRunIsActif = True Else RegAutoRunIsActif = False
End Function
'

'----------------------------------------------------------------
'Supprimer l'Autorun de l'application en cours
'----------------------------------------------------------------
Public Sub RegAutoRunDelete()
Dim RetVal As Long
On Error Resume Next
RetVal = RegDeleteVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", App.EXEName)
If RetVal = 2 Then Debug.Print "Clef Invalide (ERROR_BADKEY)"
If RetVal = 8 Then Debug.Print "Accès Refusé (ERROR_ACCES_DENIED)"
End Sub

'----------------------------------------------------------------
' Exemples D'utilisation
'----------------------------------------------------------------
' Ecriture d'une Valeur de clef (dans cet exemple on actie l'autorun)
'RegWriteVal "HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", App.EXEName, Application
' Ecriture d'une valeur de clef de type Dword
'RegWriteValDW "HKEY_LOCAL_MACHINE", "SYSTEM\CurrentControlSet\Services" & App.EXEName, "Type", 272
' Lecture d'une valeur de clef
'RegReadVal "HKEY_LOCAL_MACHINE", "SOFTWARE\Data Fellows\F-Secure\Cog-Secure", "ActiveService"
'ou (valclef est de type variant)
'ValClef = RegReadVal("HKEY_LOCAL_MACHINE", "SOFTWARE\Data Fellows\F-Secure\Cog-Secure", "ActiveService")
'Suppression d'une clef
'RegDeleteClef "HKEY_LOCAL_MACHINE", "SYSTEM\CurrentControlSet\Services" & App.EXEName & "\Parameters"
'Suppression d'une Valeur de clef
'RegDeleteVal "HKEY_LOCAL_MACHINE", "SYSTEM\CurrentControlSet\Services" & App.EXEName & "\Parameters", "Application"
'ou (valclef est de type variant)
'ValClef = RegDeleteVal("HKEY_LOCAL_MACHINE", "Software\Microsoft\Windows\CurrentVersion\Run", "Cog-Secure-Client")
sman0
Messages postés
39
Date d'inscription
mercredi 19 novembre 2003
Statut
Membre
Dernière intervention
3 novembre 2005
-
en effet c'est bien rippé sale boulet

http://www.vbfrance.com/code.aspx?ID=133
cs_Multiprise
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013
-
Exact, un très bon code qui rendra service à ceux qui réfléchissent avant de dire des conneries. Superclic, essai d'écrire dans la base de registres si Vbscript est désactivé sur la machine (Voir statégie de sécurité). Avec les API, pas de problème, tu lis et écris sur n'importe quelle bécane et les antivirus ne te posent pas de problème. Pour qu'un code soit universel, ya pas mieux que les API, évidemment c'est un peu plus hard à programmer. C'est pour cela que le site existe, celui qui sait partage et celui qui croit tout savoir devrait partager le silence.

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.