Download regbiblio.zip (4 kB)

GSGetSetting(HKEY As HKeyEnum, Section As String, Key As String) as Variant

HKEY: Einer der unter "HKeyEnum" definierten Werte
z.B.: hkLocalMachine

Section: Pfadangabe
z.B.: " Enum\Monitor\Default_Monitor\0001"

Key: KeyName wie z.B.
"Hardware_ID"

Der Rückgabewert der Funktion GSGetSetting ist der unter
HKEY\Section\Key gelesene Wert (Variant mit Untertyp String
oder Long)
Ist der angegebene Pfad nicht vorhanden oder ist der gelesene Wert
nicht vom Typ String oder Long, wird Empty zurückgegeben.
 

GSSaveSetting(HKEY As HKeyEnum, _
                        Section As String,
                        Key As String, _
                        Setting As Variant, _
                        Optional SaveAsString As Variant) As Long

HKEY:     Einer der unter "HKeyEnum" definierten Werte
               z.B.: hkLocalMachine
Section:   Pfadangabe
Key:        KeyName

Setting:    Wert der unter HKEY\Section\Key eingetragen werden soll
SaveAsString:    True -> Wert wird als String behandelt
                        False -> Wert wird als Zahl (Long) behandelt

Ist Section\Key noch nicht vorhanden, so wird der enstpr. Pfad erzeugt

Rückgabewert der Funktion GSSaveSetting:
0 wenn GSSaveSetting erfolgreich war,
<> 0 bei Fehler
 

HKEY:      Einer der unter "HKeyEnum" definierten Werte
                z.B.: hkLocalMachine
Section:    Pfad der erzeugt werden soll

Rückgabewert der Funktion GSCreateNewSection:
    0 wenn erfolgreich
    <> 0 bei Fehler
 

HKEY:     Einer der unter "HKeyEnum" definierten Werte
               z.B.: hkLocalMachine

Section:   Pfadangabe

Key:        KeyName

Rückgabewert der Funktion GSDeleteSetting:
    0 wenn erfolgreich gelöscht wurde
    <> 0 bei Fehler
 

HKEY:     Einer der unter "HKeyEnum" definierten Werte
               z.B.: hkLocalMachine

Section:   Pfadangabe

'Win 95: Löscht den in Section angegebenen Bereich (Section)
einschl. der untergeordneten Verzeichnisse

NT: Löscht den in Section angegebenen Bereich (Section),
wenn dieser nicht weitere Unterverzeichnisse enthält.
 
Rückgabewert der Funktion GSDeleteSection:
    0 wenn erfolgreich gelöscht wurde
    <> 0 bei Fehler

 

Option Explicit

'Konstanten für HKEY
Public Enum HKeyEnum
    hkClassesRoot = &H80000000
    hkCurrentUser = &H80000001
    hkLocalMachine = &H80000002
    hkUsers = &H80000003
    hkPerformanceData = &H80000004
    hkCurrentConfig = &H80000005
    hkDynData = &H80000006
End Enum

'übrige Konstanten
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
Private Const REG_OPTION_NON_VOLATILE = 0

'Deklarationen für API-Aufrufe
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKEY As Long) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal HKEY As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) _
As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal HKEY As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Long, lpcbData As Long) As Long

Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal HKEY As Long, ByVal lpSubKey As String) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal HKEY As Long, ByVal lpValueName As String) As Long

' Ende der Deklarationen
'___________________

Public Function GSCreateNewSection(HKEY As HKeyEnum, Section As String) As Long
    'Erzeugt eine neue Section in der Registry
    ' Rückgabewert:
    ' 0, wenn Section fehlerfrei erzeugt wurde
    ' Fehlernummer <> 0 bei Fehler

    Dim Cl As Boolean
    Dim hNewKey As Long 'Handle für neuen Key
    Dim Ret As Long
    Dim Disposition As Long     ' wird in dieser Funktion nicht ausgewertet
    ' Disposition = 1: ein neuer Key wurde erzeugt
    ' Disposition = 2: Key bereits vorhanden, wurde nur geöffnet

    Ret = RegCreateKeyEx(HKEY, Section, 0&, vbNullString, _
                                        REG_OPTION_NON_VOLATILE, _
                                        KEY_CREATE_SUB_KEY, _
                                        0&, hNewKey, Disposition)
    If Ret = 0 Then
        RegCloseKey (hNewKey)
    End If
    GSCreateNewSection = Ret
End Function

