Re: Listview

Hallo Olaf,

Ehm, ...wie verknüpft man nicht registrierte Dlls dynamisch
per LateBinding?

Ungefähr so:

Option Explicit

Private Declare Function LoadLibrary Lib "kernel32" Alias _
"LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
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 Function GetExitCodeThread Lib "kernel32" _
(ByVal hThread As Long, lpExitCode As Long) As Long

Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As
Long) As Long

Const STATUS_WAIT_0 = &H0


'Late binding von DLLs, z. B. in einer globalen Vorlage
'Die DLL muss nicht mehr über Extras-Verweise fest angebunden sein
Public Sub AutoExec()
On Error Resume Next 'damit beim ersten Test auch RegServeDLL
ausgeführt wird
Const cDLLFULLNAME As String = "<Pfad und Name der DLL-Datei>"
Dim sDLL As String 'sDLL muss dem echten DLLNamen entsprechen
Dim sClsName As String 'sClsName muss einem echten Klassennamen
entsprechen

sDLL = "<DLLBezeichnung>"

'In jeder DLL muss eine öffentliche Klasse clsLoader eingerichtet werden
'mit einer Get-Property IsLoaded, die True zurückliefert
sClsName = "clsLoader"

'Zunächst testen, ob der Verweis bereits funktioniert.
'Das ist bei registrierten oder bereits geladenen DLL der Fall.
'Auch das Kompilieren der DLL mit VB6 führt zu einer Registrierung.
'Deshalb anschließend immer Unreg ausführen, sonst arbeitet VBA
'mit der neuesten DLL und nicht mit der in cDLLFULLNAME benannten.
Dim cTest As Object
Set cTest = getDLL(sDLL & "." & sClsName)
If cTest.IsLoaded <> True Then
If Dir(cDLLFULLNAME) <> "" Then
If RegServeDLL(cDLLFULLNAME, True) = True Then
Exit Sub 'ggf. Fehlerbehandlung vor Ausstieg
End If
Else
Exit Sub 'ggf. Fehlerbehandlung vor Ausstieg
End If
End If
'und nun wird mit echten DLL-Funktionen gearbeitet
Dim myClass As Object 'und nicht mehr als spezifizierte Klasse
sClsName = "<öffentlicher Klassenname>" 'hier spezifizieren
Set myClass = getDLL(sDLL & "." & sClsName)

'Ausgabe eines Wertes. Natürlich muss die Get-Property in der Klasse
vorhanden sein
'Debug.Print myClass.EineProperty

'falls gewünscht, könnte man die DLL auch wieder deregistrieren
'wenn die DLL-Funktionen nicht noch in anderen VBA-Teilen gebraucht werden
'RegServeDLL cDLLFULLNAME, False
End Sub

'Es muss einmalig RegServeDLL gerufen sein, damit getDLL ein Klassenobject
zurückliefert
Private Function getDLL(sClassName As String) As Object
On Error Resume Next 'produziert Fehler, sofern die Klasse noch nicht
registriert ist
Set getDLL = CreateObject(sClassName)
End Function

'Liefert True, wenn Fehler auftrat !!!
Private Function RegServeDLL(ByVal sDLLPath As String, bModus As Boolean) As
Boolean
Dim insthLib As Long, lpLibAdr As Long, hThd As Long, lpExCode As Long
Dim procName As String, Result As Long, okFlag As Boolean

'DLL in den Speicher laden
insthLib = LoadLibrary(sDLLPath)

'Aktion wählen
If insthLib Then
If bModus Then
procName = "DllRegisterServer"
Else
procName = "DllUnregisterServer"
End If

'Adresse der DLL im Speicher
lpLibAdr = GetProcAddress(insthLib, procName)
If lpLibAdr <> 0 Then

'Aktion starten
hThd = CreateThread(ByVal 0, 0, ByVal lpLibAdr, ByVal 0&, 0&, 0&)
If hThd Then
'Maximal 5 sec warten
Result = WaitForSingleObject(hThd, 5000)
If Result = STATUS_WAIT_0 Then
'Vorgang erfolgreich in 5 sec beendet
Call CloseHandle(hThd)
okFlag = True
Else
'5 sec überschritten -> Thread schließen
Call GetExitCodeThread(hThd, lpExCode)
Call ExitThread(lpExCode)
Call CloseHandle(hThd)
End If
End If
End If

'Speicher wieder freigeben
Call FreeLibrary(insthLib)
End If

If Not okFlag Then
RegServeDLL = True
Else
RegServeDLL = False
End If
End Function

'######Ente

Hang loose, Hartwig
.

Relevant Pages

  • Re: CryptAPI
    ... > Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias ... > As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long ... > On Error GoTo ErrSign ...
    (microsoft.public.vb.winapi)
  • Re: Feedback on recursive file search...
    ... Private Declare Function FindFirstFileW Lib "kernel32" _ ... (ByVal lpFileName As String, lpFindData As Any) ...
    (microsoft.public.vb.general.discussion)
  • Re: Feedback on recursive file search...
    ... Private Declare Function FindFirstFileW Lib "kernel32" _ ... (ByVal lpFileName As String, lpFindData As Any) ...
    (microsoft.public.vb.winapi)
  • Re: problem with RegQueryValueEx (long)
    ... >> Function RegGetString(hInKey As Long, ByVal sSubKey As String, ByVal ... > (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long ... > Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias ...
    (microsoft.public.vb.general.discussion)
  • Re: Modify windows language from VBA Code
    ... lpReserved As String ... Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ ...
    (microsoft.public.word.vba.general)
Loading