Startseite / Tipps / VB 5/6-Tipp 0107: Registry lesen und schreiben, Schlüssel anlegen und löschen

VB 5/6-Tipp 0107: Registry lesen und schreiben, Schlüssel anlegen und löschen

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Es muss ein Verweis auf 'Standard OLE Types' gesetzt werden.
' Es muss ein Verweis auf 'Microsoft DAO 3.0 Object Library' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command8"
' Steuerelement: Rahmensteuerelement "Frame6"
' Steuerelement: Textfeld "Text1" auf Frame6
' Steuerelement: Textfeld "Text17" auf Frame6
' Steuerelement: Textfeld "Text16" auf Frame6
' Steuerelement: Textfeld "Text15" auf Frame6
' Steuerelement: Textfeld "Text14" auf Frame6
' Steuerelement: Textfeld "Text13" auf Frame6
' Steuerelement: Textfeld "Text9" auf Frame6
' Steuerelement: Textfeld "Text10" auf Frame6
' Steuerelement: Textfeld "Text11" auf Frame6
' Steuerelement: Textfeld "Text12" auf Frame6
' Steuerelement: Schaltfläche "Command5" auf Frame6
' Steuerelement: Schaltfläche "Command4" auf Frame6
' Steuerelement: Textfeld "Text8" auf Frame6
' Steuerelement: Textfeld "Text7" auf Frame6
' Steuerelement: Textfeld "Text6" auf Frame6
' Steuerelement: Textfeld "Text5" auf Frame6
' Steuerelement: Textfeld "Text4" auf Frame6
' Steuerelement: Textfeld "Text3" auf Frame6
' Steuerelement: Textfeld "Text2" auf Frame6
' Steuerelement: Schaltfläche "Command3" auf Frame6
' Steuerelement: Schaltfläche "Command6" auf Frame6
' Steuerelement: Schaltfläche "Command7" auf Frame6
' Steuerelement: Schaltfläche "Command2" auf Frame6
' Steuerelement: Schaltfläche "Command1" auf Frame6
' Steuerelement: Beschriftungsfeld "Label5" auf Frame6
' Steuerelement: Beschriftungsfeld "Label4" auf Frame6
' Steuerelement: Beschriftungsfeld "Label3" auf Frame6
' Steuerelement: Beschriftungsfeld "Label2" auf Frame6
' Steuerelement: Beschriftungsfeld "Label1" auf Frame6
' Steuerelement: Beschriftungsfeld "Label15" auf Frame6
' Steuerelement: Beschriftungsfeld "Label14" auf Frame6
' Steuerelement: Beschriftungsfeld "Label13" auf Frame6
' Steuerelement: Beschriftungsfeld "Label11" auf Frame6
' Steuerelement: Beschriftungsfeld "Label9" auf Frame6
' Steuerelement: Beschriftungsfeld "Label12" auf Frame6
' Steuerelement: Beschriftungsfeld "Label10" auf Frame6
' Steuerelement: Beschriftungsfeld "Label8" auf Frame6
' Steuerelement: Beschriftungsfeld "Label7" auf Frame6
' Steuerelement: Beschriftungsfeld "Label6" auf Frame6

Option Explicit

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 RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey 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 Any) 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, ByVal lpSecurityAttributes As Any, _
        phkResult As Long, lpdwDisposition As Long) As Long
        
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal _
        hKey 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 Long, ByVal cbData As Long) _
        As Long
        
Private Declare Function RegSetValueEx_Str 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 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

'Nur für Windows 2k/XP
Private Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" _
        (ByVal hKey As Long, ByVal pszSubKey As String) As Long

Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003
Private Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Private Const HKEY_CURRENT_CONFIG As Long = &H80000005
Private Const HKEY_DYN_DATA As Long = &H80000006

Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const KEY_CREATE_LINK As Long = &H20

Private Const KEY_READ As Long = KEY_QUERY_VALUE Or _
                 KEY_ENUMERATE_SUB_KEYS _
                 Or KEY_NOTIFY
                 
Private Const KEY_ALL_ACCESS As Long = KEY_QUERY_VALUE Or _
                       KEY_SET_VALUE Or _
                       KEY_CREATE_SUB_KEY Or _
                       KEY_ENUMERATE_SUB_KEYS Or _
                       KEY_NOTIFY Or _
                       KEY_CREATE_LINK
                       
Private Const ERROR_SUCCESS As Long = 0&

