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

Commenter

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

S'inscrire maintenant

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.

Du même auteur (cs_Tatar)