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


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!