|
| 1 | +// IShellLink descriptions code came from https://github.com/jrsoftware/issrc/blob/master/Examples/CodeAutomation2.iss |
| 2 | + |
| 3 | +// procedure CreateShortcut(AtPath: string; ToPath: string; RunAsAdministrator: boolean); |
| 4 | + |
| 5 | +const |
| 6 | + CLSID_ShellLink = '{00021401-0000-0000-C000-000000000046}'; |
| 7 | + |
| 8 | +const |
| 9 | + // IShellLinkDataList::GetFlags()/SetFlags() |
| 10 | + SLDF_HAS_ID_LIST = $00000001; // Shell link saved with ID list |
| 11 | + SLDF_HAS_LINK_INFO = $00000002; // Shell link saved with LinkInfo |
| 12 | + SLDF_HAS_NAME = $00000004; |
| 13 | + SLDF_HAS_RELPATH = $00000008; |
| 14 | + SLDF_HAS_WORKINGDIR = $00000010; |
| 15 | + SLDF_HAS_ARGS = $00000020; |
| 16 | + SLDF_HAS_ICONLOCATION = $00000040; |
| 17 | + SLDF_UNICODE = $00000080; // the strings are unicode |
| 18 | + SLDF_FORCE_NO_LINKINFO = $00000100; // don't create a LINKINFO (make a dumb link) |
| 19 | + SLDF_HAS_EXP_SZ = $00000200; // the link contains expandable env strings |
| 20 | + SLDF_RUN_IN_SEPARATE = $00000400; // Run the 16-bit target exe in a separate VDM/WOW |
| 21 | + SLDF_HAS_LOGO3ID = $00000800; // this link is a special Logo3/MSICD link |
| 22 | + SLDF_HAS_DARWINID = $00001000; // this link is a special Darwin link |
| 23 | + SLDF_RUNAS_USER = $00002000; // Run this link as a different user |
| 24 | + SLDF_HAS_EXP_ICON_SZ = $00004000; // contains expandable env string for icon path |
| 25 | + SLDF_NO_PIDL_ALIAS = $00008000; // don't ever resolve to a logical location |
| 26 | + SLDF_FORCE_UNCNAME = $00010000; // make GetPath() prefer the UNC name to the local name |
| 27 | + SLDF_RUN_WITH_SHIMLAYER = $00020000; // Launch the target of this link w/ shim layer active |
| 28 | + SLDF_RESERVED = $80000000; // Reserved-- so we can use the low word as an index value in the future |
| 29 | + |
| 30 | +type |
| 31 | + IShellLinkW = interface(IUnknown) |
| 32 | + '{000214F9-0000-0000-C000-000000000046}' |
| 33 | + procedure Dummy; |
| 34 | + procedure Dummy2; |
| 35 | + procedure Dummy3; |
| 36 | + function GetDescription(pszName: String; cchMaxName: Integer): HResult; |
| 37 | + function SetDescription(pszName: String): HResult; |
| 38 | + function GetWorkingDirectory(pszDir: String; cchMaxPath: Integer): HResult; |
| 39 | + function SetWorkingDirectory(pszDir: String): HResult; |
| 40 | + function GetArguments(pszArgs: String; cchMaxPath: Integer): HResult; |
| 41 | + function SetArguments(pszArgs: String): HResult; |
| 42 | + function GetHotkey(var pwHotkey: Word): HResult; |
| 43 | + function SetHotkey(wHotkey: Word): HResult; |
| 44 | + function GetShowCmd(out piShowCmd: Integer): HResult; |
| 45 | + function SetShowCmd(iShowCmd: Integer): HResult; |
| 46 | + function GetIconLocation(pszIconPath: String; cchIconPath: Integer; out piIcon: Integer): HResult; |
| 47 | + function SetIconLocation(pszIconPath: String; iIcon: Integer): HResult; |
| 48 | + function SetRelativePath(pszPathRel: String; dwReserved: DWORD): HResult; |
| 49 | + function Resolve(Wnd: HWND; fFlags: DWORD): HResult; |
| 50 | + function SetPath(pszFile: String): HResult; |
| 51 | + end; |
| 52 | + |
| 53 | + IShellLinkDataList = interface(IUnknown) |
| 54 | + '{45E2B4AE-B1C3-11D0-B92F-00A0C90312E1}' |
| 55 | + function AddDataBlock(pDataBlock: cardinal): HResult; |
| 56 | + function CopyDataBlock(dwSig: DWORD; var ppDataBlock: cardinal): HResult; |
| 57 | + function RemoveDataBlock(dwSig: DWORD): HResult; |
| 58 | + function GetFlags(var pdwFlags: DWORD): HResult; |
| 59 | + function SetFlags(dwFlags: DWORD): HResult; |
| 60 | + end; |
| 61 | + |
| 62 | + IPersist = interface(IUnknown) |
| 63 | + '{0000010C-0000-0000-C000-000000000046}' |
| 64 | + function GetClassID(var classID: TGUID): HResult; |
| 65 | + end; |
| 66 | + |
| 67 | + IPersistFile = interface(IPersist) |
| 68 | + '{0000010B-0000-0000-C000-000000000046}' |
| 69 | + function IsDirty: HResult; |
| 70 | + function Load(pszFileName: String; dwMode: Longint): HResult; |
| 71 | + function Save(pszFileName: String; fRemember: BOOL): HResult; |
| 72 | + function SaveCompleted(pszFileName: String): HResult; |
| 73 | + function GetCurFile(out pszFileName: String): HResult; |
| 74 | + end; |
| 75 | + |
| 76 | +procedure CreateShortcut(AtPath, ToPath, IconPath, WorkingDirectoryPath: string; RunAsAdministrator: boolean); |
| 77 | +var |
| 78 | + Obj: IUnknown; |
| 79 | + SL: IShellLinkW; |
| 80 | + PF: IPersistFile; |
| 81 | + DL: IShellLinkDataList; |
| 82 | + Flags: DWORD; |
| 83 | +begin |
| 84 | + Obj := CreateComObject(StringToGuid(CLSID_ShellLink)); |
| 85 | + |
| 86 | + SL := IShellLinkW(Obj); |
| 87 | + OleCheck(SL.SetPath(ToPath)); |
| 88 | + OleCheck(SL.SetWorkingDirectory(WorkingDirectoryPath)); |
| 89 | + OleCheck(Sl.SetIconLocation(IconPath, 0)); |
| 90 | + |
| 91 | + if RunAsAdministrator then |
| 92 | + begin |
| 93 | + DL := IShellLinkDataList(Obj); |
| 94 | + OleCheck(DL.GetFlags(Flags)); |
| 95 | + OleCheck(Dl.SetFlags(Flags or SLDF_RUNAS_USER)); |
| 96 | + end; |
| 97 | + |
| 98 | + PF := IPersistFile(Obj); |
| 99 | + OleCheck(PF.Save(AtPath, True)); |
| 100 | +end; |
0 commit comments