Fonctionnel sous Linux & Windows (Unicode & Ascii).
Manque plus que la version MacOs.
Code : Tout sélectionner
Structure S_Shortcut
sFilename.s
sShortcutFile.s
sWorkingDir.s
sIconPath.s
iIconIndex.l
sDescription.s
sArgs.s
wHotkey.w
iShowCmd.l
EndStructure
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows ;{
;@author : Rescator <http://www.purebasic.fr/english/viewtopic.php?t=24533>
;@author : Progi1984 ; modified for multiplateform
ProcedureDLL.l CreateShortcut(*shortcuts_infos.S_Shortcut)
Protected ppf.IPersistFile
Protected lResult.l
CompilerIf #PB_Compiler_Unicode
Protected psl.IShellLinkW
CompilerElse
Protected psl.IShellLinkA, sMemUnicode.s
CompilerEndIf
Protected lnk_infos.S_Shortcut
CopyMemory(*shortcuts_infos, @lnk_infos, SizeOf(S_Shortcut))
If (LCase(Right(lnk_infos\sShortcutFile,4))<>".lnk")
lnk_infos\sShortcutFile+".lnk"
EndIf
If lnk_infos\sWorkingDir = ""
lnk_infos\sWorkingDir = GetPathPart(lnk_infos\sFilename)
EndIf
If lnk_infos\sIconPath = ""
lnk_infos\sIconPath = lnk_infos\sFilename
lnk_infos\iIconIndex = 0
EndIf
If lnk_infos\iShowCmd = 0
lnk_infos\iShowCmd = #SW_SHOWNORMAL
EndIf
If CoInitialize_(#Null) = #S_OK
If CoCreateInstance_(?CLSID_ShellLink, 0, 1,?IID_IShellLink, @psl) = #S_OK
psl\SetArguments(@lnk_infos\sArgs)
psl\SetDescription(@lnk_infos\sDescription)
psl\SetHotkey(lnk_infos\wHotkey)
psl\SetIconLocation(@lnk_infos\sIconPath, lnk_infos\iIconIndex)
psl\SetPath(@lnk_infos\sFilename)
psl\SetShowCmd(@lnk_infos\iShowCmd)
psl\SetWorkingDirectory(@lnk_infos\sWorkingDir)
If psl\QueryInterface(?IID_IPersistFile,@ppf)=#S_OK
CompilerIf #PB_Compiler_Unicode
ppf\Save(@link$,#True)
CompilerElse
sMemUnicode = Space(#MAX_PATH)
MultiByteToWideChar_(#CP_ACP, #Null, lnk_infos\sShortcutFile, -1, sMemUnicode, Len(sMemUnicode))
ppf\Save(@sMemUnicode,#True)
CompilerEndIf
result = #True
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
;}
CompilerCase #PB_OS_Linux;{
;@author : Progi1984
;@doc : http://standards.freedesktop.org/desktop-entry-spec/latest/
ProcedureDLL.l CreateShortcut(*shortcuts_infos.S_Shortcut)
Protected lnk_infos.S_Shortcut
Protected lFile.l, bType.b
CopyMemory(*shortcuts_infos, @lnk_infos, SizeOf(S_Shortcut))
lFile = CreateFile(#PB_Any, lnk_infos\sShortcutFile)
If lFile
If Right(lnk_infos\sFilename, 1) = "/"
bType=3
ElseIf FindString(lnk_infos\sFilename, "://",1) > 0
bType=2
Else
bType=1
EndIf
WriteStringN(lFile, "[Desktop Entry]", #PB_UTF8)
WriteStringN(lFile, "Version=1.0", #PB_UTF8)
; Desktop entry type
Select bType
Case 1 : WriteStringN(lFile, "Type=Application", #PB_UTF8)
Case 2 : WriteStringN(lFile, "Type=Link", #PB_UTF8)
Case 3 : WriteStringN(lFile, "Type=Directory", #PB_UTF8)
EndSelect
WriteStringN(lFile, "Name="+StringField(GetFilePart(lnk_infos\sShortcutFile),1,"."), #PB_UTF8)
If lnk_infos\sDescription <> ""
WriteStringN(lFile, "Comment="+lnk_infos\sDescription, #PB_UTF8)
EndIf
If lnk_infos\sIconPath <> ""
WriteStringN(lFile, "Icon="+lnk_infos\sIconPath, #PB_UTF8)
EndIf
If lnk_infos\sWorkingDir <> ""
WriteStringN(lFile, "Path="+lnk_infos\sWorkingDir, #PB_UTF8)
EndIf
Select bType
Case 1
WriteStringN(lFile, "TryExec="+lnk_infos\sFilename, #PB_UTF8)
WriteStringN(lFile, "Exec="+lnk_infos\sFilename+" "+lnk_infos\sArgs, #PB_UTF8)
Case 2
WriteStringN(lFile, "URL="+lnk_infos\sFilename, #PB_UTF8)
EndSelect
CloseFile(lFile)
EndIf
EndProcedure
;}
CompilerEndSelect
Define.S_Shortcut filelink
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows ;{
filelink\sFilename = "c:\windows\system32\calc.exe"
filelink\sShortcutFile = "C:\Documents And Settings\flefevre\Bureau\Calculatrice.lnk"
;}
CompilerCase #PB_OS_Linux ;{
filelink\sFilename = "gedit"
filelink\sShortcutFile = "/home/franklin/Bureau/mygedit.desktop"
;}
CompilerEndSelect
CreateShortcut(@filelink)
