Rubrik: COM/OLE/Registry/DLL · Sonstiges | VB-Versionen: VB5, VB6 | 27.10.04 |
Den Pfad einer Anwendung ermitteln - das geht doch einfach wird sich jeder denken. Auch aus einer DLL heraus ist es noch keine Schwierigkeit.
Was aber, wenn Sie eine ActiveX-DLL geschrieben haben, und Sie den Pfad der aufrufenden, also instanzierenden Anwendung ermitteln wollen? Da hilft dieser Tipp weiter.
Option Explicit
' Benötigte API-Deklarationen
Private Declare Function GetFullPathName Lib "kernel32" _
Alias "GetFullPathNameA" ( _
ByVal lpFileName As String, _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String, _
ByVal lpFilePart As String) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" _
Alias "CreateToolhelp32Snapshot" ( _
ByVal lFlgas As Long, _
ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" _
Alias "Process32First" ( _
ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" ( _
ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" ( _
ByVal hPass As Long)
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Long = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwflags As Long
szexeFile As String * MAX_PATH
End Type
' Pfad der aufrufenden Anwendung ermitteln
Private Function GetInstancePath() As String
Dim lProcessID As Long
Dim lSnapshot As Long
Dim uProcess As PROCESSENTRY32
Dim lProcessFound As Long
Dim i As Integer
Dim sEXEName As String
' aktuelle Prozess-ID ermitteln
lProcessID = GetCurrentProcessId
lSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
' Fehler?
If lSnapshot = -1 Then Exit Function
' uProcess-Struktur füllen
With uProcess
.dwSize = Len(uProcess)
' alle aktiven Prozesse durchlaufen
lProcessFound = ProcessFirst(lSnapshot, uProcess)
Do While lProcessFound
If .th32ProcessID = lProcessID Then
' ProzessID gefunden
' jetzt EXE-Name ermitteln
If InStr(.szexeFile, Chr$(0)) > 0 Then
sEXEName = Left$(.szexeFile, InStr(.szexeFile, Chr$(0)) - 1)
End If
Exit Do
Else
' ...weitersuchen...
lProcessFound = ProcessNext(lSnapshot, uProcess)
End If
Loop
End With
' vollständigen Pfad ermitteln
Dim nBuffer As String
Dim nFilePart As String
Dim nLen As Long
nBuffer = Space$(255)
nLen = GetFullPathName(sEXEName, Len(nBuffer), nBuffer, nFilePart)
If nLen Then sEXEName = Left$(nBuffer, nLen)
GetInstancePath = sEXEName
End Function