asked on

Question for MCRIDER (or anyone else) reading all of the information about a lnk file

Hello MC,

In article Q_10205631 you wrote:

In case any of you are interrested, this will return all of the information about a link.

Add the following to a MODULE:

'-------------------------------------------------------------------------------
Type LnkHeader
SOH As Long
GUID As String * 16
Flags As Long
Attributes As Long
CreatedTime As Double
ModifiedTime As Double
LastAccessed As Double
Length As Long
Icon As Long
ShowWindow As Long
HotKey As Long
Resvd1 As Long
Resvd2 As Long
ShellIDLen As Integer
End Type

Type LnkFLocInfo
Length As Long
Offset As Long
Flags As Long
LocVolInfoOffset As Long
BasePathOffset As Long
NetVolInfoOffset As Long
NetRemainingPathOffset As Long
End Type

Type LnkLocVolTable
Length As Long
VolType As Long
SerialNumber As Long
VolNameOffset As Long
End Type

Type LnkNetVolTable
Length As Long
Resvd1 As Long
ShareNameOffset As Long
Resvd2 As Long
Resvd3 As Long
End Type

Type LnkFileEntry
Size As Integer
Path As String * 256
End Type

Type LinkInfo
VolumeLabel As String
NetShareName As String
BasePath As String
RemainingPath As String
LastModified As String
Description As String
RelativePath As String
WorkingDirectory As String
CommandLine As String
IconFile As String
End Type

Function BitValue(BitNumber As Integer, Value As Variant) As Boolean
Dim lBits As String
If UCase$(Left$(CStr(Value), 2)) = "&B" Then
lBits = Right$(String(128, "0") + Mid$(Value, 3), 128)
Else
lBits = cvtBin(Value, 128)
End If
If Left$(Right$(lBits, BitNumber + 1), 1) = "1" Then BitValue = True
End Function

Function cvtBin(Value As Variant, Length As Integer) As String
Dim BinString As String
Dim lHex As String
Dim iVal As Integer
lHex = UCase$(Hex$(Val(Value)))
BinString = String(Length, "0")
For iVal = 1 To Len(lHex)
Select Case Mid$(lHex, iVal, 1)
Case "0": BinString = BinString + "0000"
Case "1": BinString = BinString + "0001"
Case "2": BinString = BinString + "0010"
Case "3": BinString = BinString + "0011"
Case "4": BinString = BinString + "0100"
Case "5": BinString = BinString + "0101"
Case "6": BinString = BinString + "0110"
Case "7": BinString = BinString + "0111"
Case "8": BinString = BinString + "1000"
Case "9": BinString = BinString + "1001"
Case "A": BinString = BinString + "1010"
Case "B": BinString = BinString + "1011"
Case "C": BinString = BinString + "1100"
Case "D": BinString = BinString + "1101"
Case "E": BinString = BinString + "1110"
Case "F": BinString = BinString + "1111"
End Select
Next iVal
cvtBin = Right$(BinString, Length)
End Function

Function GetLinkInfo(LinkPath As String) As LinkInfo
Dim LinkHeader As LnkHeader
Dim FileLocBlock As LnkFLocInfo
Dim LocVolTable As LnkLocVolTable
Dim NetVolTable As LnkNetVolTable
Dim LinkInfo As LinkInfo
Dim fInfo As LnkFileEntry
Dim lIndex As Long
Dim fNum As Long
Dim fLen As Long
Dim iVal As Long
Dim lBuf As String
Dim lPath As String * 256

On Error Resume Next
fNum = FreeFile
Err = 0
Open LinkPath For Binary Access Read As fNum
If Not Err = 0 Then Exit Function
LinkInfo.LastModified = FileDateTime(LinkPath)
fLen = LOF(fNum)
Get #fNum, 1, LinkHeader
Get #fNum, LinkHeader.ShellIDLen + 79, FileLocBlock
Get #fNum, FileLocBlock.LocVolInfoOffset + LinkHeader.ShellIDLen + 79, LocVolTable
Get #fNum, LocVolTable.VolNameOffset + FileLocBlock.LocVolInfoOffset _
+ LinkHeader.ShellIDLen + 80, lPath
LinkInfo.VolumeLabel = Left$(lPath, InStr(1, lPath, Chr$(0)) - 1)
Get #fNum, FileLocBlock.NetVolInfoOffset + LinkHeader.ShellIDLen + 79, NetVolTable
Get #fNum, NetVolTable.ShareNameOffset + FileLocBlock.NetVolInfoOffset _
+ LinkHeader.ShellIDLen + 79, lPath
LinkInfo.NetShareName = Left$(lPath, InStr(1, lPath, Chr$(0)) - 1)
Get #fNum, FileLocBlock.BasePathOffset + LinkHeader.ShellIDLen + 79, lPath
LinkInfo.BasePath = Left$(lPath, InStr(1, lPath, Chr$(0)) - 1)
Get #fNum, FileLocBlock.NetRemainingPathOffset + LinkHeader.ShellIDLen + 79, lPath
LinkInfo.RemainingPath = Left$(lPath, InStr(1, lPath, Chr$(0)) - 1)
lIndex = Len(LinkInfo.RemainingPath) + NetVolTable.Length _
+ FileLocBlock.NetVolInfoOffset + LinkHeader.ShellIDLen + 80
If BitValue(2, LinkHeader.Flags) = True Then
Get #fNum, lIndex, fInfo
LinkInfo.Description = Left$(fInfo.Path, fInfo.Size)
lIndex = lIndex + fInfo.Size + 2
End If
If BitValue(3, LinkHeader.Flags) = True Then
Get #fNum, lIndex, fInfo
LinkInfo.RelativePath = Left$(fInfo.Path, fInfo.Size)
lIndex = lIndex + fInfo.Size + 2
End If
If BitValue(4, LinkHeader.Flags) = True Then
Get #fNum, lIndex, fInfo
LinkInfo.WorkingDirectory = Left$(fInfo.Path, fInfo.Size)
lIndex = lIndex + fInfo.Size + 2
End If
If BitValue(5, LinkHeader.Flags) = True Then
Get #fNum, lIndex, fInfo
LinkInfo.CommandLine = Left$(fInfo.Path, fInfo.Size)
lIndex = lIndex + fInfo.Size + 2
End If
If BitValue(6, LinkHeader.Flags) = True Then
Get #fNum, lIndex, fInfo
LinkInfo.IconFile = Left$(fInfo.Path, fInfo.Size)
lIndex = lIndex + fInfo.Size + 2
End If
Close #fNum
GetLinkInfo = LinkInfo
End Function
'-------------------------------------------------------------------------------

