Code: Select all
;
; create shell links/shortcuts
; translated from my old example that used CallCOM()
;
; by Danilo, 09.12.2003
;
; requires PB 3.81+
;
Procedure CreateShellLink(PATH$, LINK$, Argument$, DESCRIPTION$, WorkingDirectory$, ShowCommand.l, HotKey.l, IconFile$, IconIndexInFile.l)
Protected *psl.IShellLinkA, *ppf.IPersistFile, hres, result
If Not (PATH$ <> "" And LINK$ <> "" And ShowCommand >= 0 And IconIndexInFile >= 0)
ProcedureReturn 0 ;missing or incorrect arguments
EndIf
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@*psl.IShellLinkA) = 0
Set_ShellLink_preferences:
; The file TO which is linked ( = target for the Link )
;
*psl\SetPath(PATH$)
; Arguments for the Target
;
*psl\SetArguments(Argument$)
; Working Directory
;
*psl\SetWorkingDirectory(WorkingDirectory$)
; Description ( also used as Tooltip for the Link )
;
*psl\SetDescription(DESCRIPTION$)
; Show command:
; SW_SHOWNORMAL = Default
; SW_SHOWMAXIMIZED = aehmm... Maximized
; SW_SHOWMINIMIZED = play Unreal Tournament
*psl\SetShowCmd(ShowCommand)
; Hotkey:
; The virtual key code is in the low-order byte,
; and the modifier flags are in the high-order byte.
; The modifier flags can be a combination of the following values:
;
; HOTKEYF_ALT = ALT key
; HOTKEYF_CONTROL = CTRL key
; HOTKEYF_EXT = Extended key
; HOTKEYF_SHIFT = SHIFT key
;
*psl\SetHotkey(HotKey)
; Set Icon for the Link:
; There can be more than 1 icons in an icon resource file,
; so you have to specify the index.
;
*psl\SetIconLocation(IconFile$, IconIndexInFile)
ShellLink_SAVE:
; Query IShellLink For the IPersistFile interface For saving the
; shortcut in persistent storage.
If *psl\QueryInterface(?IID_IPersistFile,@*ppf.IPersistFile) = 0
;Save the link by calling IPersistFile::Save.
hres = *ppf\Save(LINK$, #True)
result = 1
*ppf\Release()
Else
Debug blah
EndIf
*psl\Release()
EndIf
CoUninitialize_()
ProcedureReturn result
DataSection
CLSID_ShellLink:
; 00021401-0000-0000-C000-000000000046
Data.l $00021401
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IShellLink:
; DEFINE_SHLGUID(IID_IShellLinkA, 0x000214EEL, 0, 0);
; C000-000000000046
Data.l $000214EE
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IPersistFile:
; 0000010b-0000-0000-C000-000000000046
Data.l $0000010b
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
EndProcedure
; CreateLink
; - TARGET$ for the Link ("c:\PureBasic\purebasic.exe")
; - LINK$ - name of the Link ("c:\pb.lnk")
; - Argument$ for the target ("%1")
; - Description$ = Description and Tooltip ("Start PureBasic")
; - Working Directory ("c:\PureBasic\")
; - Show command: #SW_SHOWNORMAL or #SW_SHOWMAXIMIZED or #SW_SHOWMINIMIZED
; - HotKey - no need to use this :)
; - IconFile + Index ( "c:\PureBasic\purebasic.exe" , 1 )
If CreateShellLink("D:\BASIC\PureBasic\purebasic.exe","c:\PB.lnk","","Pure FUN","D:\BASIC\PureBasic\",#SW_SHOWMAXIMIZED,0,"%SystemRoot%\system32\SHELL32.dll",12)
Beep_(800,100)
EndIf
Define WinDir$
WinDir$ = Space(100): GetSystemDirectory_(WinDir$,100)
If CreateShellLink(WinDir$+"\calc.exe","c:\CALC.lnk","","Calculator","",0,0,"%SystemRoot%\system32\SHELL32.dll",23)
Beep_(800,100)
EndIf
It will crash with PB 3.80 because there was a bug with Interfaces
in Procedures.