PureBoard

Code: Alles auswählen

;
; Anim Player Installer
;


EnableExplicit

Global ExeName.s = "AnimPlayer.exe" , TargetPfad.s = "AnimPlayer"

Declare createShellLink(obj.s, lnk.s, arg.s, desc.s, dir.s, icon.s, index)
Declare.s getSpecialFolder(id)
Declare SetUninstall(keyname$, GUID$, name$,  pub$, url$, email$, dicon$, uexe$) 

Procedure.s SpecialFolderLocation(csidl.l)
   Protected location.s,pidl.l
   If SHGetSpecialFolderLocation_(#Null,csidl,@pidl)=#ERROR_SUCCESS
      location.s=Space(#MAX_PATH)
      If SHGetPathFromIDList_(pidl,@location.s)
         If Right(location.s,1)<>""
            location.s+""
         EndIf
      EndIf
      If pidl
         CoTaskMemFree_(pidl) ; Instead of messing with com imalloc free and whatnot.
      EndIf
   EndIf
   ProcedureReturn Trim(location.s)
 EndProcedure
Procedure.s getSpecialFolder(id)
  Protected path.s, *ItemId.ITEMIDLIST
 
  *itemId = #Null
  If SHGetSpecialFolderLocation_(0, id, @*ItemId) = #NOERROR
    path = Space(#MAX_PATH)
    If SHGetPathFromIDList_(*itemId, @path)
      If Right(path, 1) <> "\"
        path + "\"
      EndIf
      ProcedureReturn path
    EndIf
  EndIf
  ProcedureReturn ""
EndProcedure
Procedure createShellLink(obj.s, lnk.s, arg.s, desc.s, dir.s, icon.s, index)
  ;obj - path to the exe that is linked to, lnk - link name, dir - working
  ;directory, icon - path to the icon file, index - icon index in iconfile
  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(Obj)
    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(lnk, #True)
;       CompilerElse
;         ;ensure that the string is ansi unicode
;         mem = Space(#MAX_PATH)
;         MultiByteToWideChar_(#CP_ACP, 0, lnk, -1, mem, #MAX_PATH)
;         ;save the link
;         hRes = ppf\Save(mem, #True)
;       CompilerEndIf
      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


OpenWindow(0,0,0,200,100,"test")

Global obj.s, lnk.s, prg.s, app.s, fil.s, zpf.s

obj = GetCurrentDirectory()+ExeName.s 
lnk = getSpecialFolder(#CSIDL_DESKTOPDIRECTORY) + "Anim Player.lnk"
prg = getSpecialFolder(#CSIDL_PROGRAM_FILES)
app = getSpecialFolder(#CSIDL_APPDATA)
fil = getSpecialFolder(#CSIDL_PROGRAMS)

zpf=prg+TargetPfad.s

Debug obj
Debug lnk
Debug prg
Debug app
Debug fil
Debug zpf

Debug "---"

Debug "Copy files from "+GetCurrentDirectory()
Debug "Copy files to   "+zpf

If CopyDirectory(GetCurrentDirectory(), zpf, "", #PB_FileSystem_Force    ) =0
  Debug "Konnte daten nicht kopieren"
EndIf


;Create Icon on Desktop
Debug "---"
Debug "Create ShellLink"
If CreateShellLink(zpf+"\"+ExeName.s , lnk,"","Lets Play Anime",zpf ,zpf+"\"+ExeName.s  ,0) = 0
  Debug "Icon auf den Desktop plaziert"
Else
  Debug "Konte keinen ShellLink erzeugen"
EndIf 

Code: Alles auswählen

SetCurrentDirectory(GetPathPart(ProgramFilename()))