Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0415: Zieldatei und Arbeitsverzeichnis einer Verknüpfung ermitteln

VB 5/6-Tipp 0415: Zieldatei und Arbeitsverzeichnis einer Verknüpfung ermitteln

 von Robert Paix

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [6,54 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 -------------
' Es muss ein Verweis auf 'VB 5 - IShellLinkA Interface(ANSI)' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "txtDir"
' Steuerelement: Textfeld "txtFile"
' Steuerelement: Textfeld "txtShortCut"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"


'Achtung!
'Dieses Projekt benötigt einen Verweis(Projekt->Verweise)
'auf die Datei
'"VB 5 - IShellLinkA Interface(ANSI)" (SHELLLINK.TLB).
'Die Datei ist im Download enthalten.

'Autor: Robert Paix
'Email: rpaix@proleit.de

Option Explicit

Private Type ShortCut
    Path As String
    File As String
    WorkDir As String
End Type

Private Sub Form_Load()
    txtShortCut.Text = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "verknüpfung.lnk"
End Sub

Private Sub Command1_Click()
    Dim SC As ShortCut
    
    SC = GetFileName(txtShortCut)
    txtFile = SC.File
    txtDir = SC.WorkDir
End Sub

Private Function GetFileName(strShortcut As String) As ShortCut
    Dim psl As ShellLinkA
    Dim ppf As IPersistFile
    Dim FileObject As WIN32_FIND_DATA
    Dim strPath As String
    Dim strFile As String
    
    On Error Goto Error
    Set psl = New ShellLinkA
    Set ppf = psl
    
    strPath = String(256, 0)
    strFile = String(256, 0)
    ppf.Load StrConv(strShortcut, vbUnicode), 0
    
    psl.GetWorkingDirectory strPath, Len(strPath)
    strPath = Left(strPath, InStr(1, strPath, Chr(0)) - 1)
    GetFileName.WorkDir = strPath
    
    psl.GetPath strFile, Len(strFile), FileObject, 0
    GetFileName.File = strFile
    
    Set ppf = Nothing
    Set psl = Nothing
    
    Exit Function

Error:
    Debug.Print Err, Error(Err)
    Set ppf = Nothing
    Set psl = Nothing
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

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.