dcsimg
Results 1 to 3 of 3

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

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,351

    [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

  2. #2
    Lively Member
    Join Date
    Feb 2015
    Location
    Colorado USA
    Posts
    106

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

    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.

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,351

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

    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width