'------------------------------------------------------------------------------------------------------------ ' This is Shortcut.inc for PBWin9. Usage: ' DIM link as LINKTYPE ' link.zLinkFolder = PATHNAME$(PATH, COMMAND$) ' link.zLinkName = PATHNAME$(NAMEX, COMMAND$) ' ReadShortcut link ' all other information will be filled in ' DumpShortcut link ' shows shortcut fields in a msgbox ' ' link.zExeName = "new\path\to\exe" ' link.zArguments = "new arguments" ' link.zWorkDir = "new\working\directory" ' link.ShowFlag = %SW_SHOWNORMAL OR %SW_HIDE OR %SW_MAXIMIZE OR %SW_SHOWMINIMIZED ' link.zComment = "any comment (c) mougino 2025" ' link.zIconFile = "path\to\exe\or\dll\or\ico" ' link.IconIndex = 0 ' Icon index, zero based ' link.zHotKey = "A" ' Hotkey letter ' link.casHotKey = %HOTKEYF_SHIFT OR %HOTKEYF_CONTROL OR %HOTKEYF_ALT OR %HOTKEYF_EXT ' ' WriteShortcut link '------------------------------------------------------------------------------------------------------------ #INCLUDE ONCE "Win32Api.inc" '------------------------------------------------------------------------------------------------------------ TYPE LINKTYPE zlinkFolder AS ASCIIZ * %MAX_PATH ' Folder holding the .LNK file zlinkName AS ASCIIZ * %MAX_PATH ' Shortcut .LNK file name zExeName AS ASCIIZ * %MAX_PATH ' Target .exe path and name zArguments AS ASCIIZ * %MAX_PATH ' Arguments zWorkDir AS ASCIIZ * %MAX_PATH ' Working directory ShowFlag AS DWORD ' Show flag: %SW_SHOWNORMAL %SW_MAXIMIZE %SW_SHOWMINIMIZED zComment AS ASCIIZ * %MAX_PATH ' Comment zIconFile AS ASCIIZ * %MAX_PATH ' Icon path, $NUL for current .exe icon IconIndex AS DWORD ' Icon index, zero based zHotKey AS ASCIIZ * 2 ' Hotkey letter casHotKey AS WORD ' Hotkey Control, Alt and Shift state: %HOTKEYF_SHIFT %HOTKEYF_CONTROL %HOTKEYF_ALT %HOTKEYF_EXT END TYPE '------------------------------------------------------------------------------------------------------------ DECLARE FUNCTION IShelllink_Call0(BYVAL pUnk AS LONG) AS LONG DECLARE FUNCTION IShelllink_Call1(BYVAL pUnk AS LONG, BYVAL p1 AS LONG) AS LONG DECLARE FUNCTION IShelllink_Call2(BYVAL pUnk AS LONG, BYVAL p1 AS LONG, BYVAL p2 AS LONG) AS LONG DECLARE FUNCTION CoCreateInstance LIB "ole32.dll" ALIAS "CoCreateInstance" _ (rclsid AS GUIDAPI, pUnkOuter AS ANY, BYVAL dwClsContext AS DWORD, riid AS GUIDAPI, ppv AS DWORD) AS LONG DECLARE FUNCTION CoInitialize LIB "ole32.dll" ALIAS "CoInitialize" (pvReserved AS ANY) AS LONG DECLARE SUB CoUninitialize LIB "ole32.dll" ALIAS "CoUninitialize" () '------------------------------------------------------------------------------------------------------------ %HOTKEYF_SHIFT = 1 %HOTKEYF_CONTROL = 2 %HOTKEYF_ALT = 4 %HOTKEYF_EXT = 8 '------------------------------------------------------------------------------------------------------------ FUNCTION ReadShortcut(BYREF link AS LINKTYPE) AS LONG ' Needed to read a shortcut are: link.zlinkFolder + link.zlinkName LINKQUERY(link) ' All other information will be filled in END FUNCTION '------------------------------------------------------------------------------------------------------------ SUB DumpShortcut(BYREF link AS LINKTYPE) ReadShortcut(link) ? "link folder :" & $TAB & link.zlinkFolder + $CR + _ "link name :" & $TAB & link.zlinkName + $CR + _ "Exe name :" & $TAB & link.zExeName + $CR + _ "Arguments :" & $TAB & link.zArguments + $CR + _ "Working folder :" & $TAB & link.zWorkDir + $CR + _ "Show flag :" & $TAB & CHOOSE$(link.ShowFlag, _ "Normal", "Minimize", "Maximize", "NoActivate", "Show", _ "Minimize", "MinNoActivate", "ShowNa", "Restore", "Default", _ "ForceMinimize") & " (" & FORMAT$(link.ShowFlag) & ")" + $CR + _ "Comment :" & $TAB & link.zComment + $CR + _ "Icon file :" & $TAB & $TAB & link.zIconFile + $CR + _ "Icon index :" & $TAB & FORMAT$(link.IconIndex) + $CR + _ "Hotkey :" & $TAB & $TAB & _ IIF$((link.casHotKey AND %HOTKEYF_SHIFT) , "Shift " , "") & _ IIF$((link.casHotKey AND %HOTKEYF_CONTROL), "Control ", "") & _ IIF$((link.casHotKey AND %HOTKEYF_ALT) , "Alt " , "") & _ IIF$((link.casHotKey AND %HOTKEYF_EXT) , "Ext " , "") & _ link.zHotKey, %MB_ICONINFORMATION, EXE.NAME$ END SUB '------------------------------------------------------------------------------------------------------------ FUNCTION WriteShortcut(BYVAL link AS LINKTYPE) AS LONG LOCAL CLSID_ShellLink AS STRING * 16 LOCAL IID_IShellLink AS STRING * 16 LOCAL IID_Persist AS STRING * 16 LOCAL pShellLnk AS DWORD PTR LOCAL pPersist AS DWORD PTR LOCAL sTargetLinkName AS STRING LOCAL sSourceFileName AS STRING LOCAL sArguments AS STRING LOCAL sWorkDir AS STRING LOCAL nShowCmd AS DWORD LOCAL sIconFile AS STRING LOCAL nIconIndex AS DWORD LOCAL sComment AS STRING LOCAL nResult AS LONG sTargetLinkName = RTRIM$(link.zlinkFolder, "\") + "\" + link.zlinkName sSourceFileName = link.zExeName sArguments = link.zArguments sWorkDir = link.zWorkDir nShowCmd = link.ShowFlag sComment = link.zComment sIconFile = link.zIconFile nIconIndex = link.IconIndex ' IShellLink interface ' IID = 000214EE-0000-0000-C000-000000000046 ' Inherited interface = IUnknown CLSID_ShellLink = MKL$(&H00021401) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46) IID_IShellLink = MKL$(&H000214EE) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46) IID_Persist = MKL$(&H0000010B) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46) sTargetLinkName = UCODE$(sTargetLinkName) CALL CoInitialize(BYVAL 0&) IF CoCreateInstance(BYVAL VARPTR(CLSID_ShellLink), BYVAL 0&, 1, BYVAL VARPTR(IID_IShellLink), pShellLnk) = 0 THEN ' IShellLink::SetPath CALL DWORD @@pShellLnk[20] USING IShellLink_Call1(pShellLnk, STRPTR(sSourceFileName)) ' IShellLink::SetsArguments CALL DWORD @@pShellLnk[11] USING IShellLink_Call1(pShellLnk, STRPTR(sArguments)) ' IShellLink::SetWorkingDirectory CALL DWORD @@pShellLnk[9] USING IShellLink_Call1(pShellLnk, STRPTR(sWorkDir)) ' IShellLink::SetnShowCmd CALL DWORD @@pShellLnk[15] USING IShellLink_Call1(pShellLnk, nShowCmd) ' IShellLink::SetDescription CALL DWORD @@pShellLnk[7] USING IShellLink_Call1(pShellLnk, STRPTR(sComment)) ' Obtain persist interface (QueryInterface) CALL DWORD @@pShellLnk[0] USING IShellLink_Call2(pShellLnk, VARPTR(IID_Persist), VARPTR(pPersist)) ' IShellLink::SetIconLocation CALL DWORD @@pShellLnk[17] USING IShellLink_Call2(pShellLnk, STRPTR(sIconFile), nIconIndex) IF nResult = 0 THEN ' Convert to unicode ' IPersistFile::Save CALL DWORD @@pPersist[6] USING IShellLink_Call2(pPersist, STRPTR(sTargetLinkName), 1) ' Release CALL DWORD @@pPersist[2] USING IShellLink_Call0(pPersist) END IF ' Release CALL DWORD @@pShellLnk[2] USING IShellLink_Call0(pShellLnk) FUNCTION = -1 END IF CALL CoUninitialize() END FUNCTION '------------------------------------------------------------------------------------------------------------ DECLARE FUNCTION F1(P1 AS ANY) AS DWORD DECLARE FUNCTION F2(P1 AS ANY, P2 AS ANY) AS DWORD DECLARE FUNCTION F3(P1 AS ANY, P2 AS ANY, P3 AS ANY) AS DWORD DECLARE FUNCTION F4(P1 AS ANY, P2 AS ANY, P3 AS ANY, P4 AS ANY) AS DWORD DECLARE FUNCTION F5(P1 AS ANY, P2 AS ANY, P3 AS ANY, P4 AS ANY, P5 AS ANY) AS DWORD '------------------------------------------------------------------------------------------------------------ FUNCTION LINKQUERY(BYREF link AS LINKTYPE)AS LONG LOCAL IID_Persist AS GUID LOCAL CLSID_Shelllink AS GUID LOCAL IID_IShelllink AS GUID LOCAL FileData AS WIN32_FIND_DATA LOCAL zBuffer AS ASCIIZ * %MAX_PATH LOCAL zBufferWide AS ASCIIZ * %MAX_PATH * 2 LOCAL PP AS DWORD POINTER LOCAL PPF AS DWORD POINTER LOCAL PSL AS DWORD POINTER LOCAL Flags AS DWORD LOCAL HotKey AS DWORD LOCAL Retval AS LONG CLSID_Shelllink = CHR$(001, 20, 2, 0, 0, 0, 0, 0, 192, 0, 0, 0, 0, 0, 0, 70) IID_IShelllink = CHR$(238, 20, 2, 0, 0, 0, 0, 0, 192, 0, 0, 0, 0, 0, 0, 70) IID_Persist = CHR$(011, 01, 0, 0, 0, 0, 0, 0, 192, 0, 0, 0, 0, 0, 0, 70) IF CoCreateInstance(CLSID_Shelllink, BYVAL %Null, 1, IID_IShelllink, PSL) = %S_OK THEN PP = @PSL : CALL DWORD @PP USING F3(BYVAL PSL, IID_Persist, PPF) TO Retval zBuffer = link.zlinkFolder & link.zlinkName Retval = MultiByteToWideChar(%CP_ACP, 0, zBuffer, -1, BYVAL VARPTR(zBufferWide), (%MAX_PATH * 2)) PP = @PPF + 20 : CALL DWORD @PP USING F3(BYVAL PPF, zBufferWide, BYVAL %True) ' SetIDList PP = @PSL + 12 : CALL DWORD @PP USING F5(BYVAL PSL, link.zExeName, BYVAL %MAX_PATH, FileData, Flags) ' Get Path & zExeName IF LEN(link.zExeName) THEN FUNCTION = %TRUE PP = @PSL + 24 : CALL DWORD @PP USING F5(BYVAL PSL, link.zComment, BYVAL %MAX_PATH, FileData, Flags) ' Comment PP = @PSL + 32 : CALL DWORD @PP USING F5(BYVAL PSL, link.zWorkDir, BYVAL %MAX_PATH, FileData, Flags) ' WorkDir PP = @PSL + 40 : CALL DWORD @PP USING F5(BYVAL PSL, link.zArguments, BYVAL %MAX_PATH, FileData, Flags) ' Argument PP = @PSL + 48 : CALL DWORD @PP USING F2(BYVAL PSL, Hotkey) ' HotKey: %HOTKEYF_SHIFT=1 HOTKEYF_CONTROL=2 %HOTKEYF_ALT=4 % %HOTKEYF_EXT=8 link.zHotKey = CHR$(LO(WORD, Hotkey)) link.casHotKey = HI(BYTE, Hotkey) PP = @PSL + 56 : CALL DWORD @PP USING F2(BYVAL PSL, link.ShowFlag) ' Show Normal-Maximize-Minimize PP = @PSL + 64 : CALL DWORD @PP USING F4(BYVAL PSL, link.zIconFile, BYVAL %MAX_PATH, link.IconIndex) 'External icon file and index END IF PP = @PPF + 8: CALL DWORD @PP USING F1( BYVAL PPF ) ' Release the persistant file PP = @PSL + 8: CALL DWORD @PP USING F1( BYVAL PSL ) ' Unbind the shell link object from the persistent file END IF END FUNCTION '------------------------------------------------------------------------------------------------------------