I tested it but i can't get the WorkingDirectory, CommandLine and IconFile information.

For some reason The info get's cloaked up after the Description info.

This is the testcode (Your code is stored in a module):

Option Explicit

Private Sub Form_Load()
Me.OLEDropMode = 1 ' manual
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, _
Shift As Integer, X As Single, Y As Single)

OLEDD Data
End Sub

Public Sub OLEDD(Data As DataObject)
Dim i As Integer, Filename As String
Dim sResult As String
sResult = vbCrLf & "Information found in the shortcut : " & vbCrLf & vbCrLf

If Data.GetFormat(vbCFFiles) Then
For i = 1 To Data.Files.Count
Filename = Data.Files.Item(i)

' do something with file
With GetLinkInfo(Filename)
sResult = sResult & "VolumeLabel = " & .VolumeLabel & vbCrLf
sResult = sResult & "NetShareName = " & .NetShareName & vbCrLf
sResult = sResult & "BasePath = " & .BasePath & vbCrLf
sResult = sResult & "RemainingPath = " & .RemainingPath & vbCrLf
sResult = sResult & "LastModified = " & .LastModified & vbCrLf
sResult = sResult & "Description = " & .Description & vbCrLf
sResult = sResult & "RelativePath = " & .RelativePath & vbCrLf
sResult = sResult & "WorkingDirectory = " & .WorkingDirectory & vbCrLf
sResult = sResult & "CommandLine = " & .CommandLine & vbCrLf
sResult = sResult & "IconFile = " & .IconFile
End With
MsgBox sResult
Next
End If
End Sub

Do you know why it stops after the description info?

Regards,

Paul

Ark

Private Function TrimNull(startstr As String) As String
Dim pos As Integer
pos = InStr(startstr, Chr$(0))
If pos Then
TrimNull = Left$(startstr, pos - 1)
Exit Function
End If
TrimNull = startstr
End Function

'....
sResult = sResult & "VolumeLabel = " & TrimNull(.VolumeLabel) & vbCrLf
'....
sResult = sResult & "Description = " & TrimNull(.Description) & vbCrLf
'....

Sector10

ASKER

Hi Ark,

I've added your function and tp test it i created a shortcut on my desktop.

General : Notepad
Target : %SystemRoot%\system32\notepad.exe
Start in : %HOMEDRIVE%%HOMEPATH%

Drag and dropped the shortcut to read its info and this was the result:

VolumeLabel = C:\WINDOWS\system32\notepad.exe
NetShareName =
BasePath = C:\WINDOWS\system32\notepad.exe
RemainingPath =
LastModified = 27-04-2005 14:43:35
Description =
RelativePath =
WorkingDirectory =
CommandLine =
IconFile =

I still can't retrieve the WorkingDirectory, CommandLine and or IconFile information...
I know that some programmers use Windows Scripting Host to retrieve the information, but i don't want to use it because of the possibility of a potential security risk.

So i hope that someone has the answer for me and can help me with this.

Regards,

Paul

Sector10

ASKER

This is the testcode with your function in it:

With GetLinkInfo(Filename)
Debug.Print "VolumeLabel = "; TrimNull(.VolumeLabel)
Debug.Print "NetShareName = "; .NetShareName
Debug.Print "BasePath = "; .BasePath
Debug.Print "RemainingPath = "; .RemainingPath
Debug.Print "LastModified = "; .LastModified
Debug.Print "Description = "; TrimNull(.Description)
Debug.Print "RelativePath = "; .RelativePath
Debug.Print "WorkingDirectory = "; .WorkingDirectory
Debug.Print "CommandLine = "; .CommandLine
Debug.Print "IconFile = " & .IconFile
End With

Hope it helps

ASKER CERTIFIED SOLUTION

Ark

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Sector10

ASKER

Hello ARK!

CLAPS, CLAPS!

If you could see me know, i am walking around with a big smile on my face.
This is more than i could hope for! It is really a great piece of coding.

It is because of guys like you that my knowledge of programming in visual basic is growing day after day, and i want to thank you for
helping me out on this one.

Regards to you all

Paul

Ark

Hello, Paul
Thanks for point, glad I could help you.
As for MCRIDER's code - I'm sure it works for Win9x OK. But he hardcoded offsets in his code, while NT use Unicode strings for Description, Working dir etc. In this case offsets are 2 times bigger. If you're interesting, you can find .lnk file description here http://www.i2s-lab.com/Papers/The_Windows_Shortcut_File_Format.pdf (though there is still old Win9x description stating that all string are ASCII format)