Hilfe beim Auslesen der Registry

[olek]

Servus an Alle!

Habe unten angegebenen Code zum Auslesen der Software aus der Registry verwendet.
Dabei habe ich nun das Problem das lediglich der Foldername unter "Software\Microsoft\Windows\CurrentVersion\Uninstall" der jeweiligen Software ausgelesen und angezeigt wird. Ich möchte aber nicht nach dem Foldernamen suchen und diesen angezeigt bekommen, sondern ich möchte den Namen ausgegeben bekommen der in solch einem Folder unter DisplayName angegeben ist!
Wenn ich nur die Foldernamen ausgebe so kommt zeitweise wirres Zeug wie {FC880800..} raus, wenn ich aber IN DIESEM Folder nach dem DisplayName suche kommt mir der tatsächliche Softwarename heraus.

Ich hoff die Registry-Profis wissen was ich damit meine?
(wenn man auf einen Folder in der Registry geht dann hat man rechts unter DisplayName den wahren Softwarenamen stehen)


Hat wer ne Ahnung wie ich dieses Problem lösen könnte?
(habe ja unten Folder = ...... definiert und dann anschließend If DisplayName = "" Then DisplayName = Folder angegeben; d.h. man müsste Folder anders definieren )

Danke für jede Hilfe im Voraus!

