1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Lire et écrire dans la base de registre facilement quelquesoit l'utilisateur

Lire et écrire dans la base de registre facilement quelquesoit l'utilisateur

1/5 (4 avis)

Snippet vu 7 330 fois - Téléchargée 35 fois

Commenter

Contenu du snippet

Tout le monde connait la fonction GetSettings de VB6.
Elle pose un petit pb sous W2K : elle écrit sous une clé qui dépends de l'utilisateur. Si vous voulez que vos données soient communes à tous les utilisateurs, il faut écrire sous LOCAL_MACHINE et non USER.
Bref, voici une focntion GetSettingsEX() avec les même paramètre que GetSettings originale.

Remarque : si la clé n'existe pas, elle est créée automatiquement...

Source / Exemple : 


Option Explicit

Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_BINARY = 3 ' Free form binary
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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
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

Public Function GetSettigsEX(appName As String, section As String, key As String, Optional defValue As String)
    Dim strpath As String, res As String
    
    strpath = "SOFTWARE\" + appName + "\" + section
    res = GetString(HKEY_LOCAL_MACHINE, strpath, key)
    
    If res = "" And Not IsMissing(defValue) Then
        SaveString HKEY_LOCAL_MACHINE, strpath, key, defValue
        res = defValue
    End If
    
    GetSettigsEX = res
    
End Function

Private Function GetString(hKey As Long, strpath As String, strValue As String) As String
    Dim Ret As Long
    'Open the key
    RegOpenKey hKey, strpath, Ret
    'Get the key's content
    GetString = RegQueryStringValue(Ret, strValue)
    'Close the key
    RegCloseKey Ret
End Function

Private Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    'retrieve nformation about the key
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            'Create a buffer
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's content
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                'Remove the unnecessary chr$(0)'s
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function

Private Sub SaveString(hKey As Long, strpath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strpath, Ret
    'Save a string to the key
    RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
    'close the key
    RegCloseKey Ret
End Sub

Private Sub SaveStringLong(hKey As Long, strpath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strpath, Ret
    'Set the key's value
    RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
    'close the key
    RegCloseKey Ret
End Sub

Private Sub DelSetting(hKey As Long, strpath As String, strValue As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strpath, Ret
    'Delete the key's value
    RegDeleteValue Ret, strValue
    'close the key
    RegCloseKey Ret
End Sub

Conclusion :


Mettre ce code dans un module(.bas), et ajouter ce module à votre projet...

A voir également

Ajouter un commentaire Commentaires
facdaar
Messages postés
64
Date d'inscription
lundi 24 mars 2003
Statut
Membre
Dernière intervention
23 février 2009
16 mai 2003 à 08:46
En effet, je n'ai essayé ça que sous W2K. Je suis qd même surpris que cela ne fonctionne pas sous NT4,vu que c'est le même noyau !
Désolé !
VBbigineure
Messages postés
169
Date d'inscription
vendredi 27 septembre 2002
Statut
Membre
Dernière intervention
27 février 2009
 1
15 mai 2003 à 10:39
Moi je préfère quand y'en a pas, on peut lire le code et s'en inspirer sans trop perdre de temps.
Sinon c'est très bien, ca fonctionne sous W2000 mais pas NT4... qui m'interessait. :(
fifipil909
Messages postés
57
Date d'inscription
jeudi 23 janvier 2003
Statut
Membre
Dernière intervention
24 mai 2006
10 mai 2003 à 11:53
un zip serais le bien venus !!
cs_blabla
Messages postés
112
Date d'inscription
mercredi 28 août 2002
Statut
Membre
Dernière intervention
13 mars 2004
9 mai 2003 à 16:49
Mouais ,j'aime pas quand ya pas de zip.
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 (facdaar)