Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0637: Testen, ob eine ActiveX-Dll registriert ist.

 von 

Beschreibung 

Mit diesem Tipp lässt sich herausfinden, ob ein ActiveX-Komponente registriert ist. Optional kann man es, sollte es nicht registriert sein, registrieren. Allerdings muss dafür der Pfad der DLL bekannt sein.

Dieser Tipp funktioniert entweder nur in kompilierter Form oder benötigt eine DLL/OCX-Datei. Diese Binärdateien sind dem Tipp hinzugefügt worden, um seinen Funktionsumfang darstellen zu können. Vor dem Upload wurden sie auf Viren geprüft.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

RegCloseKey, RegOpenKeyExA (RegOpenKeyEx), RegQueryValueA (RegQueryValue), RegQueryValueExA (RegQueryValueEx), RegSetValueExA (RegSetValueEx)

Download:

Download des Beispielprojektes [6,9 KB]

'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 Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command4"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private DllPath As String

Private Sub Command1_Click()
    Shell "regsvr32 /s " & Chr(34) & DllPath & Chr(34)
End Sub

Private Sub Command2_Click()
    Shell "regsvr32 /s /u " & Chr(34) & DllPath & Chr(34)
End Sub

Private Sub Command3_Click()
    If IsClassRegistered("Multi.Multiplikation") Then
        Call MsgBox("Die Klasse ist registriert")
    Else
        Call MsgBox("Die Klasse ist NICHT registriert")
    End If
End Sub

Private Sub Command4_Click()
    If IsClassRegistered("Multi.Multiplikation", DllPath) Then
        Call MsgBox("Die Klasse ist registriert")
    Else
        Call MsgBox("Die Klasse ist NICHT registriert")
    End If
End Sub

Private Sub Form_Load()
    DllPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "AXDll.dll"
    Command1.Caption = "DLL registrieren"
    Command2.Caption = "DLL aus Registrierung entfernen"
    Command3.Caption = "Ist DLL registriert?"
    Command4.Caption = "Ist DLL registriert? (wenn nicht, registrieren!)"
End Sub

Public Function IsClassRegistered(Class As String, Optional Filename As String = "") As Boolean
' überprüft, ob die angegebene Klasse (ActiveX-DLL) registriert ist.
' Um z. B. zu überprüfen, ob CreateObject("Excel.Application")
' ausführbar ist, muss IsClassRegistered so ausgeführt werden:
'
' blnRetVal = IsClassRegistered("Excel.Application")
'
' Wenn diese nicht registriert ist, der Pfad und der Dateiname
' bekannt ist (für das Beispiel wäre das z.B.
' "C:\Programme\Microsoft Office\Office10\Excel.exe"),
' kann diese Funktion die DLL registrieren:
'
' blnRetVal = IsClassRegistered("Excel.Application",
' "C:\Programme\Microsoft Office\Office10\Excel.exe")
'

' Anmerkung von Jochen Wierum (JoWi@ActiveVB.de):
' Ursprünglich in dieser Funktion eine Klasse von Götz Reinecke
' verwenden. Die Klasse diente dem Zugriff auf die Registry. Aus Platz-
' gründen habe ich sie daher entfernt und die genutzten Funktionen in
' das Modul "modRegistry" kopiert. Wer sich für die Originalklasse
' interessiert, kann diese in der Klassenrubrik wiederfinden.
    
Dim strCLSID As String
Dim strFilename As String

If SubKeyExists(HKEY_CLASSES_ROOT, Class) Then
    Call ValueRead(HKEY_CLASSES_ROOT, Class & "\CLSID", "", strCLSID)
    Call ValueRead(HKEY_CLASSES_ROOT, "CLSID\" & strCLSID & _
        "\InprocServer32", "", strFilename)
    If (Len(Filename) > 0) And (Filename <> strFilename) Then
        
        ' die DLL ist bereits registriert, aber der Pfad hat sich geändert
        Shell "regsvr32 /s " & Chr(34) & Filename & Chr(34)
        
        Call ValueRead(HKEY_CLASSES_ROOT, Class & "\CLSID", "", strCLSID)
        Call ValueRead(HKEY_CLASSES_ROOT, "CLSID\" & strCLSID & _
            "\InprocServer32", "", strFilename)
        
        If strFilename <> Filename Then
            ' registrieren fehlgeschlagen
            IsClassRegistered = False
        Else
            IsClassRegistered = True
        End If
    Else
        IsClassRegistered = True
        Exit Function
    End If
Else
    If Len(Filename) > 0 Then
        Shell "regsvr32 /s " & Chr(34) & Filename & Chr(34)
        
        Call ValueRead(HKEY_CLASSES_ROOT, Class & "\CLSID", "", strCLSID)
        Call ValueRead(HKEY_CLASSES_ROOT, "CLSID\" & strCLSID & _
            "\InprocServer32", "", strFilename)
        
        If strFilename <> Filename Then
            ' registrieren fehlgeschlagen
            IsClassRegistered = False
        Else
            IsClassRegistered = True
        End If
    Else
        IsClassRegistered = False
    End If