Private Const REG_NONE As Long = 0&
Private Const REG_SZ As Long = 1&
Private Const REG_EXPAND_SZ As Long = 2&
Private Const REG_BINARY As Long = 3&
Private Const REG_DWORD As Long = 4&
Private Const REG_DWORD_LITTLE_ENDIAN As Long = 4&
Private Const REG_DWORD_BIG_ENDIAN As Long = 5&
Private Const REG_LINK As Long = 6&
Private Const REG_MULTI_SZ As Long = 7&

Private Const REG_OPTION_NON_VOLATILE As Long = &H0&

Private RegRoot As Long

Private Sub Command8_Click()
  Call Shell("regedit.exe", vbNormalFocus)
End Sub

Private Sub Form_Load()
  'Voreinstellungen eintragen
  Text1.Text = "Test-Ordner"
  Text2.Text = "Test-Ordner"
  
  Text3.Text = "Test-Ordner"
  Text4.Text = "Wert-Long"
  Text5.Text = "12345"
  
  Text6.Text = "Test-Ordner"
  Text7.Text = "Wert-String"
  Text8.Text = "Hallo"
  
  Text9.Text = "Test-Ordner"
  Text10.Text = "Wert-Long"
  Text11.Text = "Test-Ordner"
  Text12.Text = "Wert-String"
  
  Text13.Text = "Test-Ordner"
  Text14.Text = "Wert-Long"
  Text15.Text = "Test-Ordner"
  Text16.Text = "Wert-String"
  
  Text17.Text = "Test-Ordner"
  
  List1.AddItem "HKEY_CLASSES_ROOT"
  List1.ItemData(0) = HKEY_CLASSES_ROOT
  List1.AddItem "HKEY_CURRENT_USER"
  List1.ItemData(1) = HKEY_CURRENT_USER
  List1.AddItem "HKEY_LOCAL_MACHINE"
  List1.ItemData(2) = HKEY_LOCAL_MACHINE
  List1.AddItem "HKEY_USERS"
  List1.ItemData(3) = HKEY_USERS
  List1.AddItem "HKEY_PERFORMANCE_DATA"
  List1.ItemData(4) = HKEY_PERFORMANCE_DATA
  List1.AddItem "HKEY_CURRENT_CONFIG"
  List1.ItemData(5) = HKEY_CURRENT_CONFIG
  List1.AddItem "HKEY_DYN_DATA"
  List1.ItemData(6) = HKEY_DYN_DATA

  List1.ListIndex = 1
End Sub

Private Sub List1_Click()
  'Bei Klick Hauptverzeichnis wechseln
  Frame6.Caption = List1.List(List1.ListIndex)
  RegRoot = List1.ItemData(List1.ListIndex)
End Sub

Private Sub Command1_Click()
  Dim Result&
    'Schlüssel erstellen
    Result = RegKeyCreate(RegRoot, Text1.Text)
                    
    Select Case Result
      Case 0: Label5.Caption = "Fehler beim Erstellen"
      Case 1: Label5.Caption = "Ok, Pfad neu erstellt"
      Case 2: Label5.Caption = "Ok, Pfad existierte schon"
    End Select
End Sub

Private Sub Command2_Click()
  Dim Result&
    'Testen ob Schlüssel existiert
    Result = RegKeyExist(RegRoot, Text2.Text)
    
    If Result = 0 Then
       Label6.Caption = "vorhanden"
     Else
       Label6.Caption = "nicht vorhanden"
    End If
End Sub

Private Sub Command3_Click()
  Dim Result&, LngInt&
    'Longwert ein ein Feld schreiben
    LngInt = CLng(Val(Text5.Text))
    Result = RegValueSet(RegRoot, Text3.Text, Text4.Text, LngInt)
    
    If Result = 0 Then
      Label7.Caption = "Ok"
    Else
      Label7.Caption = "Fehler"
    End If
End Sub

Private Sub Command4_Click()
  Dim Result&, StrVar$
    'Stringwert in ein Feld schreiben
    StrVar = CStr(Text8.Text)
    Result = RegValueSet(RegRoot, Text6.Text, Text7.Text, StrVar)
    
    If Result = 0 Then
      Label8.Caption = "Ok"
    Else
      Label8.Caption = "Fehler"
    End If
End Sub

Private Sub Command5_Click()
  Dim Result&, Value As Variant
    'Longwert auslesen
    Result = RegValueGet(RegRoot, Text9.Text, Text10.Text, Value)
    If Result = 0 Then
      Label9.Caption = CStr(Value)
      Label10.Caption = "Ok"
    Else
      Label9.Caption = ""
      Label10.Caption = "Fehler"
    End If
   
    'Stringwert auslesen
    Result = RegValueGet(RegRoot, Text11.Text, Text12.Text, Value)
    If Result = 0 Then
      Label11.Caption = CStr(Value)
      Label12.Caption = "Ok"
    Else
      Label11.Caption = ""
      Label12.Caption = "Fehler"
    End If
