|
Tipp 0508
|
Registrierte ActiveX-Komponenten auslesen
|
 |
|
Autor/Einsender:
Datum: |
|
Thorsten Thiel
09.08.2006 |
|
| Entwicklungsumgebung: |
|
VB 6 |
|
|
|
Wer sich wie in VB unter Ansicht/Komponenten eine Liste mit allen im System registrierten ActiveX-Komponenten anzeigen lassen möchte, kann
dies mit diesem Tipp tun. Dazu müssen die Komponenten aus der System-Registrierung ausgelesen werden.
|
|
Dort befinden sich die Daten 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 Standardwert des 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. Standardmäßig 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. Anschließend lesen wir den String von rechts um vier Zeichen ein.
Je nachdem ob es nun eine *.ocx oder eine *.dll ist, fügen wir ihn der Liste hinzu.
|
|
| Code im Codebereich des Moduls |
|
| |
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const REG_SZ = 1
Public Const ERROR_SUCCESS = 0&
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 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 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 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
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
|
|
|
| Code im Codebereich der Form |
|
| |
Option Explicit
Private Sub Form_Load()
Combo1.AddItem "Nur OCX"
Combo1.AddItem "Nur DLL"
Combo1.AddItem "Alle"
Combo1.ListIndex = 2
End Sub
Private Sub ShowCOMs(Optional ByVal bOCX As Boolean = True, _
Optional ByVal bDLL As Boolean = True)
Dim vKeys As Variant
Dim iKey As Long
Dim vKeyVersion As Variant
Dim sPath As String
Dim sPathTemp As String
Dim sName As String
Dim sExt As String
Dim oItemX As Object
On Error Resume Next
ListView1.ListItems.Clear
With ListView1.ColumnHeaders
.Clear
.Add , , "Komponente", 4050
.Add , , "Pfad", 3330
End With
ListView1.View = 3
ListView1.Sorted = True
ListView1.SortKey = "0"
vKeys = GetAllKeys(HKEY_CLASSES_ROOT, "TypeLib")
For iKey = 0 To UBound(vKeys)
sPath = "TypeLib\" & vKeys(iKey)
vKeyVersion = GetAllKeys(HKEY_CLASSES_ROOT, sPath)
sPath = "TypeLib\" & vKeys(iKey) & "\" & vKeyVersion(0)
sName = GetSettingString(HKEY_CLASSES_ROOT, sPath, "", "")
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
Set oItemX = ListView1.ListItems.Add(, , sName)
oItemX.SubItems(1) = sPath
End If
Next
End Sub
Private Sub Command2_Click()
Select Case Combo1.ListIndex
Case 0
ShowCOMs True, False
Case 1
ShowCOMs False, True
Case 2
ShowCOMs True, True
End Select
End Sub
|
|
|
| Windows-Version |
| 95 |
 |
|
| 98 |
|
|
| ME |
|
|
| NT |
|
|
| 2000 |
|
|
| XP |
|
|
| Vista |
|
|
| Win
7 |
|
|
|
| VB-Version |
| VBA 5 |
 |
|
| VBA 6 |
|
|
| VB 4/16 |
|
|
| VB 4/32 |
|
|
| VB 5 |
|
|
| VB 6 |
|
|
|
|
Download (4,8 kB)
|
Downloads bisher: [ 692 ]
|
|
|
Vorheriger Tipp
Zum Seitenanfang 