PureBoard

Code: Alles auswählen

#CSIDL_STARTUP   =  7

Structure EMID
  cb.b
  abID.b[1]
EndStructure

Structure ITEMIDLIST
  mkid.EMID
EndStructure

Procedure.s myGetSpecialeFolder(Folder.l)
  *itemid.ITEMIDLIST = #Null
  If SHGetSpecialFolderLocation_ (0, Folder, @*itemid) = #NOERROR
    location.s = Space (#MAX_PATH)
    If SHGetPathFromIDList_ (*itemid, @location)
      If Right(location, 1) <> "\" : location + "\" : EndIf
      ProcedureReturn location
    EndIf
  EndIf
EndProcedure

Procedure myCreateShortcut(Path.s, Link.s, WorkingDir.s, Argument.s, IconFile.s, IconIndex.l)
  ShowCommand = #SW_SHOWNORMAL
  Description.s = ""
  HotKey = #Null
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl.IShellLinkA) = 0
    Set_ShellLink_preferences:
    psl\SetPath(@Path)
    psl\SetArguments(@Argument)
    psl\SetWorkingDirectory(@WorkingDir)
    psl\SetDescription(@Description)
    psl\SetShowCmd(ShowCommand)
    psl\SetHotkey(HotKey)
    psl\SetIconLocation(@IconFile, IconIndex)
    ShellLink_SAVE:
    If psl\QueryInterface(?IID_IPersistFile,@ppf.IPersistFile) = 0
      mem.s = Space(1000)
      MultiByteToWideChar_(#CP_ACP, 0, Link, -1, mem, 1000)
      hres = ppf\Save(@mem,#True)
      Result = 1
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn Result
  DataSection
  CLSID_ShellLink:
  Data.l $00021401
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  IID_IShellLink:
  Data.l $000214EE
  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

Procedure.s GetFullPath()
  FullPath.s = Space(#MAX_PATH)
  GetModuleFileName_(GetModuleHandle_(0), @FullPath, #MAX_PATH)
  FullPath = GetPathPart(FullPath)
  If Right(FullPath, 1) <> "\"
    FullPath = FullPath + "\"
  EndIf
  ProcedureReturn FullPath
EndProcedure

MeinProgramm.s = "Tolles Programm" ; Programmname ohne Extension
myCreateShortcut(GetFullPath() + MeinProgramm.s + ".exe", myGetSpecialeFolder(#CSIDL_STARTUP) + "\" + MeinProgramm.s + ".lnk", "", "",GetFullPath() + MeinProgramm.s, 0)