VB 获取快捷方式原文件路径

'此方法不需要引用IShellLink.

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