Public Shared Function GetLnkTarget(ByVal lnkPath As String) As String
Dim shl = New Shell32.Shell()
' Move this to class scope
lnkPath = System.IO.Path.GetFullPath(lnkPath)
Dim dir = shl.[NameSpace](System.IO.Path.GetDirectoryName(lnkPath))
Dim itm = dir.Items().Item(System.IO.Path.GetFileName(lnkPath))
Dim lnk = DirectCast(itm.GetLink, Shell32.ShellLinkObject)
Return lnk.Target.Path
End Function

________
Alle Angaben ohne Gewähr. Keine Haftung für Vorschläge, Tipps oder sonstige Hilfe, falls es schiefgeht, nur Zeit verschwendet oder man sonst nicht zufrieden ist

________
Alle Angaben ohne Gewähr. Keine Haftung für Vorschläge, Tipps oder sonstige Hilfe, falls es schiefgeht, nur Zeit verschwendet oder man sonst nicht zufrieden ist

Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports Shell32
 
Module ParseLnk
 
 
    Public Class MsiShortcutParser
        '
        '        UINT MsiGetShortcutTarget(
        '            LPCTSTR szShortcutTarget,
        '            LPTSTR szProductCode,
        '            LPTSTR szFeatureId,
        '            LPTSTR szComponentCode
        '        );
        '        
        <DllImport("msi.dll", CharSet:=CharSet.Auto)> _
        Private Shared Function MsiGetShortcutTarget(ByVal targetFile As _
        String, ByVal productCode As StringBuilder, ByVal featureID As _
        StringBuilder, ByVal componentCode As StringBuilder) As Integer
        End Function
 
        Public Enum InstallState
            NotUsed = -7
            BadConfig = -6
            Incomplete = -5
            SourceAbsent = -4
            MoreData = -3
            InvalidArg = -2
            Unknown = -1
            Broken = 0
            Advertised = 1
            Removed = 1
            Absent = 2
            Local = 3
            Source = 4
            [Default] = 5
        End Enum
 
        Public Const MaxFeatureLength As Integer = 38
        Public Const MaxGuidLength As Integer = 38
        Public Const MaxPathLength As Integer = 1024
 
        '
        '        INSTALLSTATE MsiGetComponentPath(
        '          LPCTSTR szProduct,
        '          LPCTSTR szComponent,
        '          LPTSTR lpPathBuf,
        '          DWORD* pcchBuf
        '        );
        '        
 
        <DllImport("msi.dll", CharSet:=CharSet.Auto)> _
        Private Shared Function MsiGetComponentPath(ByVal productCode As _
        String, ByVal componentCode As String, ByVal componentPath As _
        StringBuilder, ByRef componentPathBufferSize As Integer) As InstallState
        End Function
 
        Public Shared Function ParseShortcut(ByVal file As String) As String
            Dim product As New StringBuilder(MaxGuidLength + 1)
            Dim feature As New StringBuilder(MaxFeatureLength + 1)
            Dim component As New StringBuilder(MaxGuidLength + 1)
 
            MsiGetShortcutTarget(file, product, feature, component)
 
            Dim pathLength As Integer = MaxPathLength
            Dim path As New StringBuilder(pathLength)
 
            Dim installState__1 As InstallState = MsiGetComponentPath( _
              product.ToString(), component.ToString(), path, pathLength)
            If installState__1 = InstallState.Local Then
                Return path.ToString()
            Else
                Return Nothing
            End If
        End Function
 
        Public Shared Function ParseShortcutShellOld(ByVal lnkPath As String) _
          As String
            Dim shl = New Shell32.Shell()
            ' Move this to class scope
            lnkPath = System.IO.Path.GetFullPath(lnkPath)
            Dim dir = shl.[NameSpace](System.IO.Path.GetDirectoryName(lnkPath))
            Dim itm = dir.Items().Item(System.IO.Path.GetFileName(lnkPath))
            Dim lnk = DirectCast(itm.GetLink, Shell32.ShellLinkObject)
            'Dim lnk As Shell32.ShellLinkObject = CType(itm.GetLink, 
            ' Shell32.ShellLinkObject)
            Return lnk.Target.Path
        End Function
        Public Shared Function ParseShortcutShell(ByVal shortcutFilename As _
          String) As String
            Dim pathOnly As String = System.IO.Path.GetDirectoryName( _
            shortcutFilename)
            Dim filenameOnly As String = System.IO.Path.GetFileName( _
            shortcutFilename)
            Dim shell As New Shell()
            Dim folder As Folder = shell.[NameSpace](pathOnly)
            Dim folderItem As FolderItem = folder.ParseName(filenameOnly)
            If folderItem IsNot Nothing Then
                Dim link As Shell32.ShellLinkObject = DirectCast( _
                  folderItem.GetLink, Shell32.ShellLinkObject)
                'Dim lnk As Shell32.ShellLinkObject = CType(itm.GetLink, 
                ' Shell32.ShellLinkObject)
                Return link.Path
            Else
                MsgBox("Error retrieving application path from shortcut", _
                  vbCritical)
                Return ""
            End If
        End Function
 
    End Class
 
End Module