Alle installierten Komponenten auflisten Durch Auslesen der Registry lassen sich alle im System registrierten Komponenten (DLLs und OCXen) ermitteln.
Autor:   Thorsten Thiel	Bewertung:	Views:  32.162
www.eclere.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Wer sich gerne mal wie in VB unter Ansicht/Komponenten eine Listbox mit allen im System registrierten ActiveX Komponenten anzeigen lassen möchte, kann dies mit folgendem Tipp errreichen.

Zuerst brauchen wir ein Modul mit den benötigten API-Deklarationen (die Komponenten müssen aus der Registry ausgelesen werden):

Option Explicit
 
' Registry-Schüssel
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
 
' Rückgabewerte
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const ERROR_SUCCESS = 0&
 
' API-Deklarationen
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 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 RegDeleteKey Lib "advapi32.dll" _
  Alias "RegDeleteKeyA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String) As Long
 
Public Declare Function RegDeleteValue Lib "advapi32.dll" _
  Alias "RegDeleteValueA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String) As Long
 
Public 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
 
Public 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
 
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

' Alle untergeordneten Registry-Schlüssel eines anderen
' Schlüssels auslesen (Rückgabe ist ein Array)
Public Function GetAllKeys(hKey As Long, _
  strPath As String) As Variant
 
  Dim lRegResult As Long
  Dim lCounter As Long
  Dim hCurKey As Long
  Dim strBuffer As String
  Dim lDataBufferSize As Long
  Dim strNames() As String
  Dim intZeroPos As Integer
 
  lCounter = 0
  lRegResult = RegOpenKey(hKey, strPath, hCurKey)
  Do
    lDataBufferSize = 255
    strBuffer = String(lDataBufferSize, " ")
    lRegResult = RegEnumKey(hCurKey, lCounter, _
      strBuffer, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
      ReDim Preserve strNames(lCounter) As String
      intZeroPos = InStr(strBuffer, Chr$(0))
      If intZeroPos > 0 Then
        strNames(UBound(strNames)) = Left$(strBuffer, _
          intZeroPos - 1)
      Else
        strNames(UBound(strNames)) = strBuffer
      End If
      lCounter = lCounter + 1
    Else
      Exit Do
    End If
  Loop
  GetAllKeys = strNames
End Function

' Registry-Eintrag auslesen
Public Function GetSettingString(hKey As Long, _
  strPath As String, strValue As String, _
  Optional Default As String) As String
 
  Dim hCurKey As Long
  Dim lValueType As Long
  Dim strBuffer As String
  Dim lDataBufferSize As Long
  Dim intZeroPos As Integer
  Dim lRegResult As Long
 
  If Not IsEmpty(Default) Then
    GetSettingString = Default
  Else
    GetSettingString = ""
  End If
  lRegResult = RegOpenKey(hKey, strPath, hCurKey)
  lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
    lValueType, ByVal 0&, lDataBufferSize)
  If lRegResult = ERROR_SUCCESS Then
    If lValueType = REG_SZ Then
      strBuffer = String(lDataBufferSize, " ")
      lRegResult = RegQueryValueEx(hCurKey, strValue, _
        0&, 0&, ByVal strBuffer, lDataBufferSize)
      intZeroPos = InStr(strBuffer, Chr$(0))
      If intZeroPos > 0 Then
        GetSettingString = Left$(strBuffer, intZeroPos - 1)
      Else
        GetSettingString = strBuffer
      End If
    End If
  Else
     ' Fehler
  End If
  lRegResult = RegCloseKey(hCurKey)
End Function

In unsere Form ziehen wir eine Listbox und einen Command-Button. Anstatt der Listbox kann auch ein Listview verwendet werden. Beim Klicken auf den Command-Button werden dann die installierten Komponenten (OCX und/oder DLLs) ausgelesen und in der Listbox angezeigt.

