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 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 Dieser Tipp wurde bereits 32.377 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
Neu! sevCoolbar 3.0 Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Tipp des Monats September 2024 Dieter Otter Übergabeparameter: String oder Array? Mit der IsArray-Funktion lässt sich prüfen, ob es sich bei einem Übergabeparameter an eine Prozedur um ein Array oder einer "einfachen" Variable handelt. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |