PureBasic

Code : Tout sélectionner

Declare createShellLink(Application.s, LinkFileName.s, arg.s, desc.s, dir.s, icon.s, index)

'ProgName$ doit contenir le nom de votre application sans extension qui doit se trouveer dans le même dossier courant 
ProgName$="Myprog"  
ProgDesc$="Logiciel test"

Procedure createShellLink(Application.s, LinkFileName.s, arg.s, desc.s, dir.s, icon.s, index)
  Protected hRes.l, mem.s, ppf.IPersistFile
  CompilerIf #PB_Compiler_Unicode
    Protected psl.IShellLinkW
  CompilerElse
    Protected psl.IShellLinkA
  CompilerEndIf
  
  ;make shure COM is active
  CoInitialize_(0)
  hRes = CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @psl)
  
  If hRes = 0
    psl\SetPath(Application)
    psl\SetArguments(arg)
    psl\SetDescription(desc)
    psl\SetWorkingDirectory(dir)
    psl\SetIconLocation(icon, index)
    
    ;query IShellLink for the IPersistFile interface for saving the
    ;link in persistent storage
    hRes = psl\QueryInterface(?IID_IPersistFile, @ppf)
    
    If hRes = 0
      ;CompilerIf #PB_Compiler_Unicode
      ;save the link
      hRes = ppf\Save(LinkFileName, #True)
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  
  ;shut down COM
  CoUninitialize_()
  
  DataSection
    CLSID_ShellLink:
    Data.l $00021401
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    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
    IID_IPersistFile:
    Data.l $0000010b
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  EndDataSection
  ProcedureReturn hRes
EndProcedure

;-----------------------------------------------------------------------------
Procedure CreateIcone()
If createShellLink(Application, LinkFileName, "", LinkName, WorkDirectory, Application, 0) = 0
  errorfound=0
Else
  MessageRequester("Erreur","Le raccourci n'a pas pu être créé")
EndIf  
EndProcedure

i=Len(ProgName$)

;-----------------------------------------------------------------------------------
;Création du raccourci
Application = GetCurrentDirectory() + "\" + progname$+".exe"
WorkDirectory = GetPathPart(Application)
LinkFileName = GetHomeDirectory() + "desktop\" + progName$ +".lnk"
LinkName =ProgDesc$
CreateIcone()
MessageRequester("","Création raccourci terminé!")      
End