PureBasic Forums - English

Code: Select all

; did some small changes...
; - allow screen savers to be compressed
; - allow to use the tool more often (signature has been filled with MZMZMZ...)
; - reduced the code a little bit (you could also remove a fileseek line in the stub.pb;)
; - changed the maximum packing rate to 9 (I did not see better results anyway)
; - calculate real size reduction (stub size have to be added)

; - now only a icon for the created exe is missing ;)

;(c)2006 Inf0Byt3

Enumeration
	#Window_0
EndEnumeration

Enumeration
	#Text_0
	#String_0
	#Button_0
	#Frame3D_0
	#CheckBox_0
	#Text_1
	#TrackBar_1
	#ProgressString_0
	#Button_1
	#Button_2
	#Button_3
EndEnumeration

If OpenWindow(#Window_0, 411, 290, 299, 208, "FShrink v1.0a",  #PB_Window_SizeGadget | #PB_Window_TitleBar)
	If CreateGadgetList(WindowID(#Window_0))
		TextGadget(#Text_0, 5, 10, 290, 15, "Choose an executable file:")
		StringGadget(#String_0, 5, 30, 225, 20, "")
		ButtonGadget(#Button_0, 235, 30, 60, 20, "Browse")
		Frame3DGadget(#Frame3D_0, 5, 60, 290, 115, "Options")
		CheckBoxGadget(#CheckBox_0, 10, 80, 278, 15, "Backup the input executable file")
		TextGadget(#Text_1, 10, 105, 280, 15, "Compression level:")
		TrackBarGadget(#TrackBar_1, 10, 120, 280, 20, 0, 9)
		TextGadget(#ProgressString_0, 10, 150, 280, 15, "Action: Waiting for a PE file to be loaded.")
		ButtonGadget(#Button_1, 5, 180, 90, 25, "About")
		ButtonGadget(#Button_2, 205, 180, 90, 25, "CompressPE")
		ButtonGadget(#Button_3, 110, 180, 90, 25, "Exit")
		SetGadgetState(#CheckBox_0,1)
		SetGadgetState(#TrackBar_1,9)
	EndIf
EndIf

Repeat
	event = WaitWindowEvent()
	If event= #PB_Event_Gadget
		Select EventGadget()
		Case #Button_0
			PE.s = OpenFileRequester("Choose a program file:","","PE Executable (*.exe, *.scr)|*.exe;*.scr",0)
			If PE <SetGadgetText> 0 And FileSize(File) < 32<<20

				If ReadFile(0,File)
					If ReadWord(0)<>'ZM'
						MessageRequester("FShrink","The file you have chosen is not a valid PE file.")
						End
					Else
						FileSeek(0,0)
						Filesize = Lof(0)

						*Buffer = AllocateMemory(Filesize)
						ReadData(0,*Buffer,Filesize)
						CloseFile(0)
						*BufferCompressed = AllocateMemory(Filesize+8)
						If *Buffer And *BufferCompressed
							SetGadgetText(#ProgressString_0,"Action: Compressing file. Please wait.")
							LengthCompressed = PackMemory(*Buffer,*BufferCompressed,Filesize,GetGadgetState(#TrackBar_1))
							
							If GetGadgetState(#CheckBox_0) = 0
								DeleteFile(File)
							Else
								File=GetPathPart(File)+GetFilePart(File)+"_compressed.exe"
							EndIf
							CreateFile(0,File)
							WriteData(0,?StubStart,?StubEnd-?StubStart)
							WriteData(0,*BufferCompressed,LengthCompressed)
							WriteLong(0,Filesize)
							WriteLong(0,LengthCompressed)
							CloseFile(0)
							MessageRequester("Ready","The file was compressed successfully. Now it is: "+Str((Filesize-LengthCompressed+?StubStart-?StubEnd)>>10)+" kB smaller.")

							SetGadgetText(#ProgressString_0,"Action: Waiting for a PE file to be loaded.")
							SetGadgetText(#String_0,"")
				
						If *BufferCompressed
							FreeMemory(*BufferCompressed)
						EndIf
					EndIf
				EndIf
			Else
				MessageRequester("FShrink","Could not read the file.")
				End
			EndIf
		Else
			MessageRequester("FShrink","The filesize must be bigger than 0 and smaller than 32MB.")
		EndIf
	EndSelect
EndIf
ForEver

DataSection
StubStart:
IncludeBinary "Stub.exe"
StubEnd:
EndDataSection

Code: Select all

Procedure.s selfE(src.s,en.l)
  k1=Len(src)
  If k1>0
    *p=@src
    k2=PeekB(*p) & $FF
    r=k1 ! k2
    If r<>0 : PokeB(*p,r) : EndIf
    For i=2 To Len(src)
      *p+1
      If en : k1=PeekB(*p-1) & $FF : Else : k1=k2 : EndIf
      k2=PeekB(*p)
      r=k1 ! k2
      If r<>0 : PokeB(*p,r) : EndIf
    Next
  EndIf
  ProcedureReturn src
EndProcedure

w.s="Wooo! Hooo! This is self encrypting"
x.s=selfE(w,#True)
y.s=selfE(x,#False)
Debug w
Debug x
Debug y