End Sub

Private Sub Command6_Click()
  Dim Result&
    'Feld des Longwertes löschen
    Result = RegFieldDelete(RegRoot, Text13.Text, Text14.Text)
    If Result = 0 Then
      Label13.Caption = "Ok"
    Else
      Label13.Caption = "Fehler"
    End If
    
    'Feld des Srtingwertes löschen
    Result = RegFieldDelete(RegRoot, Text15.Text, Text16.Text)
    If Result = 0 Then
      Label14.Caption = "Ok"
    Else
      Label14.Caption = "Fehler"
    End If
End Sub

Private Sub Command7_Click()
  Dim Result&
    'Schlüssel löschen
    Result = RegKeyDelete(RegRoot, Text17.Text)
    
    'Alternative für Windows 2k/XP User
    'Dim Key As Long
    'RegOpenKeyEx RegRoot, Text17.Text + Chr$(0), 0, KEY_ALL_ACCESS, Key
    'Result& = SHDeleteKey(Key, Text17.Text + Chr$(0))
    'RegCloseKey (Key)
    
    If Result = 0 Then
      Label15.Caption = "Ok"
    Else
      Label15.Caption = "Fehler"
    End If
End Sub

Function RegKeyExist(Root&, Key$) As Long
  Dim Result&, hKey&
    'Prüfen ob ein Schlüssel existiert
    Result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)
    If Result = ERROR_SUCCESS Then Call RegCloseKey(hKey)
    RegKeyExist = Result
End Function

Function RegKeyCreate(Root&, Newkey$) As Long
  Dim Result&, hKey&, Back&
    'Neuen Schlüssel erstellen
    Result = RegCreateKeyEx(Root, Newkey, 0, vbNullString, _
                            REG_OPTION_NON_VOLATILE, _
                            KEY_ALL_ACCESS, 0&, hKey, Back)
    If Result = ERROR_SUCCESS Then
      Result = RegFlushKey(hKey)
      If Result = ERROR_SUCCESS Then Call RegCloseKey(hKey)
        RegKeyCreate = Back
    End If
End Function

Private Function RegKeyDelete(Root&, Key$) As Long
  'Schlüssel erstellen
  RegKeyDelete = RegDeleteKey(Root, Key)
End Function

Private Function RegFieldDelete(Root&, Key$, Field$) As Long
  Dim Result&, hKey&
    'Feld löschen
    Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)
    If Result = ERROR_SUCCESS Then
      Result = RegDeleteValue(hKey, Field)
      Result = RegCloseKey(hKey)
    End If
    RegFieldDelete = Result
End Function

Function RegValueSet(Root&, Key$, Field$, Value As Variant) As Long
  Dim Result&, hKey&, s$, l&
    'Wert in ein Feld der Registry schreiben
    Result = RegOpenKeyEx(Root, Key, 0, KEY_ALL_ACCESS, hKey)
    If Result = ERROR_SUCCESS Then
      Select Case VarType(Value)
        Case vbInteger, vbLong
          l = CLng(Value)
          Result = RegSetValueEx(hKey, Field, 0, REG_DWORD, l, 4)
        Case vbString
          s = CStr(Value)
          Result = RegSetValueEx_Str(hKey, Field, 0, REG_SZ, s, _
                                        Len(s) + 1)
      End Select
      Result = RegCloseKey(hKey)
    End If
    
    RegValueSet = Result
End Function

Function RegValueGet(Root&, Key$, Field$, Value As Variant) As Long
  Dim Result&, hKey&, dwType&, Lng&, Buffer$, l&
    'Wert aus einem Feld der Registry auslesen
    Result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)
    If Result = ERROR_SUCCESS Then
      Result = RegQueryValueEx(hKey, Field, 0&, dwType, ByVal 0&, l)
      If Result = ERROR_SUCCESS Then
        Select Case dwType
          Case REG_SZ
            Buffer = Space$(l + 1)
            Result = RegQueryValueEx(hKey, Field, 0&, _
                                     dwType, ByVal Buffer, l)
            If Result = ERROR_SUCCESS Then Value = Buffer
          Case REG_DWORD
            Result = RegQueryValueEx(hKey, Field, 0&, dwType, Lng, l)
            If Result = ERROR_SUCCESS Then Value = Lng
        End Select
      End If
    End If
    
    If Result = ERROR_SUCCESS Then Result = RegCloseKey(hKey)
    RegValueGet = Result
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 40 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.