Public Function GSSaveSetting(HKEY As Long, Section As String, Key As String, _
                            Setting As Variant, Optional SaveAsString As Variant) As Long
    ' Speichert unter HKEY - Section\Key den mit Setting übergebenen Wert.
    ' SaveAsString:
    '         Wird SaveAsString = True übergeben, _
              so wird der in Setting übergebene Wert als null-terminierter String gespeichert

    '         Wird SaveAsString = False übergeben, _
              so wird der in Setting übergebene Wert als 32-Bit-Zahl (Long) gespeichert. _
             
    '         Enthält Setting keinen Wert vom Typ Integer oder Long so wird nichts gespeichert. _
              Der Rückgabewert der Funktion ist dann -1.

    ' HKEY muss einen gültigen (vordefinierten) Pfad angeben _
     siehe Definitionen "HKeyEnum"

    ' Ist Section\Key noch nicht vorhanden, so wird der enstpr. Pfad erzeugt

    ' Rückgabewert:
    '         0, wenn kein Fehler aufgetreten ist
    '         <> 0 bei Fehler

    Dim Ret As Long 'Rückgabewert der API-Funktionen
    Dim hKeyOpened As Long    'Handle des akt. geöffneten Keys
    Dim LongSetting As Long
    Dim Disposition As Long
    Dim StringSetting As String
    Dim StringTypeFlag As Boolean

    If IsMissing(SaveAsString) Then
        'Standardvorgabe (True)
        StringTypeFlag = True
    Else
        If VarType(SaveAsString) = vbBoolean Then
            'wenn SaveAsString als Boolean übergeben wurde, _
            dann übernehmen
            StringTypeFlag = SaveAsString
        Else
            'SaveAsSting war nicht vbBoolean, _
            also Standardvorgabe (True)
            StringTypeFlag = True
        End If
    End If

    'falls der mit RegCreateKeyEx zu erstellende Pfad bereits existiert, _
    wird dieser einfach nur geöffnet (s. Disposition)

    Ret = RegCreateKeyEx(HKEY, Section, 0&, vbNullString, _
                                        REG_OPTION_NON_VOLATILE, _
                                        KEY_CREATE_SUB_KEY Or KEY_SET_VALUE, _
                                        0&, hKeyOpened, Disposition)

    'Disposition wird in dieser Funktion nicht ausgewertet
    'Disposition = 1: ein neuer Key wurde erzeugt
    'Disposition = 2: Key bereits vorhanden, wurde nur geöffnet

    If Ret = 0 Then
        Select Case StringTypeFlag
            Case True
                StringSetting = Setting
                Ret = RegSetValueExString(hKeyOpened, Key, 0&, _
                                                REG_SZ, StringSetting, Len(StringSetting))
            Case False
                Select Case VarType(Setting)
                    Case 2 To 3
                        'nur Ganzzahlen zulassen (Integer, Long)
                        LongSetting = Setting
                        Ret = RegSetValueExLong(hKeyOpened, Key, 0&, _
                                                                REG_DWORD, LongSetting, 4)
                    Case Else
                        Ret = -1
                End Select
        End Select
        RegCloseKey (hKeyOpened)
    End If
    GSSaveSetting = Ret
End Function

Public Function GSGetSetting(HKEY As Long, Section As String, Key As String) As Variant
    ' Gibt die unter Section\Key gespeicherten Daten zurück
    ' Wird der angegebene Pfad nicht gefunden, _
      so wird Empty (VarType() = Empty) zurückgegeben
    ' Es werden nur die Datentypen String (REG_SZ) und Long (REG_DWORD) gelesen _
      werden andere Datentypen erkannt, so wird Empty zurückgegeben.
    ' HKEY: HKEY_CLASSES_ROOT , HKEY_CURRENT_USER, _
     HKEY_LOCAL_MACHINE, HKEY_USERS

    Dim Ret As Long 'Rückgabewert der API Funktionen
    Dim hKeyOpened As Long 'Handle für den akt. geöffneten Key
    Dim Setting As Variant 'unter dem abgefragten Schlüssel gespeicherte Daten
    Dim BufferSize As Long
    Dim ValueType As Long
    Dim lngSetting As Long
    Dim strSetting As String

    Ret = RegOpenKeyEx(HKEY, Section, 0, KEY_QUERY_VALUE, hKeyOpened)

    If Ret = 0 Then
        ' Typ und Länge des Eintrages ermitteln
        Ret = RegQueryValueExNULL(hKeyOpened, Key, 0&, ValueType, 0&, BufferSize)
        If Ret = 0 Then
            Select Case ValueType
                Case REG_SZ              'Strings
                    'Speicherplatz reservieren
                    strSetting = String$(BufferSize, 0)
                    Ret = RegQueryValueExString(hKeyOpened, Key, 0&, _
                                                                 ValueType, strSetting, BufferSize)
                    If Ret = 0 Then
                        If BufferSize > 0 Then
                            Setting = Left$(strSetting, BufferSize - 1)
                        Else
                            Setting = ""
                        End If
                    End If

                Case REG_DWORD     'Zahlen (long)
                    Ret = RegQueryValueExLong(hKeyOpened, Key, 0&, _
                                                                ValueType, lngSetting, BufferSize)
                    If Ret = 0 Then
                        Setting = lngSetting
                    End If

                Case Else
                    'andere Typen werden nicht unterstützt
                    Ret = -1
            End Select
        End If
        GSGetSetting = Setting
        RegCloseKey (hKeyOpened)
    End If
End Function

Public Function GSDeleteSetting(HKEY As Long, Section As String, Key As String) As Long
    ' Löscht den unter HKEY - Section\Key gespeicherten Wert

    ' Rückgabewert:
    ' 0, wenn Löschen erfolgreich war
    ' Fehlernummer <> 0, bei Fehler

    Dim Ret As Long 'Rückgabewert der API-Funktionen
    Dim hKeyOpened As Long 'Handle des akt. geöffneten Keys

    Ret = RegOpenKeyEx(HKEY, Section, 0, KEY_SET_VALUE, hKeyOpened)
    If Ret = 0 Then
        Ret = RegDeleteValue(hKeyOpened, Key)
        RegCloseKey (hKeyOpened)
    End If
    GSDeleteSetting = Ret
End Function

Public Function GSDeleteSection(HKEY As Long, Section As String) As Long
    ' Win 95: Löscht den in Section angegebenen Bereich (Section) _
      einschl. der untergeordneten Verzeichnisse
    ' WinNT/2k/XP: Löscht den in Section angegebenen Bereich (Section), _
      wenn dieser nicht weitere Unterverzeichnisse enthält.

    ' Rückgabewert:
    ' 0, wenn gelöscht wurde
    ' Fehlernummer <> 0, wenn nicht gelöscht werden konnte

    GSDeleteSection = RegDeleteKey(HKEY, Section)
End Function
 

 Download regbiblio.zip (4 kB)