[VB6] Code Snippet: View shortcut path w/variables unexpanded: IShellLinkDataList

Shortcuts are actually far more complex than most people realize even after dealing with the IShellLink interface. The really technical bits are hidden behind a whole other interface: IShellLinkDataList.

Windows shortcuts and shortcuts placed by some programs allow the path to refer to a special location that might vary: for example, the Windows Media Player start menu shortcut on Windows 7 was actually created with a target of %ProgramFiles(x86)%\Windows Media Player\wmplayer.exe. Whether you click it, load its properties page, or call IShellLink's GetPath, the special Program Files reference will be expanded. But what if you want to see that original reference? Here I bring another article from the wonderful Old New Thing blog to VB6. As part of the code, you can also see all the SLDF_ flags associated with a link.

Requirements
-Windows XP or higher
-oleexp 3.51 or newer (released with this code on 9 May 2016; 3.5 will NOT work); oleexp3.tlb must be added under Project-References, but it's an IDE-only requirement- the typelib does not need to be distributed with the compiled EXE.

The Code

Code:

---

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub ShowLinkInfo(sLink As String)
'sLink must include .lnk suffix (hidden even when 'show extensions' is enabled)
'e.g. C:\folder\Shortcut to MyProgram.exe.lnk

Dim psdi As IShellLinkDataList
Dim pLNK As ShellLinkW
Dim ppf As IPersistFile
Set pLNK = New ShellLinkW
Set ppf = pLNK
ppf.Load sLink, STGM_READ
Set psdi = pLNK
Dim dwFlg As SHELL_LINK_DATA_FLAGS
psdi.GetFlags dwFlg
Debug.Print "flags=" & Hex$(dwFlg)

If (dwFlg And SLDF_HAS_EXP_SZ) Then
    Debug.Print "has exp_sz"
    Dim tEXP As EXP_SZ_LINK
    Dim ltPtr As Long
    psdi.CopyDataBlock EXP_SZ_LINK_SIG, ltPtr
    If ltPtr Then
        Debug.Print "got non-zero ptr"
        CopyMemory tEXP, ByVal ltPtr, LenB(tEXP)
       
        Debug.Print "struct size=" & tEXP.cbSize & ",sig=" & Hex$(tEXP.dwSignature)
        Debug.Print "str=" & WCHARtoSTR(tEXP.swzTarget)
    Else
        Debug.Print "no ptr to tEXP"
    End If
Else
    Debug.Print "no flag match"
End If
End Sub

Public Function WCHARtoSTR(aCh() As Integer) As String
Dim i As Long
Dim sz As String
For i = LBound(aCh) To UBound(aCh)
    If aCh(i) <> 0 Then
        sz = sz & ChrW(CLng(aCh(i)))
    End If
Next
WCHARtoSTR = sz
End Function

---

(Note: I tried copying directly into the struct by passing tEXP or trying ByVal VarPtr(tEXP); but both resulted in the value of the memory pointer being shoved into the .cbSize member.)

You can set flags and add/delete data blocks as well, look for a far more advanced demo of this interface in the future.

Don't forget to free the system-allocated copy of the data block structure! ;)

Code:

---

Option Explicit 'In a standard (.BAS) Module

Private Type EXP_SZ_LINK
    cbSize                      As Long
    dwSignature                As Long
    szTarget(0 To MAX_PATH - 1) As Byte
    swzTarget                  As String * MAX_PATH
End Type

Private Declare Function CallFunction Lib "user32.dll" Alias "CallWindowProcA" (ByVal pFunc As Long, ByVal pESL As Long, ByVal pStrOut As Long, Optional ByVal Reserved1 As Long, Optional ByVal Reserved2 As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

Public Function GetUnexpandedShortcutTarget(ByRef ShortcutPath As String) As String
    Dim Ptr As Long, oSLDL As IShellLinkDataList, oPF As IPersistFile

    Set oPF = New ShellLinkW
    oPF.Load ShortcutPath

    Set oSLDL = oPF

    If oSLDL.GetFlags And SLDF_HAS_EXP_SZ Then
        Ptr = oSLDL.CopyDataBlock(EXP_SZ_LINK_SIG)

        If Ptr Then
            CallFunction AddressOf DerefDataBlock, Ptr, VarPtr(GetUnexpandedShortcutTarget)

            Ptr = LocalFree(Ptr): Debug.Assert Ptr = 0&
        End If
    End If
End Function

Private Function DerefDataBlock(ByRef ESL As EXP_SZ_LINK, ByRef StrOut As String, Optional ByVal Reserved1 As Long, Optional ByVal Reserved2 As Long) As Long
    SysReAllocString VarPtr(StrOut), StrPtr(ESL.swzTarget)
End Function

---

If I was writing a modern reference book on VB6, I would have Bonnie audit all the code.