|
Den Dateinamen samt Pfad eines aktuell ausgeführten Projekts (EXE, DLL, OCX) erhalten Sie über die Eigenschaft  Path des Visual Basic-Objekts App:
PfadName = App.Path
Doch ein auf einem Form platziertes ActiveX-Control kann mit Visual Basic-eigenen Mitteln nicht den Pfadnamen der ausführbaren Datei in Erfahrung bringen, zu dem dieses Form gehört. Die API-Funktion GetModuleFileName könnte diesen Pfadnamen vielleicht liefern, wenn... ja, wenn Sie das anscheinend von dieser Funktion geforderte Module-Handle zur Verfügung hätten.
"Anscheinend" gefordert? Genau - verzichten Sie einfach darauf und übergeben Sie als Module-Handle den Wert 0, bekommen Sie das Gewünschte. Wie die Dokumentation zu GetModuleFileName aussagt, erhalten Sie dann den Pfadnamen der Datei, von der aus der aufrufende Prozess angelegt wurde. Da ein ActiveX-Control (wie auch eine ActiveX-DLL) In-Process-Komponenten sind, ist der aufrufende Prozess tatsächlich die EXE-Datei, die die Komponente angelegt hat - ergo die EXE-Datei, zu der das Form gehört, auf dem ein ActiveX-Control platziert ist.
Das Module-Handle eines Prozesses, der ein bestimmtes Fenster (Form) angelegt (genauer gesagt: registriert) hat, erfahren Sie über die API-Funktion GetClassLong mit dem Index-Parameter GCL_HMODULE. Damit könnten Sie auch den Pfadnamen von einer fremden Anwendung in Erfahrung bringen, wenn Sie das Handle eines Fensters daraus zur Verfügung haben und wenn diese selbst das betreffende Fenster registriert hat. Bei VB-Forms werden Sie jedoch wenig Glück haben, da diese nicht von der jeweiligen Projekt-EXE registriert werden, sondern zur Laufzeit von der VB-Laufzeit-DLL (MSVBVM60.DLL bzw. MSVBVM50.DLL oder VB40032.DLL) und zur Entwicklungszeit von der EXE der VB-Entwicklungsumgebung (VB6.EXE bzw. VB5.EXE oder VB32.EXE).
Das Steuerelement ParentEXE liefert Ihnen in verschiedenen Eigenschaften Informationen über den Pfadnamen des Eltern-Prozesses: den reinen Pfad in ParentPath, den reinen Dateinamen der EXE in ParentExe und den vollständigen Pfadnamen in ParentPathName. Dazu können sie über die Funktion den Modulnamen (hier nur den vollständigen Pfadnamen) zu jedem beliebigen Fenster-Handle erfragen.
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Private Declare Function GetModuleFileName Lib "kernel32" _
Alias "GetModuleFileNameA" (ByVal hModule As Long, _
ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const GCL_HMODULE = (-16)
Public Property Get ParentPath() As String
Dim nPath As String
zSplitPath zGetModulePathName(0), , nPath
ParentPath = nPath
End Property
Public Property Get ParentExe() As String
Dim nFileName As String
zSplitPath zGetModulePathName(0), , , nFileName
End Property
Public Property Get ParentPathName() As String
ParentPathName = zGetModulePathName(0)
End Property
Public Function ModulePathName(Optional ByVal hWnd As Long) As String
ModulePathName = zGetModulePathName(hWnd)
End Function
Private Function zGetModulePathName(hWnd As Long) As String
Dim nResult As String
Dim nLenResult As Long
nResult = Space(260)
nLenResult = Len(nResult)
nLenResult = GetModuleFileName(GetClassLong(hWnd, GCL_HMODULE), _
nResult, nLenResult)
zGetModulePathName = Left$(nResult, nLenResult)
End Function
Private Sub zSplitPath(FullPath As String, Optional Drive As String, _
Optional Path As String, Optional FileName As String, _
Optional File As String, Optional Extension As String)
Dim nPos As Integer
nPos = InStrRev(FullPath, "\")
If nPos Then
If Left$(FullPath, 2) = "\\" Then
If nPos = 2 Then
Drive = FullPath
Path = ""
FileName = ""
File = ""
Extension = ""
Exit Sub
End If
End If
Path = Left$(FullPath, nPos - 1)
FileName = Mid$(FullPath, nPos + 1)
nPos = InStrRev(FileName, ".")
If nPos Then
File = Left$(FileName, nPos - 1)
Extension = Mid$(FileName, nPos + 1)
Else
File = FileName
Extension = ""
End If
Else
Path = FullPath
FileName = ""
File = ""
Extension = ""
End If
If Left$(Path, 2) = "\\" Then
nPos = InStr(3, Path, "\")
If nPos Then
Drive = Left$(Path, nPos - 1)
Else
Drive = Path
End If
Else
If Len(Path) = 2 Then
If Right$(Path, 1) = ":" Then
Path = Path & "\"
End If
End If
If Mid$(Path, 2, 2) = ":\" Then
Drive = Left$(Path, 2)
End If
End If
End Sub
Private Sub UserControl_Resize()
Static sInProc As Boolean
If sInProc Then
Exit Sub
Else
sInProc = True
End If
UserControl.Size 32 * Screen.TwipsPerPixelX, _
32 * Screen.TwipsPerPixelY
sInProc = False
End Sub
Nähere Details zur Funktion zGetModulePathName finden Sie in  "Vaterschaftsnachweis I", zur Funktion zSplitPath in "Sollbruchstellen" (Sie können die Funktion hier natürlich auch vereinfachen) und zur Darstellung des UserControls zur Entwicklungszeit in "Mehr scheinen als sein".
|