Visual Basic World - Programmierung und BeispieleVisual Basic World - Tipps und TutorialsVisual Basic World - Source-Code und Forum

<leer>

Tipp 033: Die Windows-Registry verwenden

Autor: Joern Wittek   VB-Version: Visual Basic 6.0   Download: Beispielprojekt Tipp-033

Beschreibung

Dieses Beispiel bietet fast alles, was man im Bereich Registry wissen und können sollte. Angefangen vom Erstellen einzelner Schlüssel, über das Anlegen von Werten bis hin zu einer kompletten Auflistung aller in einem Schlüssel befindlichen „Unter-Schlüssel“ ist alles enthalten. Ebenso wird gezeigt wie Sie einen Schlüssel wieder entfernen können. Die dazu benötigten API- und Sub-Funktioen sind übersichtlich in einem eigenen Modul gekapselt.

Quellcode

frmRegistry
CommandButton            cmdEnumInfos
CommandButton            cmdEnumInfos
CommandButton            cmdRegistry
CommandButton            cmdRegistry
CommandButton            cmdRegistry
CommandButton            cmdRegistry
CommandButton            cmdRegistry
CommandButton            cmdRegistry
CommandButton            cmdRegistry
Form                     frmRegistry
Label                    lblNumVal
Label                    lblString
Line                     Line1
ListBox                  lstRegistry
TextBox                  txtNumVal
' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld
'
' Autor: Joern Wittek [http://www.abgaenger2001.net]

