VB 5/6-Tipp 0209: In der Registry browsen

'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 -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kombinationsliste "Combo1"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

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

Const ERROR_SUCCESS = 0&
Const KEY_QUERY_VALUE = &H1

Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7

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 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 FILETIME) _
        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, lpReserved As Long, lpType _
        As Long, lpData As Byte, lpcbData As Long) As Long

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Dim RegPath$, RegRoot&

Private Sub Form_Load()
  With Combo1
    .AddItem "HKEY_CLASSES_ROOT"
    .ItemData(.NewIndex) = HKEY_CLASSES_ROOT
    .AddItem "HKEY_CURRENT_USER"
    .ItemData(.NewIndex) = HKEY_CURRENT_USER
    .AddItem "HKEY_LOCAL_MACHINE"
    .ItemData(.NewIndex) = HKEY_LOCAL_MACHINE
    .AddItem "HKEY_USERS"
    .ItemData(.NewIndex) = HKEY_USERS
    .AddItem "HKEY_PERFORMANCE_DATA"
    .ItemData(.NewIndex) = HKEY_PERFORMANCE_DATA
    .AddItem "HKEY_DYN_DATA"
    .ItemData(.NewIndex) = HKEY_DYN_DATA
    .ListIndex = 2
  End With
End Sub

Private Sub RegDir(Root&, Path$, LB As ListBox)
  Dim hKey&, Result&, Cnt&, fTime As FILETIME
  Dim Key$, KeyLen&, Value$, ValueLen&, RegTyp&
    
    LB.Clear
    LB.AddItem ".."
    Result = RegOpenKeyEx(Root, Path, 0, KEY_QUERY_VALUE, hKey)
    If Result = ERROR_SUCCESS Then
      Do
        KeyLen = 256
        Key = Space(KeyLen)
        
        Result = RegEnumKeyEx(hKey, Cnt, Key, KeyLen, 0&, _
                              vbNullChar, 0&, fTime)
        If Result = ERROR_SUCCESS Then
          LB.AddItem "." & UCase(Left$(Key, KeyLen))
          LB.ItemData(LB.NewIndex) = -1
        End If
        Cnt = Cnt + 1
      Loop Until Result <> ERROR_SUCCESS
          
      LB.AddItem "standard"
      Cnt = 0
      Do
        ValueLen = 256
        Value = String(ValueLen, 0)
        Result = RegEnumValue(hKey, Cnt, ByVal Value, ValueLen, _
                              0&, RegTyp, ByVal 0, 0)
        Cnt = Cnt + 1
        If Result = ERROR_SUCCESS Then
          LB.AddItem LCase(Left(Value, ValueLen))
          LB.ItemData(LB.NewIndex) = RegTyp
        End If
      Loop While Result = ERROR_SUCCESS
      Call RegCloseKey(hKey)
    Else
      MsgBox ("Schlüssel nicht gefunden")
    End If
End Sub

Private Sub Combo1_Click()
  RegPath = "\"
  RegRoot = Combo1.ItemData(Combo1.ListIndex)
  Call RegDir(RegRoot, RegPath, List1)
  Label1.Caption = RegPath
End Sub



Private Sub List1_Click()
Dim x%, ID&, aa$
  x = List1.ListIndex
  If x > -1 Then
    ID = List1.ItemData(x)
    Select Case ID
      Case -1: aa = "Knotenpunkt"
      Case REG_NONE:             aa = "REG_NONE"
      Case REG_SZ:               aa = "REG_SZ"
      Case REG_EXPAND_SZ:        aa = "REG_EXPAND_SZ"
      Case REG_BINARY:           aa = "REG_BINARY"
      Case REG_DWORD:            aa = "REG_DWORD"
      Case REG_DWORD_BIG_ENDIAN: aa = "REG_DWORD_BIG_ENDIAN"
      Case REG_LINK:             aa = "REG_LINK"
      Case REG_MULTI_SZ:         aa = "REG_MULTI_SZ"
    End Select
    Label3.Caption = aa
  End If
End Sub