End If
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'----- Anfang Modul "modRegistry" alias modRegistry.bas -----

Option Explicit

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

Private Const KEY_QUERY_VALUE As Long = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8&
Private Const KEY_NOTIFY As Long = &H10&
Private Const READ_CONTROL As Long = &H20000

Private Const SYNCHRONIZE As Long = &H100000
Private Const ERROR_SUCCESS As Long = 0&

Private Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Private Const STANDARD_RIGHTS_EXECUTE As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)

Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS _
    Or KEY_NOTIFY) And (Not SYNCHRONIZE))

Private 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 Long, ByVal cbData 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 RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue _
    As Long) As Long
    
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 Any) As Long

Public Function SubKeyExists(ByRef Root As Long, ByRef Path As String) As Boolean
    Dim hKey As Long
    
    If RegOpenKeyEx(CLng(Root), Path, 0&, CLng(KEY_READ), hKey) = ERROR_SUCCESS Then
        If hKey <> 0 Then
            SubKeyExists = True
            Call RegCloseKey(hKey)
        End If
    End If
End Function

Public Function ValueRead(ByRef Root As Long, ByRef Path As String, _
    ByVal ValueName As String, ByRef Value As Variant) As Boolean
    
    Dim Result As Long, hKey As Long, regType As Long
    Dim lngBuffer As Long, strBuffer As String, DataLength As Long
    
    If RegOpenKeyEx(CLng(Root), Path, 0&, CLng(KEY_READ), hKey) = ERROR_SUCCESS Then
        If hKey <> 0 Then
            DataLength = 512
            strBuffer = Space$(DataLength)
            
            If ValueName = "" Then
                Result = RegQueryValue(hKey, vbNullString, ByVal strBuffer, DataLength)
                Value = Left$(strBuffer, DataLength - 1)
            Else
                Result = RegQueryValueEx(hKey, ValueName, 0&, regType, ByVal 0&, DataLength)
            
                If Result = ERROR_SUCCESS Then
                    Result = RegQueryValueEx(hKey, ValueName, 0&, regType, _
                        ByVal strBuffer, DataLength)
                    If Result = ERROR_SUCCESS Then Value = Left$(strBuffer, DataLength - 1)
                End If
            End If
        End If
        
        If Result = ERROR_SUCCESS Then ValueRead = True
        Call RegCloseKey(hKey)
    End If
End Function
'------ Ende Modul "modRegistry" alias modRegistry.bas ------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Sven G am 17.05.2005 um 12:57

funnktioniert nicht, API-Deklarationen fehlen

Kommentar von TbR am 02.05.2004 um 11:13

Code fuer das Registrieren per API:

Option Explicit

Public Enum DLLType
NoDLL = 0
StandardDLL = 1
ActiveXDLL = 2
End Enum

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function RegisterFile(ByVal sFile As String, register As Boolean) As Boolean

'Der Parameter sFile enthält die zu registrierende Datei (inkl. Pfad)
'Register: True -> Datei soll registriert werden
' False -> Datei soll deregistriert werden

Dim Result As Boolean
Dim Lib As Long
Dim sProc As String
Dim r1 As Long
Dim r2 As Long
Dim Thread As Long

On Local Error GoTo RegError

Result = False
Lib = LoadLibrary(sFile)
If Lib Then
sProc = IIf(register, "DllRegisterServer", "DllUnregisterServer")
r1 = GetProcAddress(Lib, sProc)
If r1 Then
Thread = CreateThread(ByVal 0, 0, ByVal r1, ByVal 0, 0, r2)
If Thread Then
r2 = WaitForSingleObject(Thread, 10000)
If r2 Then
'Fehler aufgetreten
FreeLibrary Lib
r2 = GetExitCodeThread(Thread, r2)
ExitThread r2
Exit Function
End If
CloseHandle Thread
'OK
Result = True
End If
End If
FreeLibrary Lib
End If

RegError:
RegisterFile = Result
Exit Function

End Function

Public Function DLLAvail(sFile As String) As DLLType
Dim nHandle As Long
Dim sProcedure As String

nHandle = LoadLibrary(sFile)
If nHandle <> 0 Then
' jepp, es ist eine DLL
DLLAvail = StandardDLL

' jetzt prüfen, ob es eine Standard-DLL
' oder ActiveX-DLL ist
sProcedure = "DllRegisterServer"
If CBool(GetProcAddress(nHandle, sProcedure)) = True Then
DLLAvail = ActiveXDLL
End If

' Speicher wieder freigeben
Call FreeLibrary(nHandle)
Else
DLLAvail = NoDLL
End If
End Function

~~~~~~~~~~~~~~~~~~~~~~~~~~

man koennte nun ueber die Function DLLAvail ueberpruefen, ob die angegebene Datei (sFile) ueberhaupt eine Active-X DLL, oder ein OCX ist.
Die Function RegisterFile (de)registriert dann die angegebene Datei.
Dies nur als Erweiterung zu dem vorhandenen Tipp :)
mfg TbR