' Alle installierten Komponenten auflisten
Private Sub ShowCOMs(oListe As Control, _
  Optional ByVal bOCX As Boolean = True, _
  Optional ByVal bDLL As Boolean = True)
 
  Dim vKeys As Variant
  Dim iKey As Integer
  Dim vKeyVersion As Variant
  Dim sPath As String
  Dim sPathTemp As String
  Dim sName As String
  Dim sExt As String
  Dim oItemX As Object
 
  If TypeOf oListe Is ListBox Then
    ' ListBox
    oListe.Clear
  Else
    ' ListView
    oListe.ListItems.Clear
    With oListe.ColumnHeaders
      .Clear
      .Add , , "Komponente"
      .Add , , "Pfad"
    End With
    oListe.View = 3
    oListe.Sorted = True
    oListe.SortKey = "0"
  End If
 
  ' alle Schlüssel in typelib\ auslesen
  vKeys = GetAllKeys(HKEY_CLASSES_ROOT, "TypeLib")
 
  ' Array durchlaufen
  For iKey = 0 To UBound(vKeys)
    sPath = "TypeLib\" & vKeys(iKey)
    vKeyVersion = GetAllKeys(HKEY_CLASSES_ROOT, sPath)
 
    ' Versionsschlüssel öffnen (Name der Komponente)
    sPath = "TypeLib\" & vKeys(iKey) & "\" & vKeyVersion(0)
    sName = GetSettingString(HKEY_CLASSES_ROOT, sPath, "", "")
 
    ' Pfad zur Komponente auslesen
    sPathTemp = sPath & "\0\win32"
    sPath = GetSettingString(HKEY_CLASSES_ROOT, sPathTemp, "", "")
 
    ' Pfad zur Komponente auslesen
    sExt = LCase$(Right(sPath, 4))
    If (sExt = ".ocx" And bOCX) Or (sExt = ".dll" And bDLL) Then
 
      ' Komponente in Liste übertragen
      If TypeOf oListe Is ListBox Then
        ' ListBox
        oListe.AddItem sName
      Else
        ' ListView
        Set oItemX = oListe.ListItems.Add(, , sName)
        oItemX.SubItems(1) = sPath
      End If
    End If
  Next
End Sub

Aufruf:

' Komponenten in einem ListView anzeigen
ShowCOMs ListView1, True, True
 
' nur OCXen
ShowCOMs ListView1, True, False
 
' nur DLLs
ShowCOMs ListView1, False, True

Erläuterungen zum Code
Die Daten befinden sich in der Registry, unter "HKEY_CLASSES_ROOT\TypeLib". Jede registrierte Komponente legt dort einen Eintrag in Form einen Zahlencodes ab (GUID), z.B. "{5F847504-3E17-11D3-BABB-00C04F72FB4E}". Die Funktion "GetAllKeys" ermittelt all diese Einträge und gibt das Ergebnis als Array zurück:

vKeys = GetAllKeys(HKEY_CLASSES_ROOT, "TypeLib")

Nun brauchen wir noch den Namen jeder einzelnen Komponente. Dieser befindet sich einen Schlüssel weiter, der die Versionsbezeichnung trägt. Der Standartwert der Schlüssels ist der Name der *.ocx oder *.dll:

sPath = "TypeLib\" & vKeys(iKey)

Den Wert legen wir in der Variable "sName" ab:

vKeyVersion = GetAllKeys(HKEY_CLASSES_ROOT, sPath)
sPath = "TypeLib\" & vKeys(iKey) & "\" & vKeyVersion(0)
sName = GetSettingString(HKEY_CLASSES_ROOT, sPath, "", "")

Um unterscheiden zu können, ob es sich nun um eine *.ocx oder *.dll handelt, müssen wir zwei Schlüssel tiefer in der Registry graben. Standartmässig ist der nächste Ordner immer "0", und wiederum der nächste "win32", der den Pfad zur *.dll bzw. *. ocx einhält. Den Pfad legen wir in der Variable "sPath" ab. Anschliessend lesen wir den String von rechts um vier Zeichen ein. Je nachdem ob es nun eine *.ocx oder eine *.dll ist, fürgen wir ihn der Liste hinzu.

sPathTemp = sPath & "\0\win32"
sPath = GetSettingString(HKEY_CLASSES_ROOT, sPathTemp, "", "")
sExt = LCase$(Right(sPath, 4))
If (sExt = ".ocx" And bOCX) Or (sExt = ".dll" And bDLL) Then
  If TypeOf oListe Is ListBox Then
    oListe.AddItem sName
  Else
    Set oItemX = oListe.ListItems.Add(, , sName)
    oItemX.SubItems(1) = sPath
  End If
End If

Anmerkung
Wird der Prozedur als Listen-Objekt ein ListView übergeben, so wird neben dem Namen der Komponente automatisch auch der Pfad (sPath) eingetragen (in der 2. Spalte).
 

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.