Private Sub List1_DblClick()
  Dim x&, aa$
    x = List1.ListIndex
    If x > -1 Then
      aa = List1.List(x)
      If Left$(aa, 1) = "." Then
        If aa = ".." Then
          For x = Len(RegPath) - 1 To 1 Step -1
            If Mid$(RegPath, x, 1) = "\" Then Exit For
          Next x
          
          RegPath = Left$(RegPath, x)
          If RegPath = "" Then RegPath = "\"
          Call RegDir(RegRoot, RegPath, List1)
        Else
          If Len(RegPath) = 1 Then RegPath = ""
          RegPath = RegPath & Mid$(aa, 2) & "\"
          Call RegDir(RegRoot, RegPath, List1)
        End If
      End If
    End If
    Label1.Caption = RegPath
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von Ulf Langenbach am 21.09.2011 um 11:53

Wir haben eine alte VB6-Anwendung, die um eine Registry-Abfrage erweitert werden muss.

Obiger Tipp funktioniert wunderbar unter Windows XP / VB6, allerdings mit folgenden Änderungen:

1. Wie von Jens Jacobi am 12.11.2001 um 11:33 bemerkt, muss
im Aufruf von RegEnumKeyEx derWert vbNullChar durch VBNullString erstzt werden.

2. Im Aufruf von RegOpenKeyEx muss KEY_QUERY_VALUE durch KEY_READ ersetzt werden.
(Wobei hier möglicherweise auch KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS reichen könnte.)

Gruß Ulf

Kommentar von am 31.08.2003 um 13:50

Bei mit (VB6 Einsteiger, WinXP) kommt bei allen Schlüsseln außer "HKEY_CLASSES_ROOT" die Meldung "Schlüssel nicht gefunden". Warum ist das so und warum wird bei "HKEY_CLASSES_ROOT" auch nur ".." und "Standard" angezeigt?

Kommentar von KingIR am 09.11.2002 um 10:31

