title image


Smiley Re: Registry auslesen und schreiben.
Wenn Du Netscape verwendest, kannst Du den folgenden Code über die Zwischenablage in ein leeres Standardmodul kopieren:Option Explicit'set this to 0 to disable debug code in this module#Const DebugMode = -1 ' Einschalten: -1; Global: auskommentieren ' -----------------' ADVAPI32' ----------------- ' function prototypes, constants, and type definitions' for Windows 32-bit Registry API Private Const HKEY_CLASSES_ROOT = &H80000000Private Const HKEY_CURRENT_USER = &H80000001Private Const HKEY_LOCAL_MACHINE = &H80000002Private Const HKEY_USERS = &H80000003Private Const HKEY_PERFORMANCE_DATA = &H80000004Private Const HKEY_CURRENT_CONFIG = &H80000005Private Const HKEY_DYN_DATA = &H80000006 ' Registry API prototypes Private Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As LongPrivate Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ phkResult As Long) As LongPrivate 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 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, _ ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _ phkResult As Long, _ lpdwDisposition As Long) As LongPrivate Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ phkResult As Long) As LongPrivate 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 RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ ByVal lpValue As String, _ lpcbValue 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 LongPrivate 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 LongPrivate Declare Function RegQueryValueExByte Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Byte, _ lpcbData As Long) As LongPrivate 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 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String, _ ByVal dwType As Long, _ ByVal lpData As String, _ ByVal cbData As Long) As LongPrivate 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 lpData As String, _ ByVal cbData As Long) As LongPrivate Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _ (ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ lpData As Long, _ ByVal cbData As Long) As LongPrivate Declare Function RegSetValueExByte Lib "advapi32.dll" Alias "RegSetValueExA" _ (ByVal hKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ lpData As Byte, _ ByVal cbData As Long) As LongPrivate 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _ (ByVal hKey As Long, _ ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _ (ByVal hKey As Long, _ ByVal lpValueName As String) As Long ' Reg Data Types...Private Const REG_NONE = 0 ' No value typePrivate Const REG_SZ = 1 ' Unicode nul terminated stringPrivate Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string containing unexpanded enironment variable, like: %path%Private Const REG_BINARY = 3 ' Free form binaryPrivate Const REG_DWORD = 4 ' 32-bit number (Long integer)Private Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)Private Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit numberPrivate Const REG_LINK = 6 ' Symbolic Link (unicode)Private Const REG_MULTI_SZ = 7 ' Multiple Unicode strings Private Const ERROR_SUCCESS = 0 'The configuration registry database operation completed successfully.Private Const ERROR_FILE_NOT_FOUND = 2& 'The system cannot find the file specified. 'Here: The specified key was not found in the registry database.Private Const ERROR_ACCESS_DENIED = 5& 'Access is denied.Private Const ERROR_OUTOFMEMORY = 14& 'Not enough storage is available to complete this operation. 'Here: Insufficient Memory to open the registry key or 'insufficient memory to load the required data 'from the registry file.Private Const ERROR_INVALID_PARAMETER = 87 'dderror 'The parameter is incorrect. 'Parameter is required and not specified, 'an invalid pointer or otherwise not valid. 'und da ist sie: Der Parameter stimmt nicht. (grins)Private Const ERROR_LOCK_FAILED = 167& 'Unable to lock a region of a file. 'Here: Registry reentered while blocked by same process.Private Const ERROR_MORE_DATA = 234 'dderror 'More data is available.Private Const ERROR_NO_MORE_ITEMS = 259 'No more data is available.Private Const ERROR_BADDB = 1009& 'The configuration registry database is corrupt.Private Const ERROR_BADKEY = 1010& 'The configuration registry key or its handle is invalid.Private Const ERROR_CANTOPEN = 1011& 'The configuration registry key could not be opened.Private Const ERROR_CANTREAD = 1012& 'The configuration registry key could not be read.Private Const ERROR_CANTWRITE = 1013& 'The configuration registry key could not be written.Private Const ERROR_REGISTRY_CORRUPT = 1015& 'The Registry is corrupt. The structure of one of the files that contains 'Registry data is corrupt, or the system's image of the file in memory 'is corrupt, or the file could not be recovered because the alternate 'copy or log was absent or corrupt.Private Const ERROR_REGISTRY_IO_FAILED = 1016& 'An I/O operation initiated by the Registry failed unrecoverably. 'The Registry could not read in, or write out, or flush, one of the files 'that contain the system's image of the Registry.Private Const ERROR_KEY_DELETED = 1018& 'Illegal operation attempted on a Registry key which has been marked for deletion. 'Private Const KEY_ALL_ACCESS = &H3F' Reg Key Security OptionsPrivate Const READ_CONTROL = &H20000Private Const SYNCHRONIZE = &H100000 ' für NTPrivate Const STANDARD_RIGHTS_READ = (READ_CONTROL)Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)'Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)'Private Const STANDARD_RIGHTS_REQUIRED = &HF0000Private Const STANDARD_RIGHTS_ALL = &H1F0000 Private Const KEY_QUERY_VALUE = &H1Private Const KEY_SET_VALUE = &H2Private Const KEY_CREATE_SUB_KEY = &H4Private Const KEY_ENUMERATE_SUB_KEYS = &H8Private Const KEY_NOTIFY = &H10Private Const KEY_CREATE_LINK = &H20Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE)) Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebootedPrivate Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted ' nicht unter Windows95Private Const REG_CREATED_NEW_KEY = &H1 ' New Registry Key was createdPrivate Const REG_OPENED_EXISTING_KEY = &H2 ' Existing Key was opened Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" _ (ByVal lpSrc As String, _ ByVal lpDst As String, _ ByVal nSize As Long) As LongPrivate Declare Function GetLastError Lib "kernel32" () As Long '  'SetValueEx and QueryValueEx Wrapper Functions: Public Function QueryValue(Optional StartDirectory& = HKEY_CURRENT_USER, _ Optional sKeyName, _ Optional sValueName, _ Optional TypeToGet) As Variant'*************************************************************************************' Diese Function gibt den Wert eines Keys zurück, der in der Registry steht.'' Beispiel:' Debug_Print QueryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Shared Tools\MSInfo", "Path")'' Gibt den korrekten Dateinamen incl. Pfad für MSINFO32 zurück oder einen Leerstring, wenn nicht installiert' StartDirectory muß eine der folgenden Variablen sein:'' HKEY_CLASSES_ROOT' HKEY_CURRENT_USER' HKEY_LOCAL_MACHINE' HKEY_USERS'' Den Wert, den man sucht, ermittelt man am besten zuerst manuell aus der Registry,' in dem man direkt in der Registry sucht ...'' Näheres siehe unter: HOWTO - Use the Registry API to Save and Retrieve Setting.htm' und: Controlling Entries in the Operating System Registry' Variablen:' StartDirectory: Long, Handle für Key, Default = HKEY_CURRENT_USER' kann auch ein Subkey sein,Z.B. HKEY_LOCAL_MACHINE\SOFTWARE' sKeyName: String, jedoch als Variant deklariert, damit der Parameter fehlen kann.' Wenn sKeyName angegeben wird, wird der entsprechende Subkey geöffnet.' Wenn nicht, dann wird StartDirectory verwendet.' sValueName: String als Variant, siehe oben.' Bezeichner für den Wert "Value" eines Keys. Ein Key kann bekanntlich mehrere Values haben' Wenn sValueName weggelassen wird wird der Default-Wert des Keys (Standard) zurückgegeben' TypeToGet: Optional, VarType in die ein Byte - Array zurückkonvertiert werden soll.'*************************************************************************************  Dim lRetVal As Long 'result of the API functions Dim hKey As Long 'handle of opened key Dim vValue As Variant 'setting of queried value  ' Wenn sKeyName (also Subkey) angegeben wurde, ist dieser Subkey zu öffnen ' Ansonsten ist der Standardkey zu verwenden If Not IsMissing(sKeyName) Then QueryValue = RegOpenKeyEx(hKey:=StartDirectory, lpSubKey:=sKeyName, _ ulOptions:=0&, samDesired:=KEY_ALL_ACCESS, _ phkResult:=hKey) If lRetVal Then Exit Function Else hKey = StartDirectory End If  ' Wenn sValueName fehlt, wird das von QueryValueEx erkannt und richtig behandelt lRetVal = QueryValueEx(hKey, sValueName, vValue, TypeToGet:=TypeToGet)  If lRetVal Then QueryValue = Empty Else QueryValue = vValue End If If Not IsMissing(sKeyName) Then RegCloseKey (hKey) End IfEnd Function Public Function SetValue(Optional StartDirectory& = HKEY_CURRENT_USER, Optional sKeyName, _ Optional sValueName, Optional vValue, Optional CreateIfNotFound As Boolean = True) As Long'*************************************************************************************' Setzt den Wert eines Keys in der Registry' Beispiel:' Dim RetVal&' RetVal = SetValue (HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Shared Tools\MSInfo", "Path", "C:\PROGRA~1\GEMEIN~1\MICROS~1\MSInfo\msinfo32.exe")' If RetVal then Msgbox "Fehler: " & RetVal & GetApiErrorDescription(RetVal)'' Variablen:' StartDirectory: Long, Handle für Key, Default = HKEY_LOCAL_MACHINE,' kann auch ein Subkey sein,Z.B. HKEY_LOCAL_MACHINE\SOFTWARE' sKeyName: String, jedoch als Variant deklariert, damit der Parameter fehlen kann.' Wenn sKeyName angegeben wird, wird der entsprechende Subkey geöffnet.' Wenn nicht, dann wird StartDirectory verwendet.' sValueName: String als Variant, siehe oben.' Bezeichner für den Wert "Value" eines Keys. Ein Key kann bekanntlich mehrere Values haben' Wenn sValueName weggelassen wird wird der Default-Wert des Keys (Standard) zurückgegeben' vValue: Variant, Wert der in die Registry geschrieben werden soll.'************************************************************************************* Dim hKey As Long 'handle of opened key  ' Wenn sKeyName (also Subkey) angegeben wurde, ist dieser Subkey zu öffnen ' Ansonsten ist der Standardkey zu verwenden If Not IsMissing(sKeyName) Then SetValue = RegOpenKeyEx(hKey:=StartDirectory, lpSubKey:=sKeyName, _ ulOptions:=0&, samDesired:=KEY_ALL_ACCESS, _ phkResult:=hKey)  ' Falls Key nicht geöffnet werden konnte, ist ein neuer Key zu erstellen, ' falls das gemäß CreateIfNotFound erlaubt ist. If SetValue = ERROR_FILE_NOT_FOUND And CreateIfNotFound Then SetValue = RegCreateKey(hKey:=StartDirectory, lpSubKey:=sKeyName, _ phkResult:=hKey) End If If SetValue Then Exit Function Else hKey = StartDirectory End If  ' Wenn sValueName fehlt, wird das von SetValueEx erkannt und richtig behandelt SetValue = SetValueEx(hKey, sValueName, vValue)  If Not IsMissing(sKeyName) Then RegCloseKey (hKey) End IfEnd Function Private Function SetValueEx(ByVal hKey As Long, Optional ByVal sValueName, _ Optional ByVal vValue As Variant = Empty) Dim sValue As String Dim lBuffSize As Long Dim i As Long If IsMissing(sValueName) Then ' Der Default-Wert von hKey ist gemeint. If VarType(vValue) vbString Then ' Prüfe, ob vValue ein String ist. ' Für den Default-Wert sind nur Strings zulässig SetValueEx = ERROR_INVALID_PARAMETER Exit Function End If vValue = vValue & vbNullChar SetValueEx = RegSetValue(hKey:=hKey, lpSubKey:=vbNullString, _ dwType:=REG_SZ, lpData:=vValue, _ cbData:=Len(vValue) - 1) Else Select Case VarType(vValue) Case vbEmpty, vbNull ' hier: Eintrag löschen (nicht Key) Case vbString sValue = vValue & Chr$(0) SetValueEx = RegSetValueExString(hKey:=hKey, lpValueName:=sValueName, _ Reserved:=0&, dwType:=REG_SZ, _ lpData:=sValue, cbData:=Len(sValue)) Case vbLong, vbInteger, vbByte, vbBoolean Dim lValue As Long lValue = CLng(vValue) SetValueEx = RegSetValueExLong(hKey:=hKey, lpValueName:=sValueName, _ Reserved:=0&, dwType:=REG_DWORD, _ lpData:=lValue, cbData:=4) Case (vbArray Or vbString) 'Array of Strings For i = LBound(vValue) To UBound(vValue) sValue = sValue & vValue(i) & Chr$(0) Next sValue = sValue & Chr$(0) SetValueEx = RegSetValueExString(hKey:=hKey, lpValueName:=sValueName, _ Reserved:=0&, dwType:=REG_MULTI_SZ, _ lpData:=sValue, cbData:=Len(sValue)) Case vbSingle Dim sngValue As Single sngValue = vValue lBuffSize = 4 SetValueEx = RegSetValueEx(hKey:=hKey, lpValueName:=sValueName, _ Reserved:=0&, dwType:=REG_BINARY, _ lpData:=sngValue, cbData:=lBuffSize) Case vbDouble Dim dblValue As Double dblValue = vValue lBuffSize = 8 SetValueEx = RegSetValueEx(hKey:=hKey, lpValueName:=sValueName, _ Reserved:=0&, dwType:=REG_BINARY, _ lpData:=dblValue, cbData:=lBuffSize) Case Else ' any binary data Dim bValue() As Byte lBuffSize = Len(vValue) ReDim bValue(lBuffSize - 1) agCopyData vValue, bValue(0), lBuffSize SetValueEx = RegSetValueExByte(hKey:=hKey, lpValueName:=sValueName, _ Reserved:=0&, dwType:=REG_BINARY, _ lpData:=bValue(0), cbData:=lBuffSize) End Select End IfEnd Function Private Function QueryValueEx(ByVal lhKey As Long, Optional ByVal szValueName, Optional vValue, Optional TypeToGet) As Long Dim lRetVal As Long Dim lType As Long ' von API Zurückgegebener Variablentyp Dim lValue As Long, sValue As String, bValue() As Byte ' Buffer holding retuned values, Long, String, or Byte array Dim cch As Long ' Lenght of returned buffer  On Error GoTo QueryValueExError  If IsMissing(vValue) Then ' Prüfe, ob vValue übergeben wurde: QueryValueEx = ERROR_INVALID_PARAMETER Exit Function End If  If IsMissing(szValueName) Then ' Defaultwert abfragen '1.) Herausfinden, wie groß der Buffer sein muß: QueryValueEx = RegQueryValue(hKey:=lhKey, lpSubKey:=vbNullString, _ lpValue:=vbNullString, _ lpcbValue:=cch) '2.) Buffer anpassen: sValue = String$(lValue, vbSpace) '3.) Wert holen: QueryValueEx = RegQueryValue(hKey:=lhKey, lpSubKey:=vbNullString, _ lpValue:=sValue, _ lpcbValue:=cch) If QueryValueEx Then vValue = Empty Else vValue = Left(sValue, cch - 1) If Len(vValue) = 0 Then vValue = Empty End If End If Else ' Determine the size and type of data to be read QueryValueEx = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) If QueryValueEx ERROR_SUCCESS Then 'Error 5 QueryValueEx = QueryValueEx Exit Function End If Select Case lType ' For DWORDS Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN: QueryValueEx = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch) If QueryValueEx = ERROR_SUCCESS Then vValue = lValue ' For strings and Multi Strings Case REG_SZ, REG_MULTI_SZ: sValue = String$(cch, vbSpace) QueryValueEx = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch) If QueryValueEx = ERROR_SUCCESS Then vValue = Left$(sValue, cch - 1) Else vValue = Empty End If Case REG_EXPAND_SZ ' String lesen und expandieren sValue = String$(cch - 1, vbSpace) QueryValueEx = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch) If QueryValueEx ERROR_SUCCESS Then vValue = Empty Exit Function End If '1.) Herausfinden, wie groß der Buffer sein muß: lRetVal = ExpandEnvironmentStrings(lpSrc:=sValue, _ lpDst:=vbNullString, _ nSize:=0&) If lRetVal = 0 Then QueryValueEx = Err.LastDllError vValue = Empty Exit Function End If '2.) Buffer anpassen: Dim sDst As String sDst = String$(lRetVal, vbSpace) '3.) Wert holen: lRetVal = ExpandEnvironmentStrings(lpSrc:=sValue, _ lpDst:=sDst, _ nSize:=Len(sDst)) If lRetVal = 0 Or lRetVal > Len(sDst) Then QueryValueEx = Err.LastDllError vValue = Empty Exit Function Else vValue = sDst End If Case Else 'for all other data types: get byte array ReDim bValue(cch) QueryValueEx = RegQueryValueExByte(lhKey, szValueName, 0&, lType, bValue(0), cch) If QueryValueEx = ERROR_SUCCESS Then vValue = bValue Else vValue = Empty Exit Function End If If Not IsMissing(TypeToGet) Then ' Byte - Array nach Wunsch konvertieren Select Case TypeToGet Case vbSingle If cch = 4 Then Dim sngValue As Single agCopyData bValue(0), sngValue, cch vValue = sngValue End If Case vbDouble If cch = 8 Then Dim dblValue As Double agCopyData bValue(0), dblValue, cch vValue = dblValue End If End Select End If End Select End If QueryValueExError:End FunctionDie öffentlichen Funktionen QueryValue(...) und SetValue(...) sind für alle Lebenslagen geeignet.Außerdem gibt's im Archiv noch einen weiteren Beitrag von mir, der zeigt, wie man mit RegQueryMultipleValues mehrere Einträge gleichzeitig lesen kann.Viel Erfolg!Thomas Prötzschcu
Thomas Prötzsch

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: