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