VisualBasic Snippets  

Zugriff auf die Registry:
 

Unter Windows 3.1 hatte der Programmierer die Möglichkeit programmspezifische Parameter in einer INI-Datei zu hinterlegen. Seit Win95 steht hierfür die Registry zur Verfügung.
Auch heute noch ist es manchmal sinnvoll einzelne Werte auch in einer INI-Datei zu hinterlegen (z.B. Übersetzungen von Texten, Pfade etc.) weil diese einfacher zu ändern sind. Sollen jedoch Benutzereinstellungen abgespeichert werden legt man diese in die Registry.

Das grösste Problem an der Registry ist, daß sämtliche Systemrelevanten-Informationen ebenso hier abgelegt sind und es daher durch verändern der Werte zu einem Totalausfall des Systems kommen kann, daher verzichte ich an dieser Stelle auf die Erläuterung wie Einträge gelöscht werden können.


Mit dem untenstehenden Programm-Code können Sie die Werte aus der Registry lesen und hineinschreiben:


Dieser Codeteil kann als eigenständiges Modul verwendet werden:

Option Explicit
'------------------------------------------------------------------
' Konstanten für Registrierungsfunktionen
Global Const tsREG_SZ As Long = 1
Global Const tsREG_DWORD As Long = 4
Global Const tsHKEY_CLASSES_ROOT = &H80000000
Global Const tsHKEY_CURRENT_USER = &H80000001
Global Const tsHKEY_LOCAL_MACHINE = &H80000002
Global Const tsHKEY_USERS = &H80000003

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngHKEY As Long) As Long

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
    (ByVal lngHKEY As Long, ByVal strSubKey As String, _
    ByVal lngReserved As Long, ByVal strClass As String, _
    ByVal lngOptions As Long, ByVal lngDesired As Long, _
    ByVal strSecurityAttributes As Long, lngResult As Long, _
    lngDisposition As Long) As Long

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal lngHKEY As Long, ByVal strSubKey As String, _
    ByVal lngOptions As Long, ByVal lngDesired As Long, _
    lngResult As Long) As Long

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKEY As Long, ByVal strValueName As _
    String, ByVal lngReserved As Long, lngType As Long, ByVal lngData _
    As String, lngData As Long) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKEY As Long, ByVal strValueName As _
    String, ByVal lngReserved As Long, lngType As Long, lngData As _
    Long, lngData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal lngHKEY As Long, ByVal strValueName As _
    String, ByVal lngReserved As Long, lngType As Long, ByVal lngData _
    As Long, lngData As Long) As Long

Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
    "RegSetValueExA" (ByVal lngHKEY As Long, ByVal strValueName As String, _
    ByVal lngReserved As Long, ByVal lngType As Long, ByVal strValue As _
    String, ByVal lngData As Long) As Long

Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
    "RegSetValueExA" (ByVal lngHKEY As Long, ByVal strValueName As String, _
    ByVal lngReserved As Long, ByVal lngType As Long, lngValue As Long, _
    ByVal lngData As Long) As Long

' Registrierungsfehlerwerte
Global Const tsNoError = 0
Global Const tsErrorBadDB = 1
Global Const tsErrorBadKey = 2
Global Const tsErrorCantOpen = 3
Global Const tsErrorCantRead = 4
Global Const tsErrorCantWrite = 5
Global Const tsErrorOutOfMemory = 6
Global Const tsErrorInvalidParameter = 7
Global Const tsErrorAccessDenied = 8
Global Const tsErrorInvalidParameterS = 87
Global Const tsErrorNoMoreItems = 259
Global Const tsKeyAllAccess = &H3F
Global Const tsRegOptionNonVolatile = 0
'--------------------------------------------------------------------------------

' Setzen eines Registrierungseintrags
Public Function SetValueEx(ByVal lngHKEY As Long, strValueName As String, _
            lngType As Long, ByRef varValue As Variant) As Long
    Dim lngValue As Long
    Dim strValue As String
    
    Select Case lngType
        'Wert ist vom Typ String
        Case tsREG_SZ
            strValue = varValue & Chr(0)
            SetValueEx = RegSetValueExString(lngHKEY, strValueName, 0&, _
                                           lngType, strValue, Len(strValue))
        
        'Wert ist vom Typ DWORD (long)
        Case tsREG_DWORD
            lngValue = varValue
            SetValueEx = RegSetValueExLong(lngHKEY, strValueName, 0&, _
                                lngType, lngValue, 4)
    End Select
End Function