Hier ist ein Code für NT, 2k, und XP:
(aus dem API-Guide 3.7)!
Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) 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 Any) 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, lpData As Any, lpcbData As Long) As Long
Private Sub Form_Load()
'KPD-Team 2001
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim hKey As Long, Cnt As Long, sName As String, sData As String, Ret As Long, RetData As Long
Const BUFFER_SIZE As Long = 255
'Set the forms graphics mode to persistent
Me.AutoRedraw = True
Me.Print "RegEnumKeyEx"
Ret = BUFFER_SIZE
'Open the registry key
If RegOpenKey(HKEY_LOCAL_MACHINE, "Hardware", hKey) = 0 Then
'Create a buffer
sName = Space(BUFFER_SIZE)
'Enumerate the keys
While RegEnumKeyEx(hKey, Cnt, sName, Ret, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> ERROR_NO_MORE_ITEMS
'Show the enumerated key
Me.Print " " + Left$(sName, Ret)
'prepare for the next key
Cnt = Cnt + 1
sName = Space(BUFFER_SIZE)
Ret = BUFFER_SIZE
Wend
'close the registry key
RegCloseKey hKey
Else
Me.Print " Error while calling RegOpenKey"
End If
Me.Print vbCrLf + "RegEnumValue"
Cnt = 0
'Open a registry key
If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", hKey) = 0 Then
'initialize
sName = Space(BUFFER_SIZE)
sData = Space(BUFFER_SIZE)
Ret = BUFFER_SIZE
RetData = BUFFER_SIZE
'enumerate the values
While RegEnumValue(hKey, Cnt, sName, Ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
'show data
If RetData > 0 Then Me.Print " " + Left$(sName, Ret) + "=" + Left$(sData, RetData - 1)
'prepare for next value
Cnt = Cnt + 1
sName = Space(BUFFER_SIZE)
sData = Space(BUFFER_SIZE)
Ret = BUFFER_SIZE
RetData = BUFFER_SIZE
Wend
'Close the registry key
RegCloseKey hKey
Else
Me.Print " Error while calling RegOpenKey"
End If
End Sub

Kommentar von HenryF am 23.10.2002 um 13:13

Hab alles ausprobiert, was hier so beschrieben wurde und noch einiges mehr, aber es läuft einfach nicht!

Hat jemand schon das Beispiel vielleicht so überarbeitet, daß es auch unter XP und VB6.0 funzt?

HF

Kommentar von Hendrik Jordt am 05.08.2002 um 09:42

Trotz aller Änderungen an dem Tipp kriege ich ihn bei mir nicht zum laufen (NT4.0 & VB6.0). Habe ByVal und auch ALL_ACCESS drin...
Wat nu?

Kommentar von Ronny am 15.06.2002 um 17:17

Hallo Andreas,
Der Rückgabewert 234 hat die Bezeichnung ERROR_MORE_DATA, Du liegst also völlig richtig.

Kommentar von Axel am 16.04.2002 um 22:36

Auf Win98 lief es unter VB6 einwandfrei - compiliert: Fehlanzeige!
Mein Tip: Schmeisst das "LB As ListBox" raus - dann klappts auch mit der EXE.

Kommentar von Jens Jacobi am 12.11.2001 um 11:33

Unter NT4 mußte bei mir im Aufruf von RegEnumKeyEx derWert
vbNullChar durch VBNullString erstzt werden, dann gings.
Gruß Jens

Kommentar von Andreas Reiter am 24.10.2001 um 14:34

OK, ich hab's. Das Problem ist, dass bei W2K die Puffer-Variablen für die Namen der Variablen und der Schlüssel jeweils mit ByVal im Funktionsaufruf stehen müssen. Daraufhin erhalte ich eine Funktionsrückgabe "234", die ich aber nicht in den Fehler-Konstanten der API finden kann. Jedenfalls muss deshalb das Abbruchkriterium für die Do-Schleife nicht Result = ERROR_SUCCESS, sondern Result = ERROR_NO_MORE_ITEMS (= &H3F) heißen.

Kommentar von Andreas Reiter am 24.10.2001 um 13:56

Ich habe ein Problem bei W2k gefunden. Wenn der SubKey-Pfad nur einen "\" enthält, lassen sich die Schlüssel nicht öffnen. Elemeniert man das Problem, erscheinen aber trotzdem keine Schlüssel, aber zumindest mal die Werte!

Kommentar von Frank-Ivo Schulz am 09.10.2001 um 17:06

Bei mir hat das ganze auch nicht funktioniert und es liegt an einer falschen Deklaration von RegEnumValue()! Der 5. Parameter muß als ByVal deklariert werden. Siehe auch MSDN-Library July 2000!

Kommentar von John Lanners am 05.04.2001 um 09:54

Unter NT4 hatte ich auch die bekannten Probleme und öffne nun den Schlüssel mit allen Rechten (KEY_ALL_ACCESS = &H3F) und siehe da ich sehe die Unterschlüssel.
John Lanners

Kommentar von Björn Möller am 08.03.2001 um 15:44

Also ich arbeite noch mit NT 4.0 und er findet auch keinen Schlüssel.
Ich hoffe jemand findet das problem

Kommentar von Sebastian Eichholz am 04.03.2001 um 18:18

Unter WindowsNT 4 kommt auch die Fehlermeldung "Schlüssel nicht gefunden"
:-(
Hat schon jemand einen "Fix" für dieses Problem entwickelt?

Kommentar von Florian Rittmeier am 03.02.2001 um 13:44

Schaut doch mal bei 2K mit REGEDIT welche Hauptgruppen es in der Registry gibt.
Da wurden nämlich eins zwei für den User als unzugänglich markiert, um die Sicherheit zu erhöhen.
Außerdem wird Sie so anders geladen ..

Kommentar von Dirk Marx am 01.02.2001 um 14:04

Habe auch Win2000 und es funktioniert nicht. Fehler "Schlüssel nicht gefunden"

Kommentar von Thomas Brecht am 26.11.2000 um 16:09

Dieses Tool funktioniert unter Win 2000 nicht

Kommentar von Mehmet Ayas am 13.11.2000 um 08:22

Guten morgen, bei mir kommet die meldung [Schlüssel nicht gefunden]?
Was mach ich falsch??
Gruss Mehmet.