File "Shortcut.inc"
Path: /linkedit/Shortcut.inc
File size: 10.35 KB
MIME-type:
Charset: utf-8
'------------------------------------------------------------------------------------------------------------
' 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
'------------------------------------------------------------------------------------------------------------