Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Code: Alles auswählen
If CreateFile(1, ...)
WriteData(1, ?Start, ?Ende-?Start)
CloseFile(1)
EndIf
Start:
IncludeBinary ...
Ende:
Unsinn ...AND51 hat geschrieben:IncludeBinarys gehören jedoch in eine DataSection, das gilt auch für dich, STARGATE!
edel hat geschrieben:Unsinn ...AND51 hat geschrieben:IncludeBinarys gehören jedoch in eine DataSection, das gilt auch für dich, STARGATE!
@ marco2006:PB Hilfe [img]http://www.cheesebuerger.de/images/smilie/figuren/c010.gif[/img] hat geschrieben:IncludeBinary will include the named file at the current place in the code. Including should be done inside a Data block.
...and...
[...] component will be stored in the data section of the program, which has a much faster access than the code section.
Code: Alles auswählen
![PB Hilfe [img]http://www.cheesebuerger.de/images/smilie/figuren/c010.gif[/img]](http://www.cheesebuerger.de/images/smilie/figuren/c010.gif){kind=link}
; ******************************
; by Katana Seiko, とけより Studios
; Thanks to all contributors
; ******************************
Procedure CreateShortcut(Path.s, Link.s, WorkingDir.s = "", Argument.s = "", ShowCommand.l = #SW_SHOWNORMAL, Description.s = "", HotKey.l = #Null, IconFile.s = "|", IconIndex.l = 0)
Protected psl.IShellLinkW, ppf.IPersistFile, mem.s, hres.l, Result.l
If IconFile = "|" : IconFile = Path : EndIf
If Not WorkingDir : WorkingDir = GetPathPart(Path) : EndIf
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @psl.IShellLinkW) = 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)
PokeS(@mem, LINK, -1, #PB_Unicode)
hres = ppf\Save(@mem, #True)
result = 1
ppf\Release()
EndIf
psl\Release()
EndIf
CoUninitialize_()
ProcedureReturn result
DataSection
CLSID_ShellLink:
; 00021401-0000-0000-C000-000000000046
Data.l $00021401
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IPersistFile:
; 0000010b-0000-0000-C000-000000000046
Data.l $0000010B
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
CompilerIf #PB_Compiler_Unicode = 0
IID_IShellLink:
; DEFINE_SHLGUID(IID_IShellLinkA, 0x000214EEL, 0, 0);
; C000-000000000046
Data.l $000214EE
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
CompilerElse
IID_IShellLink: ; {000214F9-0000-0000-C000-000000000046}
Data.l $000214F9
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
CompilerEndIf
EndDataSection
EndProcedure
Procedure.s GetSpecialFolder(CSIDL.i)
Protected *itemid.ITEMIDLIST
Protected location.s = Space(#MAX_PATH)
If SHGetSpecialFolderLocation_ (0, CSIDL, @*itemid) = #NOERROR
If SHGetPathFromIDList_(*itemid, @location)
CoTaskMemFree_(*itemid)
If Right(location, 1) <> "\" : location + "\" : EndIf
ProcedureReturn location
EndIf
EndIf
EndProcedure
Procedure RestoreFile(file.i, start.i, ende.i)
If file
WriteData(file, start, ende-start)
CloseFile(file)
Else
MessageRequester("Fataler Fehler!", "Schreiben der Datei ist fehlgeschlagen.")
End 666
EndIf
EndProcedure
MyDesktop.s = GetSpecialFolder(#CSIDL_DESKTOPDIRECTORY)
AllDesktop.s = GetSpecialFolder(#CSIDL_COMMON_DESKTOPDIRECTORY)
MyStartmenu.s = GetSpecialFolder(#CSIDL_COMMON_PROGRAMS)
AllStartmenu.s = GetSpecialFolder(#CSIDL_COMMON_PROGRAMS)
Programme.s = GetSpecialFolder(#CSIDL_PROGRAM_FILES)
;Programme ist unter 64bit-OS automatisch (x86), wenn mit 32bit kompiliert.
;Programme.s = GetSpecialFolder(#CSIDL_PROGRAM_FILESX86) liefert unter x64-OS das (x86)-Verzeichnis.
;Installationspfad ermitteln
Path.s = PathRequester("Installationspfad", Programme)
If Path = ""
MessageRequester("Abbruch", "Installation abgebrochen.")
End
EndIf
;Dateien auspacken in den Installationspfad
RestoreFile(CreateFile(#PB_Any, Path+"Hauptprogramm.exe"), Start1, Ende1)
RestoreFile(CreateFile(#PB_Any, Path+"Resource.res"), Start2, Ende2)
;Weitere Dateien
;Für alle Nutzer oder nur für mich Links anlegen?
If MessageRequester("Frage", "Möchten Sie das Programm für alle Nutzer installieren?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
Desktop.s = AllDesktop
Startmenu.s = AllStartmenu
Else
Desktop.s = MyDesktop
Startmenu.s = MyStartmenu
EndIf
;Links im Startmenü
CreateDirectory(Startmenu+"MyProgram\")
CreateShortcut(Path+"Hauptprogramm.exe", Startmenu+"MyProgram\Hauptprogramm.lnk")
;Optional: Links auf dem Desktop
If MessageRequester("Frage", "Möchten Sie einen Link auf dem Desktop?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
CreateShortcut(Path+"Hauptprogramm.exe", Desktop+"Hauptprogramm.lnk")
EndIf
;Optional: Registrierungsdateien für das Programm ändern.
;Include "Registry.pbi"
DataSection
Start1:
IncludeBinary "Hauptprogramm.exe"
Ende1:
Start2:
IncludeBinary "Resource.res"
Ende2:
;Weitere Dateien
EndDataSection