title image


Smiley biddeschön
Hier ein Codeschnipsel, den ich mal irgendwo aufgegegabelt hab und der das bewerkstelligt. Am besten in ein Modul kopieren und in Ruhe auseinander pflücken.HTH Option Compare DatabaseOption Explicit' Dieses Modul enthält die wichtigsten API32-Aufrufe für Access'RegEdit-FunktionenPublic Const HKEY_CURRENT_USER = &H80000001Public Const HKEY_LOCAL_MACHINE = &H80000002Public Const KEY_QUERY_VALUE = &H1Public Const KEY_SET_VALUE = &H2Public Const KEY_CREATE_SUB_KEY = &H4Public Const KEY_ENUMERATE_SUB_KEYS = &H8Public Const KEY_NOTIFY = &H10Public Const KEY_CREATE_LINK = &H20Public Const KEY_READ = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFYPublic Const KEY_WRITE = KEY_SET_VALUE Or KEY_CREATE_SUB_KEYPublic Const KEY_EXECUTE = KEY_READPublic Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINKPublic Const ERROR_SUCCESS = 0&'Public Const REG_NONE = 0 ' No value typePublic Const REG_SZ = 1 ' Unicode nul terminated string'Public Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string (with environment variable references)'Public Const REG_BINARY = 3 ' Free form binaryPublic Const REG_DWORD = 4 ' 32-bit number'Public Const REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)'Public Const REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number'Public Const REG_LINK = 6 ' Symbolic Link (unicode)'Public Const REG_MULTI_SZ = 7 ' Multiple Unicode strings'Public Const REG_OPTION_NON_VOLATILE = &H0'Public Const REG_CREATED_NEW_KEY = &H1Declare 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 LongDeclare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongDeclare 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 Any) As LongDeclare 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 Any, phkResult As Long, lpdwDisposition As Long) As LongDeclare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As LongDeclare Function RegSetValueEx_String 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 LongDeclare Function RegSetValueEx_DWord 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 Long'Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long'Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As LongFunction ExistKey(Root&, schlüssel$) As Boolean' Prüft auf das Vorhandensein eines Schlüssels.' Diese Funktion sollten Sie aufrufen bevor Sie einen neuen Eintrag hinzufügen' Root ist entweder HKEY_CURRENT_USER oder HKEY_LOCAL_MACHINEDim lResult&, keyhandle& lResult = RegOpenKeyEx(Root, schlüssel, 0, KEY_READ, keyhandle) If lResult = ERROR_SUCCESS Then RegCloseKey keyhandle ExistKey = (lResult = ERROR_SUCCESS)End FunctionFunction GetValue(Root&, KEY$, Field$, Value As Variant) As Boolean' Liefert den Wert eines Eintrags, der durch Root, Schlüssel und Feld spezifiziert wirdDim lResult&, keyhandle&, dwType&Dim zw&, puffergröße&, Puffer$ lResult = RegOpenKeyEx(Root, KEY, 0, KEY_READ, keyhandle) GetValue = (lResult = ERROR_SUCCESS) If lResult ERROR_SUCCESS Then Exit Function ' Schlüssel existiert nicht lResult = RegQueryValueEx(keyhandle, Field, 0&, dwType, ByVal 0&, puffergröße) GetValue = (lResult = ERROR_SUCCESS) If lResult ERROR_SUCCESS Then Exit Function ' Feld existiert nicht Select Case dwType Case REG_SZ ' nullterminierter String Puffer = Space$(puffergröße + 1) lResult = RegQueryValueEx(keyhandle, Field, 0&, dwType, ByVal Puffer, puffergröße) GetValue = (lResult = ERROR_SUCCESS) If lResult ERROR_SUCCESS Then Exit Function ' Fehler beim auslesen des Feldes Value = Puffer Case REG_DWORD ' 32-Bit Number !!!! Word puffergröße = 4 ' = 32 Bit lResult = RegQueryValueEx(keyhandle, Field, 0&, dwType, zw, puffergröße) GetValue = (lResult = ERROR_SUCCESS) If lResult ERROR_SUCCESS Then Exit Function ' Fehler beim auslesen des Feldes Value = zw ' Hier könnten auch die weiteren Datentypen behandelt werden, soweit dies sinnvoll ist End Select If lResult = ERROR_SUCCESS Then RegCloseKey keyhandle GetValue = TrueEnd FunctionFunction SetValue(Root&, KEY$, Field$, Value As Variant) As BooleanDim lResult&, keyhandle&Dim s$, l& lResult = RegOpenKeyEx(Root, KEY, 0, KEY_ALL_ACCESS, keyhandle) If lResult ERROR_SUCCESS Then SetValue = False Exit Function End If Select Case VarType(Value) Case vbInteger, vbLong l = CLng(Value) lResult = RegSetValueEx_DWord(keyhandle, Field, 0, REG_DWORD, l, 4) Case vbString s = CStr(Value) lResult = RegSetValueEx_String(keyhandle, Field, 0, REG_SZ, s, Len(s) + 1) ' +1 für die Null am Ende ' Hier können noch weitere Datentypen umgewandelt bzw. gespeichert werden End Select RegCloseKey keyhandle SetValue = (lResult = ERROR_SUCCESS)End Function

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: