CreateShellFileLink(), make shortcuts, ANSI and Unicode

[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")

[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.

[Tranquil]

Nice one! Thanks for this. Now make it thread save.

[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

[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.

[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.

[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

[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)

[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

[ts-soft]

Or use this version: http://www.purebasic.fr/german/viewtopi ... 48#p270648

[eJan]

@ rsts thanks, i still can't get it to work.
@ ts-soft instead i will use your version, thanks.