PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

CreateShellFileLink(), make shortcuts, ANSI and Unicode

https://www.purebasic.fr/english/viewtopic.php?t=24533

Page 1 of 1

CreateShellFileLink(), make shortcuts, ANSI and Unicode

Posted: Thu Nov 09, 2006 3:56 am
by Rescator
I know this exist already on the forums but nothing that was easily "slotted into" existing code nor did it work with unicode enabled.

The following works with Unicode enabled or disabled, and also work with EnableExplicit enabled or disabled.
Hopefully more tips and tricks code will be tested and made to work with those two compile options. (points a finger at the others) :)

Hopefully the code speaks for itself, it was based on Danilo's http://www.purebasic.fr/english/viewtopic.php?t=8668 code.
But made unicode "compatible" and EnableExplicit "compatible" and enhanced to make almost all arguments optional or have sensible defaults.
The link filename can be specified with or without ".lnk" at the end, the procedure will add it if missing.

Code: Select all

Procedure.l CreateShellFileLink(path$,link$,args$="",desc$="",workpath$="",showcommand.l=#SW_SHOWNORMAL,hotkey.l=#Null,icon$="",iconindex.l=0)
 Protected ppf.IPersistFile,hres.l,result.l
 CompilerIf #PB_Compiler_Unicode
  Protected psl.IShellLinkW
 CompilerElse
  Protected psl.IShellLinkA,mem.s
 CompilerEndIf
 If workpath$=""
  workpath$=GetPathPart(path$)
 EndIf
 If icon$=""
  icon$=path$
 EndIf
 If (LCase(Right(link$,4))<>".lnk")
  link$+".lnk"
 EndIf
 If CoInitialize_(#Null)=#S_OK
  If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl)=#S_OK
   Set_ShellLink_preferences:
   psl\SetPath(@path$)
   psl\SetArguments(@args$)
   psl\SetWorkingDirectory(@workpath$)
   psl\SetDescription(@desc$)
   psl\SetShowCmd(showcommand)
   psl\SetHotkey(hotkey)
   psl\SetIconLocation(@icon$,iconindex)
   If psl\QueryInterface(?IID_IPersistFile,@ppf)=#S_OK
    CompilerIf #PB_Compiler_Unicode
     hres=ppf\Save(@link$,#True)
    CompilerElse
     mem.s=Space(#MAX_PATH)
     MultiByteToWideChar_(#CP_ACP,#Null,link$,-1,mem,Len(mem))
     hres=ppf\Save(@mem,#True)
    CompilerEndIf
    result=1
    ppf\Release()
   EndIf
   psl\Release()
  EndIf
  CoUninitialize_()
 EndIf
 ProcedureReturn result
 DataSection
  IID_IShellLink:
   CompilerIf #PB_Compiler_Unicode
    Data.l $000214F9
   CompilerElse
    Data.l $000214EE
   CompilerEndIf
   Data.w $0000,$0000
   Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CLSID_ShellLink:
   Data.l $00021401
   Data.w $0000,$0000
   Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  IID_IPersistFile:
   Data.l $0000010b
   Data.w $0000,$0000
   Data.b $C0,$00,$00,$00,$00,$00,$00,$46
 EndDataSection
EndProcedure

CreateShellFileLink("c:\windows\system32\calc.exe","c:\test")

Posted: Mon Nov 27, 2006 11:50 am
by utopiomania
Thanks for the post. I've updated one procedure template I have that creates shell links, and will update at least one post in tips soon.

Posted: Mon Nov 27, 2006 2:23 pm
by Tranquil
Nice one! Thanks for this. Now make it thread save. :D

Posted: Mon Nov 27, 2006 4:37 pm
by Rescator
Thread safe, ugh. I guess one could slap some critical sections or mutexes on this. But I'm not that much of a thread safe guy (yet) so if anyone else want to please do so. This code is public domain after all :)

Posted: Sun Nov 25, 2007 1:09 am
by eJan

Code: Select all

Procedure.l CreateShellFileLink(path$,link$,args$="",desc$="",workpath$="",showcommand.l=#SW_SHOWNORMAL,hotkey.l=#Null,icon$="",iconindex.l=0)
  Protected ppf.IPersistFile,hres.l,result.l
  CompilerIf #PB_Compiler_Unicode
  Protected psl.IShellLinkW
  CompilerElse
  Protected psl.IShellLinkA,mem.s
  CompilerEndIf
  If workpath$=""
    workpath$=GetPathPart(path$)
  EndIf
  If icon$=""
    icon$=path$
  EndIf
  If (LCase(Right(link$,4))<>".lnk")
    link$+".lnk"
  EndIf
  CoInit=CoInitialize_(#Null)
  If CoInit = CoInit & 1
    If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl)=#S_OK
      Set_ShellLink_preferences:
      psl\SetPath(@path$)
      psl\SetArguments(@args$)
      psl\SetWorkingDirectory(@workpath$)
      psl\SetDescription(@desc$)
      psl\SetShowCmd(showcommand)
      psl\SetHotkey(hotkey)
      psl\SetIconLocation(@icon$,iconindex)
      If psl\QueryInterface(?IID_IPersistFile,@ppf)=#S_OK
        CompilerIf #PB_Compiler_Unicode
        hres=ppf\Save(@link$,#True)
        CompilerElse
        mem.s=Space(#MAX_PATH)
        MultiByteToWideChar_(#CP_ACP,#Null,link$,-1,mem,Len(mem))
        hres=ppf\Save(@mem,#True)
        CompilerEndIf
        If hres=#S_OK
          result=1
        EndIf
        ppf\Release()
      EndIf
      psl\Release()
    EndIf
    CoUninitialize_()
  EndIf
  ProcedureReturn result
  DataSection
    IID_IShellLink:
    CompilerIf #PB_Compiler_Unicode
    Data.l $000214F9
    CompilerElse
    Data.l $000214EE
    CompilerEndIf
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    CLSID_ShellLink:
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    IID_IPersistFile:
    Data.l $0000010b
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
EndProcedure

CreateShellFileLink("c:\windows\system32\calc.exe","c:\test")
EDIT: Corrected as ABBKlaus & nco2k suggested.

Posted: Sun Nov 25, 2007 12:23 pm
by ABBKlaus
Wouldn´t it be better to check wether CoInitialize was already called before :?:

Code: Select all

  CoInit=CoInitialize_(0)
  If CoInit=#S_OK Or CoInit=#S_FALSE
  ;#S_OK    : The COM library was initialized successfully on this thread.
  ;#S_FALSE : The COM library is already initialized on this thread.

Posted: Thu Jun 19, 2008 6:54 pm
by nco2k
you should only return #true, if the shortcut was really created. replace line 36 with this:

Code: Select all

If hres=#S_OK
  result=1
EndIf
and for a quick check if #true or #false, you can write line 18 like this:

Code: Select all

If CoInit = CoInit & 1
c ya,
nco2k

Re: CreateShellFileLink(), make shortcuts, ANSI and Unicode

Posted: Mon Jun 14, 2010 7:56 pm
by eJan
I need help here again, PB 4.50
I have errors 'a string is espected', please help.

Code: Select all

psl\SetPath(@path$)
psl\SetArguments(@args$)
psl\SetWorkingDirectory(@workpath$)
psl\SetDescription(@desc$)
psl\SetIconLocation(@icon$,iconindex)
hres=ppf\Save(@mem,#True)

Re: CreateShellFileLink(), make shortcuts, ANSI and Unicode

Posted: Mon Jun 14, 2010 10:13 pm
by rsts

Code: Select all

psl\SetPath(@path$)
psl\SetArguments(@args$)
psl\SetWorkingDirectory(@workpath$)
psl\SetDescription(@desc$)
psl\SetIconLocation(@icon$,iconindex)
hres=ppf\Save(@mem,#True)
to

Code: Select all

psl\SetPath(Str(@Path))
      psl\SetArguments(Str(@Argument))
      psl\SetWorkingDirectory(Str(@WorkingDir))
      psl\SetDescription(Str(@Description))
      psl\SetIconLocation(Str(@IconFile), IconIndex)
      hres = ppf\Save(Str(@mem),#True)
make the appropriate changes to the variables - e.g Argument to args$

cheers

Re: CreateShellFileLink(), make shortcuts, ANSI and Unicode

Posted: Mon Jun 14, 2010 10:20 pm
by ts-soft
Or use this version: http://www.purebasic.fr/german/viewtopi ... 48#p270648

Re: CreateShellFileLink(), make shortcuts, ANSI and Unicode

Posted: Wed Jun 16, 2010 6:01 pm
by eJan
@ rsts thanks, i still can't get it to work.
@ ts-soft instead i will use your version, thanks. :wink:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited