You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
542 lines
20 KiB
QBasic
542 lines
20 KiB
QBasic
Attribute VB_Name = "MRegistry"
|
|
Option Explicit
|
|
|
|
'Modul für den Zugriff auf die Windows-Registierungsdatenbank (Registry)
|
|
'© 2000-2002, INOSOFT GmbH
|
|
'Version 4.04.000
|
|
|
|
'Funktionen:
|
|
'-Read Liest einen Wert aus der Windows-Registierungsdatenbank
|
|
'-ReadEx Liest einen Wert aus der Windows-Registierungsdatenbank (mit Wertprüfung)
|
|
'-Store Schreibt einen Wert in die Windows-Registierungsdatenbank
|
|
'-Keys Gibt alle (Unter)-Schlüssel eines Pfades der Windows-Registierungsdatenbank zurück
|
|
'-Values Gibt alle Einträge eines Pfades der Windows-Registierungsdatenbank zurück
|
|
'-DeleteKey Entfernt einen kompletten Schlüssel (inkl. Werte und Unterschlüssel)
|
|
'-DeleteValue Entfernt einen Wert aus der Windows-Registierungsdatenbank
|
|
|
|
'Abhängigkeiten/zusätzliche Dateien:
|
|
'-CVWValue.cls Klassenmodul "CVWValue"
|
|
|
|
Public Enum ERegType
|
|
REG_NONE = 0
|
|
REG_SZ = 1
|
|
REG_EXPAND_SZ = 2
|
|
REG_BINARY = 3
|
|
REG_DWORD = 4
|
|
REG_MULTI_SZ = 7
|
|
End Enum
|
|
|
|
Public Enum ERegLevel
|
|
HKEY_CLASSES_ROOT = &H80000000
|
|
HKEY_CURRENT_CONFIG = &H80000005
|
|
HKEY_CURRENT_USER = &H80000001
|
|
HKEY_DYN_DATA = &H80000006
|
|
HKEY_LOCAL_MACHINE = &H80000002
|
|
HKEY_PERFORMANCE_DATA = &H80000004
|
|
HKEY_USERS = &H80000003
|
|
End Enum
|
|
|
|
|
|
|
|
Private Const KEY_QUERY_VALUE = &H1
|
|
Private Const KEY_SET_VALUE = &H2
|
|
Private Const KEY_CREATE_SUB_KEY = &H4
|
|
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
|
|
Private Const READ_CONTROL = &H20000
|
|
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
|
|
Private Const KEY_NOTIFY = &H10
|
|
Private Const SYNCHRONIZE = &H100000
|
|
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
|
|
|
|
Private Const ERROR_SUCCESS = 0&
|
|
Private Const ERROR_FILE_NOT_FOUND = 2&
|
|
Private Const ERROR_NO_MORE_ITEMS = 259&
|
|
Private Const ERROR_MORE_DATA = 234
|
|
|
|
Private Type FILETIME
|
|
dwLowDateTime As Long
|
|
dwHighDateTime As Long
|
|
End Type
|
|
|
|
|
|
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, _
|
|
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 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 RegSetValueExStr Lib "advapi32.dll" Alias "RegSetValueExA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal lpValueName As String, _
|
|
ByVal Reserved As Long, _
|
|
ByVal dwType As Long, _
|
|
ByVal lpData As String, _
|
|
ByVal cbData 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
|
|
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal lpValueName As String _
|
|
) As Long
|
|
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal lpSubKey As String _
|
|
) As Long
|
|
Private Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal lpSubKey As String _
|
|
) As Long
|
|
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal dwIndex As Long, _
|
|
ByVal lpValueName As String, _
|
|
lpcbValueName As Long, _
|
|
ByVal lpReserved As Long, _
|
|
lpType As Long, _
|
|
lpData As Any, _
|
|
lpcbData As Long _
|
|
) As Long
|
|
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal lpClass As String, _
|
|
lpcbClass As Long, _
|
|
ByVal lpReserved As Long, _
|
|
lpcSubKeys As Long, _
|
|
lpcbMaxSubKeyLen As Long, _
|
|
lpcbMaxClassLen As Long, _
|
|
lpCVWValues As Long, _
|
|
lpcbMaxValueNameLen As Long, _
|
|
lpcbMaxValueLen As Long, _
|
|
lpcbSecurityDescriptor As Long, _
|
|
lpftLastWriteTime As Any _
|
|
) As Long
|
|
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
|
|
(ByVal hKey As Long, _
|
|
ByVal dwIndex As Long, _
|
|
ByVal lpName As String, _
|
|
lpcbName As Long, _
|
|
ByVal lpReserved As Long, _
|
|
ByVal lpClass As String, _
|
|
lpcbClass As Long, _
|
|
lpftLastWriteTime As FILETIME _
|
|
) As Long
|
|
|
|
Private Declare Function RegCloseKey Lib "advapi32.dll" _
|
|
(ByVal hKey As Long) _
|
|
As Long
|
|
|
|
|
|
|
|
Public Function Read(ByVal Level As ERegLevel, _
|
|
ByVal Path As String, _
|
|
ByVal Name As String, _
|
|
Optional ByVal Default As Variant _
|
|
) As Variant
|
|
'Liest einen Wert aus der Windows-Registierungsdatenbank
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Eintrags
|
|
' Name: Name des Eintrags
|
|
' Default: Vorgabewert, wenn kein Eintrag gefunden wurde
|
|
'Ausgabe:
|
|
' Read: Wert des Eintrags als Long/String/Bytefeld
|
|
' oder Default, wenn nicht vorhanden
|
|
'Anwendung:
|
|
' Dim s as string
|
|
' s = MRegistry.Read(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion", "CommonFilesDir")
|
|
'
|
|
' Dim v As Variant
|
|
' 'Liest den Eintrag "ZZZ" aus dem Pfad "HKEY_LOCAL_MACHINE\SOFTWARE\XXX"
|
|
' 'Ist der Eintrag nicht vorhanden, wird je nach Default-Belegung ein anderer Rückgabewert geliefert
|
|
' v = MRegistry.Read(HKEY_LOCAL_MACHINE, "SOFTWARE\XXX", "ZZZ") ' Null
|
|
' v = MRegistry.Read(HKEY_LOCAL_MACHINE, "SOFTWARE\XXX", "ZZZ", 1) ' 1 (Integer)
|
|
' v = MRegistry.Read(HKEY_LOCAL_MACHINE, "SOFTWARE\XXX", "ZZZ", "1") ' "1" (String)
|
|
|
|
Dim hKey As Long, lR As Long, lLen As Long, enmRegTyp As ERegType
|
|
Dim sBuffer As String, lBuffer As Long, bBuffer() As Byte
|
|
|
|
If IsMissing(Default) Then
|
|
Read = Null
|
|
Else
|
|
Read = Default
|
|
End If
|
|
|
|
lR = RegOpenKeyEx(Level, Path, 0, KEY_QUERY_VALUE, hKey)
|
|
If lR = ERROR_SUCCESS Then
|
|
lLen = 0
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, ByVal 0&, lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
Select Case enmRegTyp
|
|
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
|
|
lLen = lLen + 2
|
|
sBuffer = Space$(lLen)
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, ByVal sBuffer, lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
If lLen = 0 Then
|
|
Read = ""
|
|
Else
|
|
Read = Left$(sBuffer, lLen - 1)
|
|
End If
|
|
End If
|
|
Case REG_BINARY
|
|
ReDim bBuffer(lLen - 1)
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, bBuffer(0), lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
Read = bBuffer
|
|
End If
|
|
Case REG_DWORD
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, lBuffer, lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
Read = lBuffer
|
|
End If
|
|
End Select
|
|
End If
|
|
RegCloseKey hKey
|
|
End If
|
|
End Function
|
|
|
|
Public Function ReadEx(ByVal Level As ERegLevel, _
|
|
ByVal Path As String, _
|
|
ByVal Name As String, _
|
|
Optional ByVal Default As Variant, _
|
|
Optional ByVal Minimum As Variant, _
|
|
Optional ByVal Maximum As Variant _
|
|
) As Variant
|
|
'Liest einen Wert aus der Windows-Registierungsdatenbank
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Eintrags
|
|
' Name: Name des Eintrags
|
|
' Default: Vorgabewert, wenn kein Eintrag gefunden wurde
|
|
' Minimum/Maximum: Grenzen, in denen der Wert liegen muss,
|
|
' andernfalls wird der Default-Wert zurückgegeben
|
|
'Ausgabe:
|
|
' ReadEx: Wert des Eintrags als Long/String/Bytefeld
|
|
' oder Default, wenn nicht vorhanden
|
|
|
|
Dim hKey As Long, lR As Long, lLen As Long, enmRegTyp As ERegType
|
|
Dim sBuffer As String, lBuffer As Long, bBuffer() As Byte
|
|
|
|
If IsMissing(Default) Then
|
|
ReadEx = Null
|
|
Else
|
|
ReadEx = Default
|
|
End If
|
|
|
|
lR = RegOpenKeyEx(Level, Path, 0, KEY_QUERY_VALUE, hKey)
|
|
If lR = ERROR_SUCCESS Then
|
|
lLen = 0
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, ByVal 0&, lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
Select Case enmRegTyp
|
|
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
|
|
lLen = lLen + 2
|
|
sBuffer = Space$(lLen)
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, ByVal sBuffer, lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
If lLen = 0 Then
|
|
ReadEx = ""
|
|
Else
|
|
ReadEx = Left$(sBuffer, lLen - 1)
|
|
End If
|
|
End If
|
|
Case REG_BINARY
|
|
ReDim bBuffer(lLen - 1)
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, bBuffer(0), lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
ReadEx = bBuffer
|
|
End If
|
|
Case REG_DWORD
|
|
lR = RegQueryValueEx(hKey, Name, 0, enmRegTyp, lBuffer, lLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
ReadEx = lBuffer
|
|
End If
|
|
End Select
|
|
End If
|
|
RegCloseKey hKey
|
|
End If
|
|
|
|
If Not IsMissing(Minimum) Then
|
|
If ReadEx < Minimum Then
|
|
If IsMissing(Default) Then
|
|
ReadEx = Minimum
|
|
Else
|
|
ReadEx = Default
|
|
End If
|
|
End If
|
|
End If
|
|
If Not IsMissing(Maximum) Then
|
|
If ReadEx > Maximum Then
|
|
If IsMissing(Default) Then
|
|
ReadEx = Maximum
|
|
Else
|
|
ReadEx = Default
|
|
End If
|
|
End If
|
|
End If
|
|
End Function
|
|
|
|
Public Function Store(ByVal Level As ERegLevel, _
|
|
ByVal Path As String, _
|
|
ByVal Name As Variant, _
|
|
ByVal Value As Variant, _
|
|
ByVal KeyType As ERegType _
|
|
) As Boolean
|
|
'Schreibt einen Wert in die Windows-Registierungsdatenbank
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Eintrags
|
|
' Name: Name des Eintrags
|
|
' oder Null => Pfad wird komplett entfernt
|
|
' Value: neuer Wert des Eintrags (Long/String/Bytefeld)
|
|
' oder Null => Eintrag wird entfernt
|
|
' KeyType: Datentyp des Eintrags
|
|
'Ausgabe:
|
|
' Store: True=Wert geschrieben
|
|
' False=Fehler, Wert nicht geschrieben
|
|
'Anwendung:
|
|
' MRegistry.Store HKEY_LOCAL_MACHINE, "SOFTWARE\XXX", "ZZZ", 123, REG_DWORD
|
|
' MRegistry.Store HKEY_LOCAL_MACHINE, "SOFTWARE\XXX", "ZZZ", "Hallo", REG_SZ
|
|
|
|
Dim hKey As Long, lR As Long
|
|
Dim sBuffer As String, lBuffer As Long, bBuffer() As Byte
|
|
|
|
Store = False
|
|
|
|
If IsNull(Name) Then
|
|
'Pfad komplett entfernen
|
|
Store = DeleteKey(Level, Path)
|
|
ElseIf IsNull(Value) Then
|
|
'Eintrag entfernen
|
|
Store = DeleteValue(Level, Path, Name)
|
|
Else
|
|
'Eintrag schreiben
|
|
lR = RegCreateKeyEx(Level, Path, 0, vbNullString, 0, KEY_SET_VALUE + KEY_CREATE_SUB_KEY, ByVal 0&, hKey, lBuffer)
|
|
If lR = ERROR_SUCCESS Then
|
|
'Eintrag schreiben
|
|
Select Case KeyType
|
|
Case REG_SZ, REG_EXPAND_SZ
|
|
sBuffer = Value
|
|
lR = RegSetValueExStr(hKey, Name, 0, KeyType, sBuffer, Len(sBuffer))
|
|
Case REG_MULTI_SZ
|
|
sBuffer = Value
|
|
lR = RegSetValueExStr(hKey, Name, 0, KeyType, sBuffer, Len(sBuffer))
|
|
Case REG_DWORD
|
|
lBuffer = Value
|
|
lR = RegSetValueEx(hKey, Name, 0, KeyType, lBuffer, 4)
|
|
Case REG_BINARY
|
|
bBuffer = Value
|
|
lR = RegSetValueEx(hKey, Name, 0, KeyType, bBuffer(0), UBound(bBuffer) + 1)
|
|
Case Else
|
|
lR = Not ERROR_SUCCESS
|
|
End Select
|
|
End If
|
|
If lR = ERROR_SUCCESS Then
|
|
Store = True
|
|
End If
|
|
RegCloseKey hKey
|
|
End If
|
|
End Function
|
|
|
|
Public Function Values(ByVal Level As ERegLevel, _
|
|
ByVal Path As String _
|
|
) As Collection
|
|
'Gibt alle Einträge eines Pfades der Windows-Registierungsdatenbank zurück
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Eintrags (Name des Schlüssels)
|
|
'Ausgabe:
|
|
' Values: Collection mit CVWValue-Elementen mit den Einträgen:
|
|
' CVWValue enthält den Namen und den Wert des Eintrags.
|
|
'Anwendung:
|
|
' Dim col As Collection, c As CVWValue
|
|
' Set col = MRegistry.Values(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion")
|
|
' For Each c In col
|
|
' Debug.Print c.Name; "="; c.Value
|
|
' Next c
|
|
|
|
Dim hKey As Long, lR As Long, lIndex As Long, enmRegTyp As ERegType
|
|
Dim sName As String, lNLen As Long, lNMaxLen As Long
|
|
Dim lBLen As Long, sBuffer As String, lBuffer As Long, bBuffer() As Byte
|
|
Dim col As New Collection, clsValue As CVWValue
|
|
|
|
lR = RegOpenKeyEx(Level, Path, 0, KEY_READ, hKey)
|
|
If lR = ERROR_SUCCESS Then
|
|
lR = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, 0, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, lNMaxLen, ByVal 0&, ByVal 0&, ByVal 0&)
|
|
If lR = ERROR_SUCCESS Then
|
|
lIndex = 0
|
|
Do
|
|
Set clsValue = New CVWValue
|
|
lNLen = lNMaxLen + 1
|
|
sName = Space$(lNLen)
|
|
lBLen = 0
|
|
lR = RegEnumValue(hKey, lIndex, sName, lNLen, 0, enmRegTyp, ByVal 0&, lBLen)
|
|
If lR = ERROR_NO_MORE_ITEMS Then Exit Do
|
|
lNLen = lNMaxLen + 1
|
|
If lR = ERROR_SUCCESS Then
|
|
Select Case enmRegTyp
|
|
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
|
|
lBLen = lBLen + 2
|
|
sBuffer = Space$(lBLen)
|
|
lR = RegEnumValue(hKey, lIndex, sName, lNLen, 0, enmRegTyp, ByVal sBuffer, lBLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
If lBLen = 0 Then
|
|
clsValue.Value = ""
|
|
Else
|
|
clsValue.Value = Left$(sBuffer, lBLen - 1)
|
|
End If
|
|
End If
|
|
Case REG_BINARY
|
|
ReDim bBuffer(lBLen - 1)
|
|
lR = RegEnumValue(hKey, lIndex, sName, lNLen, 0, enmRegTyp, bBuffer(0), lBLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
clsValue.Value = bBuffer
|
|
End If
|
|
Case REG_DWORD
|
|
lR = RegEnumValue(hKey, lIndex, sName, lNLen, 0, enmRegTyp, lBuffer, lBLen)
|
|
If lR = ERROR_SUCCESS Then
|
|
clsValue.Value = lBuffer
|
|
End If
|
|
End Select
|
|
If lR = ERROR_SUCCESS Then
|
|
clsValue.Name = Left$(sName, lNLen)
|
|
col.Add clsValue
|
|
End If
|
|
End If
|
|
lIndex = lIndex + 1
|
|
Loop
|
|
End If
|
|
RegCloseKey hKey
|
|
End If
|
|
Set Values = col
|
|
End Function
|
|
|
|
Public Function Keys(ByVal Level As ERegLevel, _
|
|
ByVal Path As String _
|
|
) As Collection
|
|
'Gibt alle (Unter)-Schlüssel eines Pfades der Windows-Registierungsdatenbank zurück
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Eintrags (Name des Schlüssels)
|
|
'Ausgabe:
|
|
' Keys: Collection mit den Schlüsseln (Strings)
|
|
|
|
Dim hKey As Long, lR As Long, lIndex As Long
|
|
Dim sName As String, lNLen As Long, lNMaxLen As Long
|
|
Dim lBLen As Long, sBuffer As String, lBuffer As Long, bBuffer() As Byte
|
|
Dim col As New Collection
|
|
Dim uFileTime As FILETIME
|
|
|
|
lR = RegOpenKeyEx(Level, Path, 0, KEY_READ, hKey)
|
|
If lR = ERROR_SUCCESS Then
|
|
lR = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, 0, ByVal 0&, lNMaxLen, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&)
|
|
If lR = ERROR_SUCCESS Then
|
|
lIndex = 0
|
|
Do
|
|
lNLen = lNMaxLen + 1
|
|
sName = Space$(lNLen)
|
|
lBLen = 0
|
|
lR = RegEnumKeyEx(hKey, lIndex, sName, lNLen, 0, vbNullString, ByVal 0&, uFileTime)
|
|
If lR = ERROR_NO_MORE_ITEMS Then Exit Do
|
|
If lR = ERROR_SUCCESS Then
|
|
col.Add Left$(sName, lNLen)
|
|
End If
|
|
lIndex = lIndex + 1
|
|
Loop
|
|
End If
|
|
RegCloseKey hKey
|
|
End If
|
|
Set Keys = col
|
|
End Function
|
|
|
|
Public Function DeleteValue(ByVal Level As ERegLevel, _
|
|
ByVal Path As String, _
|
|
ByVal Name As String _
|
|
) As Boolean
|
|
'Entfernt einen Wert aus der Windows-Registierungsdatenbank
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Eintrags
|
|
' Name: Name des Eintrags
|
|
'Ausgabe:
|
|
' DeleteValue: True=Wert gelöscht
|
|
' False=Fehler, Wert nicht gelöscht
|
|
|
|
Dim hKey As Long, lR As Long
|
|
|
|
DeleteValue = False
|
|
lR = RegOpenKeyEx(Level, Path, 0, KEY_SET_VALUE, hKey)
|
|
Select Case lR
|
|
Case ERROR_SUCCESS
|
|
lR = RegDeleteValue(hKey, Name)
|
|
If lR = ERROR_SUCCESS Or lR = ERROR_FILE_NOT_FOUND Then
|
|
DeleteValue = True
|
|
End If
|
|
RegCloseKey hKey
|
|
Case ERROR_FILE_NOT_FOUND
|
|
DeleteValue = True
|
|
End Select
|
|
End Function
|
|
|
|
Public Function DeleteKey(ByVal Level As ERegLevel, _
|
|
ByVal Path As String _
|
|
) As Boolean
|
|
'Entfernt einen kompletten Schlüssel (inkl. Werte und Unterschlüssel)
|
|
'aus der Windows-Registierungsdatenbank
|
|
'Eingabe:
|
|
' Level: Bereich der Registrierung
|
|
' Path: Pfad des Schlüssels
|
|
'Ausgabe:
|
|
' DeleteKey: True=Schlüssel gelöscht
|
|
' False=Fehler, Schlüssel nicht gelöscht
|
|
|
|
Dim hKey As Long, lR As Long
|
|
|
|
On Error Resume Next
|
|
DeleteKey = False
|
|
lR = RegOpenKeyEx(Level, vbNullString, 0, KEY_SET_VALUE, hKey)
|
|
If lR = ERROR_SUCCESS Then
|
|
'Diese Funktion funktiert nur unter Win 95/98
|
|
lR = RegDeleteKey(hKey, Path)
|
|
If Err.Number Then
|
|
'Diese Funktion funktioniert nur unter Win 98/2000
|
|
'oder Win 95/NT mit IE4.0
|
|
lR = SHDeleteKey(hKey, Path)
|
|
End If
|
|
If lR = ERROR_SUCCESS Or lR = ERROR_FILE_NOT_FOUND Then
|
|
DeleteKey = True
|
|
End If
|
|
RegCloseKey hKey
|
|
End If
|
|
Err.Clear
|
|
End Function
|
|
|
|
|