Option Explicit Private WithEvents Registry As clsRegistry Attribute Registry.VB_VarHelpID = -1
Private Sub Registry_EnumKey(sSubKeyName As String) lstRegistry.AddItem sSubKeyName End Sub
Private Sub Registry_EnumValue(sValueName As String, _ vValueSetting As Variant, lValueType As Long) lstRegistry.AddItem sValueName & vbTab & vValueSetting _ & vbTab & lValueType End Sub
Private Sub cmdEnumInfos_Click(Index As Integer) Dim Test As String lstRegistry.Clear Select Case Index Case 0 Registry.EnumKeys lKeyRoot.HKEY_CURRENT_USER, _ "Software" Case 1 Registry.EnumValues lKeyRoot.HKEY_CURRENT_USER, _ "Software\Microsoft\VBA\Microsoft Visual Basic" End Select End Sub
Private Sub cmdRegistry_Click(Index As Integer) Select Case Index Case 0 Registry.CreateKey lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel" Case 1 If IsNumeric(txtNumVal.Text) = True Then _ Registry.SetNumericValue lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel", "NumValue", txtNumVal.Text Case 2 lblNumVal.Caption = _ Registry.QueryNumericValue(lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel", "NumValue") Case 3 Registry.SetStringValue lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel", "StrValue", txtString.Text Case 4 lblString.Caption = _ Registry.QueryStringValue(lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel", "StrValue") Case 5 Registry.EnableDelete = True Registry.DeleteValue lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel", "StrValue" Registry.EnableDelete = True Registry.DeleteValue lKeyRoot.HKEY_CURRENT_USER, _ "Neuer Schlüssel", "NumValue" Case 6 Registry.EnableDelete = True Registry.DeleteKey lKeyRoot.HKEY_CURRENT_USER, "Neuer Schlüssel" End Select End Sub
Private Sub Form_Load() Set Registry = New clsRegistry lblNumVal.Caption = "" lblString.Caption = "" End Sub


clsRegistry
' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld
'
' Autor: Joern Wittek [http://www.abgaenger2001.net]
'
' +-----------------------------------------+
' | Klasse für Zugriff auf die Registry von |
' |      Windows 9x (nicht Windows NT)      |
' +-----------------------------------------+
' |           Copyright 2001 by:            |
' |          Abgänger 2001 Online           |
' +-----------------------------------------+

Option Explicit 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, _ lpSecurityAttributes As tSecurity_Attributes, _ phkResult As Long, _ lpdwDisposition 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 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 tFileTime) 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, _ ByVal lpData As String, _ lpcbData 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 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 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 RegSetValueExLong Lib "advapi32.dll" _ Alias "RegSetValueExA" ( _ ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ lpValue As Long, _ ByVal cbData As Long) As Long Private Declare Function RegSetValueExString Lib "advapi32.dll" _ Alias "RegSetValueExA" ( _ ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ ByVal lpValue As String, _ ByVal cbData As Long) As Long Public Event EnumKey(sSubKeyName As String) 'Tritt für jeden gefundenen Schlüssel auf. Public Event EnumKeyComplete() 'Tritt auf, wenn Schlüsselenumeration abgeschlossen. Public Event EnumValue(sValueName As String, _ vValueSetting As Variant, lValueType As Long) 'Tritt für jeden gefundenen Wert auf. Public Event EnumValueComplete() 'Tritt auf, wenn Werteenumeration abgeschlossen. Public Event RegistryError(ErrorCode As Long) 'Tritt auf, wenn beim Zugriff ein Fehler auftrat Private mbEnableDelete As Boolean 'Löschen erlaubt Private Const REG_OPTION_NON_VOLATILE = 0 'Schlüssel bleibt beim Neustart erhalten Private Const READ_CONTROL = &H20000 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 KEY_NOTIFY = &H10 Private Const KEY_CREATE_LINK = &H20 Private Const KEY_READ = KEY_QUERY_VALUE + _ KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL Private Const KEY_WRITE = KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + READ_CONTROL Private Const KEY_EXECUTE = KEY_READ Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + _ KEY_SET_VALUE + KEY_CREATE_SUB_KEY + _ KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + _ READ_CONTROL 'Zugriffsoptionen: 'Da aus Gründen der Kompaktheit dieses Klassenmoduls eine 'gemeinsamgenutze Prozedur zum Öffnen eines Schlüssels 'deshalb werden nicht die spezifizierten, sondern nur 'KEY_ALL_ACCESS genutzt. '--- Datentypen ---' Public Enum lValueType REG_SZ = 1 REG_DWORD = 4 End Enum '--- Fehlercodes ---' Public Enum lErrorCode REG_ERROR_SUCCESS = 0 REG_ERROR_BADKEY = 2 REG_ERROR_CANTOPEN = 3 REG_ERROR_CANTREAD = 4 REG_ERROR_CANTWRITE = 5 REG_ERROR_OUTOFMEMORY = 6 REG_ERROR_INVALID_PARAMETER = 7 REG_ERROR_ACCESS_DENIED = 8 REG_ERROR_INVALID_PARAMETERS = 87 REG_ERROR_MORE_DATA = 234 REG_ERROR_NO_MORE_ITEMS = 259 End Enum '--- Basen ---' Public Enum lKeyRoot HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_PERFORMANCE_DATA = &H80000004 HKEY_CURRENT_CONFIG = &H80000005 HKEY_DYN_DATA = &H80000006 End Enum '--- Filetime-Typ ---' Private Type tFileTime dwLowDateTime As Long dwHighDateTime As Long End Type '--- SecurityAttributes-Typ ---' Private Type tSecurity_Attributes lLength As Long lSecurityDescriptor As Long bInheritHandle As Boolean End Type Public Property Let EnableDelete(ByVal ubNewValue As Boolean) 'Setzt das Flag zum Löschen von Werten und Schlüsseln mbEnableDelete = ubNewValue End Property Public Property Get EnableDelete() As Boolean 'Liest das Flag zum Löschen von Werten und Schlüsseln EnableDelete = mbEnableDelete End Property
Public Sub CreateKey(lKeyRoot As Long, sKeyName As String) 'Legt einen Schlüssel neu an und öffnet ihn. Dim hKey As Long Dim lRetVal As Long Dim tScAttr As tSecurity_Attributes tScAttr.lLength = 50 tScAttr.lSecurityDescriptor = 0 tScAttr.bInheritHandle = True lRetVal = RegCreateKeyEx(lKeyRoot, sKeyName, 0&, _ vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _ tScAttr, hKey, lRetVal) If lRetVal <> REG_ERROR_SUCCESS Then RaiseEvent RegistryError(lRetVal) End If RegCloseKey (hKey) End Sub
Public Sub DeleteKey(lKeyRoot As Long, sKeyName As String) 'Löscht einen Schlüssel (Benötigt EnableDelete = True) 'ACHTUNG! DIESE METHODE RÄUMT JEDEN SCHLÜSSEL RADIKAL LEER! 'NUR MIT ÄUßERSTER VORSICHT EINSETZEN! BEI UNSACHGEMÄßER 'VERWENDUNG KANN DAS WINDOWS-SYSTEM BESCHÄDIGT WERDEN! 'WIR ÜBERNEHME KEINE HAFTUNG! 'Hinweis: Unter Windows NT müssen zuerst alle Unterschlüssel, 'sofern vorhanden, entfernt werden, damit die DeleteKey-Methode 'fehlerfrei ausgeführt wird. Dim lRetVal As Long If mbEnableDelete = True Then lRetVal = RegDeleteKey(lKeyRoot, sKeyName) If lRetVal <> REG_ERROR_SUCCESS Then RaiseEvent RegistryError(lRetVal) End If End If mbEnableDelete = False End Sub
Public Sub DeleteValue(lKeyRoot As Long, sKeyName As String, _ sValueName As String) 'Löscht einen Wert (Benötigt EnableDelete = True) Dim hKey As Long Dim lRetVal As Long If (OpenKey(lKeyRoot, sKeyName, hKey) = True) And _ (mbEnableDelete = True) Then lRetVal = RegDeleteValue(hKey, sValueName) If lRetVal <> REG_ERROR_SUCCESS Then RaiseEvent RegistryError(lRetVal) End If End If lRetVal = RegCloseKey(hKey) mbEnableDelete = False End Sub
Public Function EnumKeys(lKeyRoot As Long, sKeyName As String) 'Ruft für jeden gefundenen Unterschlüssel das Ereignis 'EnumKeys(<Name>) auf. Wenn keine weitern Unterschlüssel 'existieren, wird das Ereignis EnumValueComplete ausgelöst. Dim hKey As Long Dim lCurIndex As Long Dim lRetVal As Long Dim lSubKeyNameLen As Long Dim sSubKeyName As String Dim tFileTime As tFileTime If OpenKey(lKeyRoot, sKeyName, hKey) = True Then lCurIndex = 0 Do lSubKeyNameLen = 1024 sSubKeyName = String(lSubKeyNameLen, Chr(32)) lRetVal = RegEnumKeyEx(hKey, lCurIndex, sSubKeyName, _ lSubKeyNameLen, 0, vbNullChar, vbNull, tFileTime) If lRetVal = REG_ERROR_SUCCESS Then sSubKeyName = Left(sSubKeyName, lSubKeyNameLen) RaiseEvent EnumKey(sSubKeyName) End If lCurIndex = lCurIndex + 1 Loop While lRetVal <> REG_ERROR_NO_MORE_ITEMS RaiseEvent EnumKeyComplete End If lRetVal = RegCloseKey(hKey) End Function
Public Function EnumValues(lKeyRoot As Long, sKeyName As String) 'Ruft für jeden gefundenen Wert das Ereignis 'EnumValue(<Name>,<Wert>,<Typ>) auf. Wenn keine weiteren 'Werte vorliegen wird das Ereignis EnumValueComplete ausgelöst. Dim hKey As Long Dim lCurIndex As Long Dim lDWORD As Long Dim lRetVal As Long Dim lValueNameLen As Long Dim lValueSettingLen As Long Dim lValueType As Long Dim sValueName As String Dim sValueSetting As String Dim vValueSetting As Variant If OpenKey(lKeyRoot, sKeyName, hKey) = True Then lCurIndex = 0 Do lValueNameLen = 1024 lValueSettingLen = 1024 sValueName = String(lValueNameLen, Chr(32)) sValueSetting = String(lValueSettingLen, Chr(32)) lRetVal = RegEnumValue(hKey, lCurIndex, sValueName, _ lValueNameLen, 0, lValueType, sValueSetting, _ lValueSettingLen) If lRetVal = REG_ERROR_SUCCESS Then sValueName = Left(sValueName, lValueNameLen) Select Case lValueType Case REG_SZ vValueSetting = Left(sValueSetting, _ lValueSettingLen - 1) Case REG_DWORD vValueSetting = QueryNumericValue( _ lKeyRoot, sKeyName, sValueName) End Select RaiseEvent EnumValue(sValueName, vValueSetting, _ lValueType) Else RaiseEvent RegistryError(lRetVal) lRetVal = RegCloseKey(hKey) Exit Function End If lCurIndex = lCurIndex + 1 Loop While lRetVal <> REG_ERROR_NO_MORE_ITEMS RaiseEvent EnumValueComplete End If lRetVal = RegCloseKey(hKey) End Function
Private Function OpenKey(lKeyRoot As Long, sKeyName As String, _ hKey As Long) As Boolean 'Öffnet einen Schlüssel zur weiteren Verwendung 'durch andere Methoden. Dim lRetVal As Long OpenKey = False lRetVal = RegOpenKeyEx(lKeyRoot, sKeyName, 0, _ KEY_ALL_ACCESS, hKey) Select Case lRetVal Case REG_ERROR_SUCCESS OpenKey = True Case REG_ERROR_BADKEY CreateKey lKeyRoot, sKeyName lRetVal = RegOpenKeyEx(lKeyRoot, sKeyName, 0, _ KEY_ALL_ACCESS, hKey) If lRetVal = REG_ERROR_SUCCESS Then OpenKey = True Else RaiseEvent RegistryError(REG_ERROR_CANTOPEN) End If Case Else RaiseEvent RegistryError(lRetVal) End Select End Function
Public Function QueryNumericValue(lKeyRoot As Long, _ sKeyName As String, sValueName As String) As Long 'Liest einen Numerischen Wert QueryNumericValue = 0 Dim hKey As Long Dim lRetVal As Long Dim lValueSetting If OpenKey(lKeyRoot, sKeyName, hKey) = True Then lRetVal = RegQueryValueExLong(hKey, sValueName, _ 0&, REG_DWORD, lValueSetting, 4) If lRetVal <> REG_ERROR_SUCCESS Then RaiseEvent RegistryError(lRetVal) lRetVal = RegCloseKey(hKey) Exit Function End If QueryNumericValue = lValueSetting End If lRetVal = RegCloseKey(hKey) End Function
Public Function QueryStringValue(lKeyRoot As Long, _ sKeyName As String, sValueName As String) As String 'Liest einen String QueryStringValue = "" Dim hKey As Long Dim lRetVal As Long Dim lValueSettingType As Long Dim lValueSettingLength As Long Dim sValueSetting As String If OpenKey(lKeyRoot, sKeyName, hKey) = True Then lRetVal = RegQueryValueEx(hKey, sValueName, _ 0&, lValueSettingType, 0&, lValueSettingLength) If (lRetVal <> REG_ERROR_SUCCESS) And _ (lRetVal <> REG_ERROR_MORE_DATA) Then RaiseEvent RegistryError(lRetVal) lRetVal = RegCloseKey(hKey) Exit Function End If sValueSetting = String(lValueSettingLength, vbNullChar) lRetVal = RegQueryValueExString(hKey, sValueName, _ 0&, lValueSettingType, sValueSetting, lValueSettingLength) If lRetVal <> REG_ERROR_SUCCESS Then RaiseEvent RegistryError(lRetVal) lRetVal = RegCloseKey(hKey) Exit Function End If QueryStringValue = Left(sValueSetting, _ lValueSettingLength - 1) End If lRetVal = RegCloseKey(hKey) End Function
Public Sub SetNumericValue(lKeyRoot As Long, _ sKeyName As String, sValueName As String, lValueSetting As Long) 'Setzt einen Numerischen Wert oder erzeugt ihn, 'wenn er noch nicht existiert. Dim hKey As Long Dim lRetVal As Long If OpenKey(lKeyRoot, sKeyName, hKey) = True Then lRetVal = RegSetValueExLong(hKey, sValueName, _ 0&, REG_DWORD, lValueSetting, 4) If lRetVal = REG_ERROR_BADKEY Then RaiseEvent RegistryError(REG_ERROR_BADKEY) End If End If lRetVal = RegCloseKey(hKey) End Sub
Public Sub SetStringValue(lKeyRoot As Long, sKeyName As String, _ sValueName As String, sValueSetting As String) 'Setzt einen String oder erzeugt ihn, 'wenn er noch nicht existiert. Dim hKey As Long Dim lRetVal As Long If OpenKey(lKeyRoot, sKeyName, hKey) = True Then If sValueSetting = "" Then sValueSetting = Space(1) sValueSetting = sValueSetting & vbNullChar lRetVal = RegSetValueExString(hKey, sValueName, _ 0&, REG_SZ, sValueSetting, Len(sValueSetting)) If lRetVal = REG_ERROR_BADKEY Then RaiseEvent RegistryError(REG_ERROR_BADKEY) End If End If lRetVal = RegCloseKey(hKey) End Sub

<leer> Aktuelle Seite Back To Top
Druckansicht | Feedback | Favoriten
Copyright © Visual Basic World, 2000-2022 | Kontakt | Impressum

Visual Basic World @ Twitter

Folgen Sie Visual Basic World!

Visual Basic World @ Twitter
Wenn Ihnen Visual Basic World gefällt, dann folgen Sie uns doch bei Twitter (@visualbasicwrld).
Vielen Dank!