Créer un raccourci

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

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)