Classe .net de lecture/écriture dans la base de registre

Commenter

Contenu du snippet

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.

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 (NikatorS)