Public Function ResolveShortcut(ByRef vsLnkFilePath As String) As String
Dim hFile As Integer
Dim nByteBuffer As Byte
Dim nLongBuffer As Long
Dim nIntBuffer As Integer
Dim nPosFLI As Long '# Position de départ de la FLI (File Location Info)
Dim nOffset_BasePath As Long
Dim nOffset_Network As Long
Dim nOffset_Remaining As Long
hFile = FreeFile
Open vsLnkFilePath For Binary Access Read As hFile
Get hFile, 1, nLongBuffer
'# les fichiers LNK commencent par un 'L'
If nLongBuffer = 76 Then
'# On skippe le GUID
Seek hFile, 21
'# On récupère les flags
Get hFile, , nLongBuffer
'# si la Shell Item ID liste est présente...
If nLongBuffer And 1 Then
Seek hFile, 77
'# On récupère la taille totale de la liste
Get hFile, , nIntBuffer
'# et on décale d'autant le pointeur de lecture.
nPosFLI = 79 + nIntBuffer
Else
nPosFLI = 77
End If
'# On skippe la taille, les flags, et les Local Volume Info
Seek hFile, nPosFLI + 16
'# Offset du chemin, si fichier local
Get hFile, , nOffset_BasePath
'# Offset du repertoire réseau
Get hFile, , nOffset_Network
'# Offset du reste (éventuel) du nom du fichier
Get hFile, , nOffset_Remaining
If nOffset_BasePath Then
Seek hFile, nPosFLI + nOffset_BasePath
Do
Get hFile, , nByteBuffer
If nByteBuffer <> 0 Then
ResolveShortcut = ResolveShortcut & ChrW$(nByteBuffer)
Else
Exit Do
End If
Loop
ElseIf nOffset_Network Then
Seek hFile, nPosFLI + nOffset_Network + &H14
Do
Get hFile, , nByteBuffer
If nByteBuffer <> 0 Then
ResolveShortcut = ResolveShortcut + ChrW$(nByteBuffer)
Else
Exit Do
End If
Loop
ResolveShortcut = ResolveShortcut & "\"
End If
If nOffset_Remaining Then
Seek hFile, nPosFLI + nOffset_Remaining
Do
Get hFile, , nByteBuffer
If nByteBuffer <> 0 Then
ResolveShortcut = ResolveShortcut + ChrW$(nByteBuffer)
Else
Exit Do
End If
Loop
End If
Else
ResolveShortcut = vsLnkFilePath
End If
Close hFile
End Function