Sorry, dachte das Programm währe bekannt:
http://www.purebasic.fr/english/viewtop ... highlight=
Da die Seite aber down ist, hier der Source:
PureSFX.exe
Code: Alles auswählen
;PureSFX v1.1 Archive Maker
;(c)2006 Trutia Alexandru
Enumeration
#Window_0
EndEnumeration
Global Image0,Count.l,FilesAdded,Path.s,TempZIP.s,File.s,Working,Threaddie
; Image0 = CatchImage(0, ?Image0)
Procedure PureSFXCallback(File.s, PerCent.f)
SetGadgetState(4,PerCent)
SetGadgetText(5,GetFilePart(File.s))
EndProcedure
Procedure PureSFXCount(EntryPath.s)
If Right(EntryPath.s,1)<>"\":EntryPath + "\":EndIf
Count.l
UsedDirectory = ExamineDirectory(#PB_Any, EntryPath, "*.*")
While NextDirectoryEntry(UsedDirectory)
EntryType.l = DirectoryEntryType(UsedDirectory)
EntryName.s = DirectoryEntryName(UsedDirectory)
If EntryName = "." Or EntryName = ".."
Continue
EndIf
If EntryType = #PB_DirectoryEntry_File
Count = Count + 1
EndIf
If EntryType = #PB_DirectoryEntry_Directory
PureSFXCount(EntryPath + EntryName)
EndIf
Wend: FinishDirectory(UsedDirectory)
ProcedureReturn Count
EndProcedure
Procedure.s PureSFXTempFile(name$)
tmpdir$ = GetTemporaryDirectory()
Repeat
tmp$ = tmpdir$ + name$ + Str(Random(99))
Until FileSize(tmp$) = -1
ProcedureReturn tmp$
EndProcedure
Procedure PureSFXMakeEXE(*pDummy)
DisableGadget(6,1)
DisableGadget(7,1)
DisableGadget(3,1)
Count = PureSFXCount(Path)
FilesAdded = PureZIP_AddFiles(TempZIP, Path+"*.*", #PureZIP_StorePathRelative, #PureZIP_Recursive)
If Count = FilesAdded
If ReadFile(0,TempZIP)
SizeT = Lof(0)
*Temp = AllocateMemory(SizeT)
ReadData(0,*Temp,SizeT)
CloseFile(0)
CreateFile(0,File)
WriteData(0,?StubStart, ?StubEnd - ?StubStart)
WriteData(0,*Temp,SizeT)
WriteLong(0,SizeT)
CloseFile(0)
EndIf
EndIf
Debug SizeT
DeleteFile(TempZIP)
FreeMemory(*Temp)
MessageRequester("Ready","The archive was created sucessfully. "+Str(FilesAdded)+" files were added.",#MB_ICONINFORMATION)
Working = 0
TempZIP = ""
Path = ""
File = ""
SizeT = 0
Count = 0
SetGadgetState(4,0)
DisableGadget(6,0)
DisableGadget(7,0)
DisableGadget(3,0)
SetGadgetText(5,"Ready...")
ProcedureReturn
EndProcedure
If OpenWindow(#Window_0, 405, 334, 253, 161, "PureSFX v1.0", #PB_Window_TitleBar )
;If CreateGadgetList(WindowID(#Window_0))
StringGadget(0, 5, 60, 180, 20, "")
; ImageGadget(1, 0, 0, 253, 34, Image0)
TextGadget(2, 5, 45, 245, 15, "Choose your folder:")
ButtonGadget(3, 190, 60, 60, 20, "Browse")
ProgressBarGadget(4, 5, 110, 240, 15, 0, 100)
TextGadget(5, 5, 90, 240, 15, "Ready...")
ButtonGadget(6, 125, 135, 60, 20, "Exit")
ButtonGadget(7, 190, 135, 60, 20, "Squeeze!")
ButtonGadget(8, 5, 135, 60, 20, "About")
;EndIf
EndIf
LoadFont(0,"Arial",8)
SetGadgetFont(#PB_Any,FontID(0))
Repeat
event = WaitWindowEvent()
If event = #PB_Event_Gadget
Select EventGadget()
Case 8
MessageRequester("About PureSFX","PureSFX v1.1"+Chr(10)+Chr(13)+Chr(10)+Chr(13)+"Description: PureSFX is a small tool to make"+Chr(10)+Chr(13)+"Self-Extracting ZIP archives."+Chr(10)+Chr(13)+"(c)2006 Trutia Alexandru."+Chr(10)+Chr(13)+"Special thanks to Gnozal for PureZIP and all the help.",64)
Case 6
End
Case 3
Path.s = PathRequester("Choose a path please","")
If Path <> ""
If Right(Path,1) <> "\"
Path + "\"
EndIf
SetGadgetText(0,Path)
EndIf
Case 7
If Working = 1
KillThread(Threaddie)
Working = 0
EndIf
Path.s = GetGadgetText(0)
If Path <> ""
If Right(Path,1) <> "\"
Path + "\"
EndIf
File.s = SaveFileRequester("Please choose file to save", "", "Executable files (*.exe)|*.exe", 0)
If File <> ""
If Right(File,4) <> ".exe":File=File+".exe":EndIf
TempZIP.s = PureSFXTempFile("PureSFX")
PureZIP_SetProgressionCallback(@PureSFXCallback())
Threaddie = CreateThread(@PureSFXMakeEXE(),0)
Working = 1
EndIf
EndIf
EndSelect
EndIf
ForEver
DataSection
; Image0:
; IncludeBinary "LOGO2.bmp"
StubStart:
IncludeBinary "Stub.exe"
StubEnd:
EndDataSection
Code: Alles auswählen
;PureSFX v1.1 Stub
;(c)2006 Trutia Alexandru
Enumeration
#Window_0
EndEnumeration
Global Image0,File.s,Path.s,Exe.s,Done.l
Global GlobalInfo.unz_global_info
; Image0 = CatchImage(0, ?Image0)
OpenConsole()
Procedure PureSFXCallback(NrOfCompressed)
SetGadgetState(5,Done*100/NrOfCompressed)
Done = Done + 1
EndProcedure
Procedure PureSFXExtract()
Path = GetGadgetText(1)
If Path <> ""
If PureZIP_Archive_Read(Exe)
SetGadgetText(3,"Extracting files...")
PureZIP_SetArchivePassword(InputRequester("Enter password", "This archive is encrypted, please enter the password:", ""))
GlobalInfo.unz_global_info
PureZIP_Archive_GlobalInfo(GlobalInfo.unz_global_info)
NrOfCompressed.l = GlobalInfo\number_entry
ReturnValue.l = PureZIP_Archive_FindFirst() = #UNZ_OK
While ReturnValue = #UNZ_OK
PureZIP_Archive_Extract(Path.s, #True)
PureSFXCallback(NrOfCompressed)
ReturnValue = PureZIP_Archive_FindNext()
Wend
PureZIP_Archive_Close()
EndIf
SetGadgetText(3,"Ready")
MessageRequester(Str(NrOfCompressed),"The files were extracted successfully!",#MB_ICONINFORMATION)
End
Else
MessageRequester("PureSFX","Please choose a destination path!",#MB_ICONWARNING)
EndIf
ProcedureReturn
EndProcedure
If OpenWindow(#Window_0, 405, 334, 253, 125, "PureSFX Archive", #PB_Window_TitleBar | #PB_Window_Invisible)
StringGadget(1, 5, 55, 180, 20, "")
; ImageGadget(2, 0, 0, 253, 34, Image0)
TextGadget(3, 5, 40, 245, 15, "Choose your destination directory:")
ButtonGadget(4, 190, 55, 60, 20, "Browse")
ProgressBarGadget(5, 5, 80, 245, 15, 0, 100)
ButtonGadget(6, 105, 100, 70, 20, "Exit")
ButtonGadget(7, 180, 100, 70, 20, "Extract")
ButtonGadget(8, 5, 100, 60, 20, "About")
ButtonGadget(9, 105, 100, 70, 20, "Cancel")
HideGadget(9,1)
EndIf
LoadFont(0,"Arial",8)
SetGadgetFont(#PB_Any,FontID(0))
Exe.s = Space(512)
GetModuleFileName_(0,@Exe.s,999)
HideWindow(#Window_0,0)
Repeat
event = WaitWindowEvent()
If event = #PB_Event_Gadget
Select EventGadget()
Case 4
Path.s = PathRequester("Choose the destination path please","")
If Path <> ""
If Right(Path,1) <> "\"
Path=Path+"\"
EndIf
SetGadgetText(1,Path)
Path = ""
EndIf
Case 7
Threaddie = CreateThread(@PureSFXExtract(),0)
Case 6
End
Case 8
MessageRequester("About PureSFX","PureSFX v1.1"+Chr(10)+Chr(13)+Chr(10)+Chr(13)+"Description: PureSFX is a small tool to make"+Chr(10)+Chr(13)+"Self-Extracting ZIP archives."+Chr(10)+Chr(13)+"(c)2006 Trutia Alexandru."+Chr(10)+Chr(13)+"Special thanks to Gnozal for PureZIP and all the help.",64)
EndSelect
EndIf
ForEver
DataSection
; Image0:
; IncludeBinary "LOGO1.bmp"
EndDataSection
