[VB6] Code Snippet: Make your shortcuts request elevation with IShellLinkDataList

This is related to my other recent post on this interface, [VB6] Code Snippet: View shortcut path w/variables unexpanded: IShellLinkDataList.

Making shortcuts to your program for Run As Administrator requires diving into the highly technical IShellLinkDataList, which is implemented by shortcut objects in addition to the IShellLink interface that is usually all you need. But shortcuts have many advanced flags and data blocks that aren't exposed by IShellLink-- look for more uses of this interface in the future.

Requirements
-Windows XP or higher
-oleexp 3.51 or newer (released with this code on 9 May 2016; 3.5 will NOT work); oleexp 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
It's a bit easier this time:

Code:

---

Public Sub MakeLinkElevated(sLink As String)

'sLink must include .lnk suffix (hidden even when 'show extensions' is enabled)
'e.g. C:\folder\Shortcut to MyProgram.exe.lnk
On Error GoTo e0
Dim psdi As IShellLinkDataList
Dim pLNK As ShellLinkW
Dim ppf As IPersistFile
Set pLNK = New ShellLinkW
Set ppf = pLNK
ppf.Load sLink, STGM_READWRITE
Set psdi = pLNK
Dim dwFlg As SHELL_LINK_DATA_FLAGS
psdi.GetFlags dwFlg
Debug.Print "flags=" & Hex$(dwFlg)

If (dwFlg And SLDF_RUNAS_USER) Then
    Debug.Print "Already elevated."
Else
    Debug.Print "Setting flag..."
    dwFlg = dwFlg Or SLDF_RUNAS_USER
    psdi.SetFlags dwFlg
    ppf.Save sLink, 1
End If
Exit Sub
e0:
Debug.Print "MakeLinkElevated.Error->" & Err.Description
End Sub

---

I know this is a year and a half old but I have a question about oleexp.tlb. I am using your newest version (4.43) and I was working on some code to make shortcuts. I am trying to use Unicode and I have tried Shell32.dll and wshom.ocx and neither one appears to support unicode.. Your post above uses ShellLinkW and I am presuming the "W" on the end means unicode. That's good but the is no ShellLinkA although there is an IShellLinkA that seems to have the same parameters. Am I correct in guessing that IShellLinkA is stuck with that name for backwards compaibility but that ShellLinkW is the one we should use if we want unicode link calls. Is this correct? Thanks.

Correct IShellLinkA is not included in the coclass by default; but there is no different default implementation, so you could create a ShellLinkW object but set it to IShellLinkA if you needed to for some reason. CLSID_ShellLink - the ShellLinkW object - actually covers them both; I should have just called ShellLink and added A to it...
For full reference, oleexp has:
interface IShellLinkA
interface IShellLinkW
coclass ShellLinkW with IShellLinkW as the only listed interface [but actually supports IShellLinkA as well]-- CLSID_ShellLink

---

If you're making a link, this supports unicode (in the filename and link name):

Code:

---

Public Sub CreateLink(sSrc As String, sDest As String)
Dim isl As ShellLinkW
Dim ipf As oleexp.IPersistFile

Set isl = New ShellLinkW
Set ipf = isl
With isl
    .SetPath sSrc
    .SetShowCmd SW_NORMAL
    .Resolve 0, 4
End With

ipf.Save sDest, 0

Set ipf = Nothing
Set isl = Nothing

End Sub

---

eg CreateLink "C:\d1\test.txt", "C:\d2\test.txt.lnk"
I tested it by picking a file through a dialog.. where d1 contained a file with unicode chars (H❷m❷❸ v.png) and d2 already existed

Code:

---

Dim si As IShellItem
Dim fod As FileOpenDialog
Dim lp As Long
Dim s1 As String, s2 As String
Set fod = New FileOpenDialog
fod.Show Me.hWnd
fod.GetResult si
si.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lp
s1 = LPWSTRtoStr(lp)
s2 = Replace$(s1, "d1", "d2") & ".lnk"
'MessageBoxW Me.hWnd, StrPtr(s1 & vbCrLf & s2), StrPtr(App.Title), 0& 'if you want to confirm names and paths
CreateLink s1, s2

---