' Lesen eines Registierungseintrags
Function QueryValueEx(ByVal lngHKEY As Long, _
                      ByVal strValueName As String, _
                      ByRef varValue As Variant) As Long
    Dim lngCch As Long
    Dim lngRc As Long
    Dim lngType As Long
    Dim lngValue As Long
    Dim strValue As String

    On Error GoTo err_QueryValueEx

    'Ermitteln der Datentypen und Groesse
    lngRc = RegQueryValueExNULL(lngHKEY, strValueName, 0&, lngType, 0&, lngCch)
    If lngRc <> tsNoError Then
        strValue = ""
        lngRc = -1
    Else
        Select Case lngType
            'Fuer Strings
            Case tsREG_SZ:
                strValue = String(lngCch, 0)
    
                lngRc = RegQueryValueExString(lngHKEY, strValueName, 0&, _
                                              lngType, strValue, lngCch)
                If lngRc = tsNoError Then
                    varValue = Left(strValue, lngCch)
                Else
                    varValue = Empty
                End If
            'Fuer DWORDS (long)
            Case tsREG_DWORD:
                lngRc = RegQueryValueExLong(lngHKEY, strValueName, 0&, _
                                            lngType, lngValue, lngCch)
                If lngRc = tsNoError Then
                    varValue = lngValue
                End If
            'alle anderen Datentypen werden nicht unterstuezt
            Case Else
                lngRc = -1
        End Select
    End If
    
exit_QueryValueEx:
    QueryValueEx = lngRc
    Err.Clear
    Exit Function

err_QueryValueEx:
    Resume exit_QueryValueEx

End Function

Public Function tsSetRegKey _
        (ByVal lngKEY As Long, _
         ByVal strSubKey As String, _
         ByVal strValueName As String, _
         ByVal strValue As String)
Dim lngRetVal As Long     ' Ergebniswert der API-Funktion
Dim lngHKEY As Long       ' Handle des Registrierungseintrags
Dim varValue As Variant   ' Wert der Registrierungseintrags
Dim varX As Variant

    strValue = strValue & Chr(0)
    varX = tsGetRegKey(lngKEY, strSubKey, strValue)
    
    ' Registierung öffnen
    lngRetVal = RegOpenKeyEx(lngKEY, "", 0&, tsKeyAllAccess, lngHKEY)
    ' Schlüssel erstellen
    RegCreateKeyEx lngKEY, strSubKey, 0&, tsREG_SZ, 0&, 0&, 0&, 0&, 0&
    
    ' Registierung erneut öffnen,
    ' lngHKEY enthält anschließend den Zeiger auf den Eintrag
    lngRetVal = RegOpenKeyEx(lngKEY, strSubKey, 0&, tsKeyAllAccess, lngHKEY)
    ' Wert setzen
    tsSetRegKey = RegSetValueExString(lngHKEY, strValueName, 0&, tsREG_SZ, strValue, Len(strValue))
    ' Registry schliessen
    RegCloseKey (lngHKEY)

End Function

Public Function tsGetRegKey _
        (ByVal lngKEY As Long, _
         ByVal strSubKey As String, _
         ByVal strValueName As String) As Variant
Dim lngRetVal As Long     ' Ergebniswert der API-Funktion
Dim lngHKEY As Long       ' Handle des Registrierungseintrags
Dim varValue As Variant   ' Wert der Registrierungseintrags

    ' Registierung öffnen,
    ' lngHKEY enthält anschließend den Zeiger auf den Eintrag
    lngRetVal = RegOpenKeyEx(lngKEY, strSubKey, 0, _
                                            tsKeyAllAccess, lngHKEY)
    ' Abfragen des Werts
    lngRetVal = QueryValueEx(lngHKEY, strValueName, varValue)
    If lngRetVal <> -1 Then
        tsGetRegKey = Left(varValue, Len(varValue) - 1)
    Else
        tsGetRegKey = "Schlüssel nicht gefunden !!"
    End If
    RegCloseKey (lngHKEY)

End Function

Der Aufruf der Funktion gestaltet sich dann wie folgt:
'schreiben
tsSetRegKey tsHKEY_CURRENT_USER, "Software/BytesAndMore", "Test", "Dies ist ein Test"

'lesen
MsgBox tsGetRegKey(tsHKEY_CURRENT_USER, "Software/BytesAndMore", "Test")

'---------------------------------------------------------------------------------------
Viel Spass !!

  Download des VB6
Moduls
 

© '2000 by T. Schindzielorz