gruß alex (ein schlafloser VB-Anfänger :-( )

' Durchsuchen der Registry wird benötigt! ( Module1)
Private Sub Form_Load()
Dim SO As SearchOptions
Dim Gefunden() As String
Dim I As Integer
Dim Daten() As String
Dim DisplayName As String
Dim RegKey As String
Dim Folder As String
Dim itemX As ListItem

' Registry in der die deinstallierbare Software aufzufinden ist
RegKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"

With ListView1
.ListItems.Clear

' Alle Einträge im Schlüssel
' Software\Microsoft\Windows\CurrentVersion\Uninstall ermitteln
With SO
.HowToSearch = StringExists
.SearchMainKey = HKEY_LOCAL_MACHINE
.SearchString = "UninstallString"
.StartSearchPath = RegKey
.SearchSubfolders = True
.FindKeys = True
.FindValueNames = True
.FindValues = True
End With

' Suche starten
FindString SO, Gefunden
On Error Resume Next
For I = 0 To UBound(Gefunden)
Daten = Split(Gefunden(I), vbCrLf)

' SubKey
Folder = Mid$(Daten(0), InStrRev(Daten(0), "\") + 1)

' DisplayName ermitteln
DisplayName = Get_ValueString(HKEY_LOCAL_MACHINE, _
RegKey & "\" & Daten(1), "DisplayName")
If DisplayName = "" Then DisplayName = Folder

' ListView1 Daten in ein .txt schreiben
Dim Filenum As Integer
Dim j As Integer

For j = 0 To ListView1.ListItems.Count - 1
If Left(ListView1.ListItems(j).Text, 2) = "KB" Then
ListView1.ListItems.Remove (j)
End If
Next j

Filenum = FreeFile
Open "C:\software.txt" For Output As #Filenum
For j = 0 To ListView1.ListItems.Count - 1
Print #Filenum, ListView1.ListItems(j).Text
Next j
Close #Filenum


Set itemX = .ListItems.Add(, Daten(0), DisplayName)
' für 2. unnötige Spalte die mehr Informationen ausgeben würde
itemX.SubItems(1) = Daten(2)
Next I
End With
End Sub

 

[olek]

Achja habe diesen Code noch in einem Module drinn gehabt. Dadurch lässt sich vielleicht besser das FindString erklären und das ganze Bsp. wird einfach zu verstehen.

' zunächst die benötigten API-Deklarationen
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) 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 Byte, lpcbData As Long) As Long
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 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
Private Declare Function RegEnumKey Lib "advapi32.dll" _
Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex _
As Long, ByVal lpName As String, ByVal cbName As Long) _
As Long

' Such-Methode
Public Enum CompareMode
Exact = 0
StringExists = 1
End Enum

' Suchoptionen
Public Type SearchOptions
SearchString As String
StartSearchPath As String
SearchMainKey As MainKey
HowToSearch As CompareMode
SearchSubfolders As Boolean
FindKeys As Boolean
FindValueNames As Boolean
FindValues As Boolean
End Type

' Zeitdaten
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

' KeyHandles der Hauptschlüssel
Public Enum MainKey
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
'Nur Windows 95, 98
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
'Nur Windows NT, 2000
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum

Private Enum KeyAccess
KEY_ALL_ACCESS = &HF003F
KEY_CREATE_LINK = &H20
KEY_CREATE_SUB_KEY = &H4
KEY_ENUMERATE_SUB_KEYS = &H8
KEY_EXECUTE = &H20019
KEY_NOTIFY = &H10
KEY_QUERY_VALUE = &H1
KEY_READ = &H20019
KEY_SET_VALUE = &H2
KEY_WRITE = &H20006
End Enum

Private Enum ValueOpenMode
REG_BINARY = 3
REG_DWORD = 4
REG_DWORD_BIG_ENDIAN = 5
REG_DWORD_LITTLE_ENDIAN = 4
REG_EXPAND_SZ = 2
REG_LINK = 6
REG_MULTI_SZ = 7
REG_NONE = 0
REG_RESOURCE_LIST = 8
REG_SZ = 1
End Enum

Private RetVal As Long

' Wenn True dann wird die Suche gestoppt
Public StopSearch As Boolean


' Registry nach einem bestimmten String durchsuchen
' Options legt die Suchoptionen fest
Public Function FindString(ByRef Options As SearchOptions, _
ByRef RetVar() As String)

Dim TmpRetVar() As String
Dim HKeyStart(6) As String
Dim I As Integer
Dim TmpStartPath As String
Dim CheckString As String
Dim CheckString2 As String
Dim CheckString3 As String

With Options
TmpRetVar = Get_KeyValues(.SearchMainKey, _
.StartSearchPath)

For I = 0 To UBound(TmpRetVar)
If StopSearch Then Exit Function
DoEvents
CheckString = Get_ValueString(.SearchMainKey, _
.StartSearchPath, TmpRetVar(I))
CheckString2 = TmpRetVar(I)
CheckString3 = .StartSearchPath
If InStr(1, CheckString3, "\") = 0 Then _
CheckString3 = "\" & CheckString3

' EXAKTE ÜBEREINSTIMMUNG
If .HowToSearch = Exact Then

' VALUE
If .SearchString = CheckString And _
.FindValues Then
GoSub Ret_Add

' VALUENAME
ElseIf .SearchString = CheckString2 And _
.FindValueNames Then
GoSub Ret_Add

' KEYNAME
ElseIf .SearchString = CheckString3 Or _
Mid$(CheckString3, InStrRev(CheckString3, _
"\") + 1) = .SearchString And .FindKeys Then
GoSub Ret_Add
End If

' TEILSTRING
ElseIf .HowToSearch = StringExists Then
'VALUE
If InStr(1, StrConv(CheckString, vbUpperCase), _
StrConv(.SearchString, vbUpperCase)) > 0 And _
.FindValues Then
GoSub Ret_Add

' VALUENAME
ElseIf InStr(1, StrConv(CheckString2, vbUpperCase), _
StrConv(.SearchString, vbUpperCase)) > 0 And _
.FindValueNames Then
GoSub Ret_Add

' KEYNAME
ElseIf InStr(1, StrConv(CheckString3, vbUpperCase), _
StrConv(.SearchString, vbUpperCase)) > 0 And _
.FindKeys Then
GoSub Ret_Add
End If
End If
Next I
On Error Resume Next

' ggf. auch Unterordner durchsuchen
If .SearchSubfolders = True Then
TmpRetVar = Get_SubFolders(.SearchMainKey, _
.StartSearchPath)
If TmpRetVar(0) = "" Then Exit Function

' für jeden Unterordner
For I = 0 To UBound(TmpRetVar)
If StopSearch Then Exit Function
DoEvents
TmpStartPath = .StartSearchPath
If .StartSearchPath = "" Then
.StartSearchPath = TmpRetVar(I)
Else
.StartSearchPath = .StartSearchPath & "\" & _
TmpRetVar(I)
End If

' Funktion ruft sich selbst auf
FindString Options, RetVar
.StartSearchPath = TmpStartPath
Next I
End If
End With
Exit Function

Ret_Add:
On Error GoTo Err_ReDim1
ReDim Preserve RetVar(0 To UBound(RetVar) + 1)
On Error GoTo 0
RetVar(UBound(RetVar)) = CheckString3 & vbCrLf & _
CheckString2 & vbCrLf & CheckString
Return

Err_ReDim1:
ReDim RetVar(0)
Resume Next
End Function

' ValueNames Suchen
Public Function Get_KeyValues(ByVal hKey As MainKey, _
ByVal StartFolder As String) As Variant

Dim ValueStr As String
Dim RetHandle As Long
Dim ValueIndex As Long
Dim RetVar() As String
Dim DummiType As Long
Dim DummiData(0 To 254) As Byte

ReDim RetVar(0)
RetVal = RegOpenKeyEx(hKey, StartFolder, 0&, _
KeyAccess.KEY_QUERY_VALUE, RetHandle)

' Wenn der Key nicht geöffnet werden kann
' Funktion verlassen
If RetVal <> 0 Then
Get_KeyValues = RetVar
Exit Function
End If

Do
ValueStr = Space(255)
' Key enumerieren, den x-ten (ValueIndex)
' SubKey auslesen
RetVal = RegEnumValue(RetHandle, ValueIndex, ValueStr, _
Len(ValueStr), 0&, DummiType, DummiData(0), 256)
If RetVal <> 0 Then Exit Do

ReDim Preserve RetVar(0 To ValueIndex)

' Index für die nächste Suche erhöhen
ValueIndex = ValueIndex + 1
RetVar(UBound(RetVar)) = Left$(ValueStr, _
InStr(1, ValueStr, vbNullChar) - 1)
Loop
RegCloseKey RetHandle
Get_KeyValues = RetVar
End Function

' Sucht nach KeyNames
Public Function Get_SubFolders(ByVal hKey As MainKey, _
ByVal StartFolder As String) As Variant

Dim SubStr As String
Dim RetHandle As Long
Dim KeyIndex As Long
Dim RetVar() As String

ReDim RetVar(0)
RetVal = RegOpenKeyEx(hKey, StartFolder, 0&, _
KeyAccess.KEY_ENUMERATE_SUB_KEYS, RetHandle)

' Wenn der Key nicht geöffnet werden kann
' Funktion verlassen
If RetVal <> 0 Then
Get_SubFolders = RetVar
Exit Function
End If

Do
SubStr = Space(255)
' KeyNames enumerieren, den x-ten (KeyIndex)
' KeyName auslesen
RetVal = RegEnumKey(RetHandle, KeyIndex, SubStr, _
Len(SubStr))
If RetVal <> 0 Then Exit Do

ReDim Preserve RetVar(0 To KeyIndex)

' Index für die nächste Suche erhöhen
KeyIndex = KeyIndex + 1
RetVar(UBound(RetVar)) = Left$(SubStr, _
InStr(1, SubStr, vbNullChar) - 1)
Loop
RegCloseKey RetHandle

Get_SubFolders = RetVar
End Function

' Value wert von ValueName bekommen
Public Function Get_ValueString(ByVal hKey As MainKey, _
ByVal StartFolder As String, ByVal ValueName As String) _
As String

Dim RetStr As String
Dim RetHandle As Long
Dim RetType As Long
Dim TmpVar() As Variant

' Key öffnen (für KeyHandle)
RetVal = RegOpenKeyEx(hKey, StartFolder, 0&, _
KeyAccess.KEY_QUERY_VALUE, RetHandle)

' Wenn der Key nicht geöffnet werden kann
' Funktion verlassen
If RetVal <> 0 Then Exit Function

' Wert auslesen
RetStr = Space(256)
RetVal = RegQueryValueEx(RetHandle, ValueName, 0&, _
RetType, ByVal RetStr, Len(RetStr))
If RetVal <> 0 Then Exit Function

' Nur übergeben wenn gefundene Value ein String ist
If RetType = REG_SZ Then
Get_ValueString = Left$(RetStr, _
InStr(1, RetStr, vbNullChar) - 1)
End If
RegCloseKey RetHandle
End Function

 

[Merlin_78]

Hi olek,

Du mußt dein Folder auf das erste Zeichen überprüfen und in Abhängigkeit davon den RegKey bilden, aus dem die Daten gelesen werden sollen.
Fettschrift=neuer Code im Formular

...
...
' SubKey
Folder = Mid$(Daten(0), InStrRev(Daten(0), "\") + 1)
' prüfen, ob das erste Zeichen ein "{" ist
If Left(Folder, 1) = "{" Then
' Registrystruktur um Folder erweitern und DisplayName ermitteln
DisplayName = Get_ValueString(HKEY_LOCAL_MACHINE, _
RegKey & Folder, "DisplayName")
Else
' DisplayName ermitteln
DisplayName = Get_ValueString(HKEY_LOCAL_MACHINE, _
RegKey & "\" & Daten(1), "DisplayName")
End If
If DisplayName = "" Then DisplayName = Folder
...
...

 

[olek]

Hi Merlin!
DANKE UND NOCHMALS DANKE für diese Spitze Hilfe!
Echt klasse von dir! Es hat einwandfrei funktioniert bist ein Genie *hehe*

ABER: du hast es ja derzeit so gemacht das wenn er ein { findet das er dann in diesen Folder reinschaut und dann den RegKey such und anzeigt. Also er macht das nur bei Foldern die { beinhalten.
Toll wäre es aber wenn er eben unter Software\Microsoft\Windows\CurrentVersion\Uninstall
in ALLE Folder reingeht, diese durchsucht und dort jeweils den DisplayNamen ausgibt.
Derzeigt gibt er ja nur die Namen der Folder aus und nicht die Namen der DisplayNames die in diesen Foldern vorkommen. (Außer eben die Folder mit { )

Kanns du dies auch noch realiseren?
Also nicht die Foldernamen ausgeben unter \Uninstall sondern die Bezeichnungen die unter DisplayName IN DIESEN Foldern vorkommen.

grüßle olek
BEDANKE MICH NOCHMALS FÜR DEINE TOLLE HILFE!

 

[olek]

DANKE DIE LETZTE FRAGE VON MIT HAT SICH ERLEDIGT.
Bin jetzt selber draufgekommen wie das ganze genau abläuft *freu*
Als VB-Anfänger garnicht so leicht aber DANK EURER Hilfe lernt man recht schnell!
DANKE!

gruß olek