Voici un bout de code permettant de travailler sereinement dans la base de registre.
On peut lire/écrire partout pas comme avec GetSetting/SaveSetting et sans utiliser "Set WshShell = WScript.CreateObject("WScript.Shell")" qui n'est pas pratique et pas stable.
Et point important, j'utilise le .NET
Les erreurs éventuelles peuvent être lues ou ignorées.
Source / Exemple :
'****************************************************************************
'**** La classe Registre ****
'****************************************************************************
Public Class Registre
Delegate Sub delegueException(ByVal ex As Exception)
Private adresseException As delegueException
Public Enum RegisterKeys
HKCR = 1
HKCU = 2
HKLM = 4
HKU = 8
HKCC = 16
HKEY_CLASSES_ROOT = HKCR
HKEY_CURRENT_USER = HKCU
HKEY_LOCAL_MACHINE = HKLM
HKEY_USERS = HKU
HKEY_CURRENT_CONFIG = HKCC
End Enum
Public Sub New()
adresseException = Nothing
End Sub
Public Sub New(ByRef SubDelegueException As delegueException)
adresseException = SubDelegueException
End Sub
Private Sub ExceptionCalled(ByRef ex As Exception)
If Not adresseException Is Nothing Then
adresseException(ex)
End If
End Sub
Private Function OpenSubKey_Create_False(ByVal sKey As RegisterKeys, ByVal sSubKey As String) As RegistryKey
'Ouvre la sous clé et ne la crée pas si elle n'existe pas
Select Case sKey
Case RegisterKeys.HKCR
Return Registry.ClassesRoot.OpenSubKey(sSubKey, False)
Case RegisterKeys.HKCU
Return Registry.CurrentUser.OpenSubKey(sSubKey, False)
Case RegisterKeys.HKLM
Return Registry.LocalMachine.OpenSubKey(sSubKey, False)
Case RegisterKeys.HKU
Return Registry.Users.OpenSubKey(sSubKey, False)
Case RegisterKeys.HKCC
Return Registry.CurrentConfig.OpenSubKey(sSubKey, False)
Case Else
Return Registry.CurrentUser.OpenSubKey(sSubKey, False)
End Select
End Function
Private Function OpenSubKey_Create_True(ByVal sKey As RegisterKeys, ByVal sSubKey As String) As RegistryKey
'Ouvre la sous clé, si elle n'existe pas, elle est créée
Select Case sKey
Case RegisterKeys.HKCR
Return Registry.ClassesRoot.OpenSubKey(sSubKey, True)
Case RegisterKeys.HKCU
Return Registry.CurrentUser.OpenSubKey(sSubKey, True)
Case RegisterKeys.HKLM
Return Registry.LocalMachine.OpenSubKey(sSubKey, True)
Case RegisterKeys.HKU
Return Registry.Users.OpenSubKey(sSubKey, True)
Case RegisterKeys.HKCC
Return Registry.CurrentConfig.OpenSubKey(sSubKey, True)
Case Else
Return Registry.CurrentUser.OpenSubKey(sSubKey, True)
End Select
End Function
Public Function ReadValue(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String, ByVal sDefault As Object, ByVal sCreateIfDontExist As Boolean) As Object
Dim regVersion As RegistryKey
Dim Ret As Object
Try
regVersion = OpenSubKey_Create_False(sKey, sSubKey)
If regVersion Is Nothing And sCreateIfDontExist Then
' La clé n'existe pas ; crée la clé si voulu.
Select Case sKey
Case RegisterKeys.HKCR
regVersion = Registry.ClassesRoot.CreateSubKey(sSubKey)
Case RegisterKeys.HKCU
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
Case RegisterKeys.HKLM
regVersion = Registry.LocalMachine.CreateSubKey(sSubKey)
Case RegisterKeys.HKU
regVersion = Registry.Users.CreateSubKey(sSubKey)
Case RegisterKeys.HKCC
regVersion = Registry.CurrentConfig.CreateSubKey(sSubKey)
Case Else
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
End Select
regVersion.SetValue(sName, sDefault)
End If
If (Not regVersion Is Nothing) Then
Ret = regVersion.GetValue(sName, sDefault)
regVersion.Close()
Else
Ret = sDefault
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function ReadValue(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String, ByVal sDefault As Object) As Object
Return ReadValue(sKey, sSubKey, sName, sDefault, False)
End Function
Public Function ReadValue(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String, ByVal sCreateIfDontExist As Boolean) As Object
Return ReadValue(sKey, sSubKey, sName, 0, sCreateIfDontExist)
End Function
Public Function ReadValue(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String) As Object
Return ReadValue(sKey, sSubKey, sName, 0, False)
End Function
Public Function WriteValue(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String, ByVal sValue As Object, ByVal sType As Microsoft.Win32.RegistryValueKind) As Boolean
Dim regVersion As RegistryKey
Dim Ret As Boolean
Try
regVersion = OpenSubKey_Create_True(sKey, sSubKey)
If regVersion Is Nothing Then
' La clé n'existe pas ; crée la clé.
Select Case sKey
Case RegisterKeys.HKCR
regVersion = Registry.ClassesRoot.CreateSubKey(sSubKey)
Case RegisterKeys.HKCU
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
Case RegisterKeys.HKLM
regVersion = Registry.LocalMachine.CreateSubKey(sSubKey)
Case RegisterKeys.HKU
regVersion = Registry.Users.CreateSubKey(sSubKey)
Case RegisterKeys.HKCC
regVersion = Registry.CurrentConfig.CreateSubKey(sSubKey)
Case Else
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
End Select
End If
If (Not regVersion Is Nothing) Then
regVersion.SetValue(sName, sValue, sType)
regVersion.Close()
Ret = True
Else
Ret = False
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function WriteValue(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String, ByVal sValue As Object) As Object
Return WriteValue(sKey, sSubKey, sName, sValue, RegistryValueKind.String)
End Function
Public Function DeleteName(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sName As String) As Boolean
Dim regVersion As RegistryKey
Dim Ret As Boolean
Try
regVersion = OpenSubKey_Create_True(sKey, sSubKey)
If (Not regVersion Is Nothing) Then
regVersion.DeleteValue(sName, False)
Ret = True
regVersion.Close()
Else
Ret = Nothing
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function DeleteSubKey(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sDeletingSubKey As String) As Boolean
Dim regVersion As RegistryKey
Dim Ret As Boolean
Try
regVersion = OpenSubKey_Create_True(sKey, sSubKey)
If (Not regVersion Is Nothing) Then
regVersion.DeleteSubKey(sDeletingSubKey, False)
Ret = True
regVersion.Close()
Else
Ret = Nothing
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function DeleteSubKeyTree(ByVal sKey As RegisterKeys, ByVal sSubKey As String, ByVal sDeletingSubKey As String) As Boolean
Dim regVersion As RegistryKey
Dim Ret As Boolean
Try
regVersion = OpenSubKey_Create_True(sKey, sSubKey)
If (Not regVersion Is Nothing) Then
Try
regVersion.DeleteSubKeyTree(sDeletingSubKey)
Catch ex As Exception
End Try
Ret = True
regVersion.Close()
Else
Ret = Nothing
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function GetAllSubKeys(ByVal sKey As RegisterKeys, ByVal sSubKey As String) As String()
Dim regVersion As RegistryKey
Dim Ret As String()
Try
regVersion = OpenSubKey_Create_True(sKey, sSubKey)
If regVersion Is Nothing Then
' La clé n'existe pas ; crée la clé.
Select Case sKey
Case RegisterKeys.HKCR
regVersion = Registry.ClassesRoot.CreateSubKey(sSubKey)
Case RegisterKeys.HKCU
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
Case RegisterKeys.HKLM
regVersion = Registry.LocalMachine.CreateSubKey(sSubKey)
Case RegisterKeys.HKU
regVersion = Registry.Users.CreateSubKey(sSubKey)
Case RegisterKeys.HKCC
regVersion = Registry.CurrentConfig.CreateSubKey(sSubKey)
Case Else
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
End Select
End If
If (Not regVersion Is Nothing) Then
Ret = regVersion.GetSubKeyNames()
regVersion.Close()
Else
Ret = Nothing
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function GetAllSubName(ByVal sKey As RegisterKeys, ByVal sSubKey As String) As String()
Dim regVersion As RegistryKey
Dim Ret As String()
Try
regVersion = OpenSubKey_Create_True(sKey, sSubKey)
If regVersion Is Nothing Then
' La clé n'existe pas ; crée la clé.
Select Case sKey
Case RegisterKeys.HKCR
regVersion = Registry.ClassesRoot.CreateSubKey(sSubKey)
Case RegisterKeys.HKCU
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
Case RegisterKeys.HKLM
regVersion = Registry.LocalMachine.CreateSubKey(sSubKey)
Case RegisterKeys.HKU
regVersion = Registry.Users.CreateSubKey(sSubKey)
Case RegisterKeys.HKCC
regVersion = Registry.CurrentConfig.CreateSubKey(sSubKey)
Case Else
regVersion = Registry.CurrentUser.CreateSubKey(sSubKey)
End Select
End If
If (Not regVersion Is Nothing) Then
Ret = regVersion.GetValueNames()
regVersion.Close()
Else
Ret = Nothing
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return Nothing
End Try
End Function
Public Function ValueCount(ByVal sKey As RegisterKeys, ByVal sSubKey As String) As Integer
Dim regVersion As RegistryKey
Dim Ret As Object
Try
regVersion = OpenSubKey_Create_False(sKey, sSubKey)
If (Not regVersion Is Nothing) Then
Ret = regVersion.ValueCount
regVersion.Close()
Else
Ret = -1
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return -1
End Try
End Function
Public Function SubKeyCount(ByVal sKey As RegisterKeys, ByVal sSubKey As String) As Integer
Dim regVersion As RegistryKey
Dim Ret As Object
Try
regVersion = OpenSubKey_Create_False(sKey, sSubKey)
If (Not regVersion Is Nothing) Then
Ret = regVersion.SubKeyCount
regVersion.Close()
Else
Ret = -1
End If
Return Ret
Catch ex As Exception
ExceptionCalled(ex)
Return -1
End Try
End Function
End Class
'*****************************************************************************
'**** Exemple d'utilisation ****
'*****************************************************************************
Const HKCU As Registre.RegisterKeys = Registre.RegisterKeys.HKCU
Const RegApplication As String = "Software\\MonApplication\\MonRepertoire"
Private Sub FonctionPrincipale()
Dim Reg As New Registre()
Dim RegExcept As New Registre(New Registre.delegueException(AddressOf TraiterException))
Dim Ret As Integer
'Ecrit un String
Reg.WriteValue(HKCU, RegApplication, "Nom", "MonApplication")
'Lit un String
Ret = Reg.ReadValue(HKCU, RegApplication, "ShowMe", 0)
Visible = CBool(Ret)
ShowInTaskbar = Visible
'Lit un Byte
Ret = Reg.ReadValue(HKCU, RegApplication, "KillMe", 0)
If Ret = 1 Then
Me.Close()
'Ecrit un Byte
Reg.WriteValue(HKCU, RegApplication, "KillMe", 0, Microsoft.Win32.RegistryValueKind.Binary)
End If
'Lit un Boolean
Etat = CBool(Reg.ReadValue(HKCU, RegApplication, "EtatBoolean", sDefault:=False)
Etat = Not Etat
'Ecrit un Boolean
Reg.WriteValue(HKCU, RegApplication, "EtatBoolean", Etat, Microsoft.Win32.RegistryValueKind.DWord)
'Déclenche un erreur, récupérer dans "TraiterException"
RegExcept.WriteValue(HKCU, RegApplication, "EtatBoolean", Etat, Microsoft.Win32.RegistryValueKind.Binary)
'Déclenche une erreur, mais rien n'est récupérer
Reg.WriteValue(HKCU, RegApplication, "EtatBoolean", Etat, Microsoft.Win32.RegistryValueKind.Binary)
End Sub
Private Sub TraiterException(ByVal ex As Exception)
'Affiche le message d'erreur
MsgBox(ex.Message)
End Sub
Conclusion :
Le paramètre "sSubKey" contient l'arborescence où vous souhaitez lire et écrire. Chaque sous-répertoires doit être séparés par un double anti-slash - "\\" - surtout pas un anti-slash seul - "\".
Si vous souhaitez enregistrer un Boolean, n'utilisez pas "RegistryValueKind.Binary" mais plutôt "RegistryValueKind.DWord" pour le paramètre "sType".
Enfin pour qu'il n'y pas de confusion avec les surcharges de la fonction "ReadValue" entre le paramètre "sDefault" et "sCreateIfDontExist" écrivez ceci : "sDefault:=True"
Ci-dessus, un exemple pour utiliser la classe.
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.