Registry - wie mit VB/VBA verwalten ?

wie ich immer mitbekomme haben viele Probleme beim Lesen / Schreiben der Registry. Ich poste mal anbei ein Modul. Kopiere dies einfach in dein Project und schon hast du alle nötigen Prozeduren zur Verfügung!

Es ist unter VB getestet, sollte aber unter VBA auch ihren Dienst machen :)

'Aufruf von folgendenden Subs / Functionen sind möglich

 DeleteAutoRun 'Löscht AutoRun Eintrag
 DeleteAutoRunOnce 'Löscht AutoRunOnce Eintrag
 DeleteKey 'Löscht einen Schluessel
 SetAutoRun 'Setzt einen AutoRun Eintrag
 SetAutoRunOnce 'Setzt einen AutoRunOnce Eintrag
 SetValue 'Setzt einen Wert, wobei ueber Typ die Form des Eintrages gesetzt werden kann ( REG_SZ ,REG_BINARY ,REG_DWORD)
 WerteLoeschen 'Löscht einen Wert
 WertLesen 'Liest einen Wert

So nun das Modul :)

Option Explicit

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public 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
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Enum RegistryData
 zBYTE = 1
 zDWORD = 2
 zSTRING = 3
End Enum

Public Const HKEY_CURRENT_USER = &H80000001
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

Public Function SetValue(Key As String, Field As String, vdata As Variant, Typ As RegistryData) As Boolean
On Error GoTo ErrHandler
 Dim tmp As String
 Dim tmp1 As Byte
 Dim tmp2 As Long
 Select Case Typ
  Case 1 'Byte
   tmp1 = CByte(vdata)
   SetValue = StringSpeichernByte(HKEY_CURRENT_USER, Key, Field, CStr(tmp1))
  Case 2 'DWORD
   tmp2 = CLng(vdata)
   SetValue = StringSpeichernLong(HKEY_CURRENT_USER, Key, Field, tmp2)
  Case 3 'STRING
   tmp = CStr(vdata)
   SetValue = StringSpeichern(HKEY_CURRENT_USER, Key, Field, tmp)
 End Select
ErrHandler:
End Function

Private Function StringSpeichern(hKey As Long, sPath As String, sValue As String, iData As String) As Boolean
On Error GoTo ErrHandler
Dim vRet As Variant
 RegCreateKey hKey, sPath, vRet
 RegSetValueEx vRet, sValue, 0, REG_SZ, ByVal iData, Len(iData)
 RegCloseKey vRet
 StringSpeichern = True
ErrHandler:
End Function

Private Function StringSpeichernByte(hKey As Long, sPath As String, sValue As String, iData As String) As Boolean
On Error GoTo ErrHandler
Dim vRet As Variant
 RegCreateKey hKey, sPath, vRet
 RegSetValueEx vRet, sValue, 0, REG_BINARY, CByte(iData), 4
 RegCloseKey vRet
 StringSpeichernByte = True
ErrHandler:
End Function

Private Function StringSpeichernLong(hKey As Long, sPath As String, sValue As String, iData As Long) As Boolean
On Error GoTo ErrHandler
Dim vRet As Variant
Dim lResult As Long
 RegCreateKey hKey, sPath, vRet
 lResult = RegSetValueEx(vRet, sValue, 0, REG_DWORD, iData, 4)
 RegCloseKey vRet
 StringSpeichernLong = True
ErrHandler:
End Function

Public Function WertLesen(hKey As Long, sPath As String, sValue As Variant, Default As Variant) As Boolean
On Error GoTo ErrHandler
Dim vRet As Variant
 RegOpenKey hKey, sPath, vRet
 sValue = fRegAbfrageWert(vRet, CStr(sValue))
 If IsEmpty(sValue) Then sValue = Default
 RegCloseKey vRet
 WertLesen = True
ErrHandler:
End Function

Private Function fRegAbfrageWert(ByVal hKey As Long, ByVal sValueName As String) As Variant
On Error GoTo ErrHandler
Dim sBuffer As String
Dim lRes As Long
Dim lTypeValue As Long
Dim lBufferSizeData As Long
Dim iData As Integer
Dim LongData As Long
 lRes = RegQueryValueEx(hKey, sValueName, 0, lTypeValue, ByVal 0, lBufferSizeData)
  If lRes = 0 Then
   If lTypeValue = REG_SZ Then
    sBuffer = String(lBufferSizeData, Chr$(0))
    lRes = RegQueryValueEx(hKey, sValueName, 0, 0, ByVal sBuffer, lBufferSizeData)
    If lRes = 0 Then fRegAbfrageWert = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
   ElseIf lTypeValue = REG_BINARY Then
    lRes = RegQueryValueEx(hKey, sValueName, 0, 0, iData, lBufferSizeData)
    If lRes = 0 Then fRegAbfrageWert = iData
   ElseIf lTypeValue = REG_DWORD Then
    lBufferSizeData = 4
    lRes = RegQueryValueEx(hKey, sValueName, 0&, REG_DWORD, LongData, lBufferSizeData)
    If lRes = 0 Then fRegAbfrageWert = LongData
   End If
  End If
 Exit Function
ErrHandler:
 fRegAbfrageWert = ""
End Function

Public Function WerteLoeschen(sPath As String, sValue As String) As Boolean
On Error GoTo ErrHandler
Dim vRet As Variant
 RegCreateKey HKEY_CURRENT_USER, sPath, vRet
 RegDeleteValue vRet, sValue
 RegCloseKey vRet
 WerteLoeschen = True
ErrHandler:
End Function

Public Function DeleteAutoRun(sValueName As String) As Boolean
On Error GoTo ErrHandler
Dim hKey As Long
 RegOpenKey HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\run", hKey
 RegDeleteValue hKey, sValueName
 RegCloseKey hKey
 DeleteAutoRun = True
ErrHandler:
End Function

Public Function DeleteAutoRunOnce(sValueName As String) As Boolean
On Error GoTo ErrHandler
Dim hKey As Long
 RegOpenKey HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\runonce", hKey
 RegDeleteValue hKey, sValueName
 RegCloseKey hKey
 DeleteAutoRunOnce = True
ErrHandler:
End Function

Public Function SetAutoRun(sValueName As String, sValue As String) As Boolean
On Error GoTo ErrHandler
Dim hKey As Long
 RegOpenKey HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\run", hKey
 RegSetValueEx hKey, sValueName, 0, REG_SZ, ByVal sValue, Len(sValue)
 RegCloseKey hKey
 SetAutoRun = True
ErrHandler:
End Function

Public Function SetAutoRunOnce(sValueName As String, sValue As String) As Boolean
On Error GoTo ErrHandler
Dim hKey As Long
 RegOpenKey HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\runonce", hKey
 RegSetValueEx hKey, sValueName, 0, REG_SZ, ByVal sValue, Len(sValue)
 RegCloseKey hKey
 SetAutoRunOnce = True
ErrHandler:
End Function

Public Function DeleteKey(Key As String) As Boolean
On Error GoTo ErrHandler
Dim lReturn As Long
lReturn = RegDeleteKey(HKEY_CURRENT_USER, Key)
DeleteKey = CBool(lReturn = 0)
ErrHandler:
End Function

MfG Alex