获取快捷方式原文件路径

这篇文章是参考下面地址修改而来希望对大家有用。此方法可以不需要引用IShellLink.
http://www.vckbase.com/document/viewdoc/?id=1411 

 

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type LNKHEAD
    dwID As Long
    dwGUID(3) As Long
    dwFlags As Long
    dwFileAttributes As Long
    dwCreationTime As FILETIME
    dwModificationTime As FILETIME
    dwLastaccessTime As FILETIME
    dwFileLen As Long
    dwIconNum As Long
    dwWinStyle As Long
    dwHotkey As Long
    dwReserved1 As Long
    dwReserved2 As Long
End Type

Private Type FILELOCATIONINFO
    dwSize As Long
    dwFirstOffset As Long
    dwFlags As Long
    dwOffsetOfVolume As Long
    dwOffsetOfBasePath As Long
    dwOffsetOfNetworkVolume As Long
    dwOffsetOfRemainingPath As Long
End Type

Private Type LOCALVOLUMETAB
    dwSize As Long
    dwTypeOfVolume As Long
    dwVolumeSerialNumber As Long
    dwOffsetOfVolumeName As Long
    strVolumeName As Byte
End Type

Private Type NETWORKVOLUMETAB
    dwSize As Long
    dwUnknown1 As Long
    dwOffsetOfNetShareName As Long
    dwUnknown2 As Long
    dwUnknown3 As Long
    strNetShareName As Byte
End Type

Private Const LNK_HASIDLIST = &H1
Private Const LNK_FILEDIR = &H2
Private Const LNK_HASDES = &H4
Private Const LNK_HASPATH = &H8
Private Const LNK_HASWORKDIR = &H10
Private Const LNK_HASCMD = &H20

Private Const LNK_LOCALVOLUME = &H1
Private Const LNK_NETSHARE = &H2

Public Function GetLinkPath(ByVal strShortCut As String) As String
    Dim objLinked As LNKHEAD
    Dim intNo As Integer, intTmp As Integer
    Dim objInfo As FILELOCATIONINFO
    Dim intSeek As Integer
    Dim bytBuffer() As Byte
    intNo = FreeFile
    Open strShortCut For Binary As #intNo
    Get #intNo, , objLinked
    intSeek = Len(objLinked)
    If objLinked.dwFlags And LNK_HASIDLIST Then
        Get #intNo, , intTmp
    Else
        Close #intNo
        Exit Function
    End If
    intSeek = Seek(intNo)
    intSeek = intSeek + intTmp
    Seek #intNo, intSeek
    Get #intNo, , objInfo
    Seek #intNo, objInfo.dwOffsetOfBasePath + intSeek
    If objInfo.dwFlags And LNK_NETSHARE Then
        intSeek = objInfo.dwOffsetOfNetworkVolume - objInfo.dwOffsetOfBasePath
    Else
        intSeek = objInfo.dwOffsetOfRemainingPath - objInfo.dwOffsetOfBasePath
    End If
    ReDim bytBuffer(intSeek - 1)
    Get #intNo, , bytBuffer
    Close #intNo
    GetLinkPath = StrConv(bytBuffer, vbUnicode)
End Function