;compression procedures ;- Headers XIncludeFile "MyIDEVars.pbi" XIncludeFile "PBMacros.pbi" XIncludeFile "GenMacros.pbi" Global NewList FileList.s() Global PackFileLength.l Global ProgressGadget.l Global SourceSize.l Procedure AddResource(FN.s) ;same as AddResource2 except this time we just smash it together ;not as pretty though Unpacker.l=CreateFile(#PB_Any,FN) If Unpacker=0 MessageRequester(MyTittle,"Unable to create"+Chr(10)+FN,#MB_ICONSTOP) ProcedureReturn EndIf WPK.l=ReadFile(#PB_Any,NewExtension(FN,"wpk")) If WPK=0 MessageRequester(MyTittle,"Unable to open pack file"+Chr(10)+NewExtension(FN,"wpk"),#MB_ICONSTOP) CloseFile(Unpacker) DeleteFile(FN) ProcedureReturn EndIf ;save the unpacker WriteData(Unpacker,?Unpacker,?EndPacker-?UnPacker) ;add the pack file pksize.l=Lof(WPK) *mem=AllocateMemory(pksize) ReadData(WPK,*mem,pksize) CloseFile(WPK) pf.l=Lof(Unpacker) WriteDouble(Unpacker,pksize) WriteData(Unpacker,*mem,pksize) CloseFile(Unpacker) FreeMemory(*mem) EndProcedure Procedure AddResource2(FN.s) ;FN is name of selfextractor exe file F.l=CreateFile(#PB_Any,FN) If F WriteData(F,?Unpacker,?EndPacker-?UnPacker) CloseFile(F) Else MessageRequester(MyTittle,"Unable to create"+Chr(10)+FN,#MB_ICONSTOP) EndIf UPacker.s=FN hUnpacker.l=BeginUpdateResource_(@UPacker,#False) If hUnPacker Type$="RT_RCDATA" Name$="WPK" FPK$=NewExtension(FN,"wpk") FS.l=FileSize(FPK$) F.l=ReadFile(#PB_Any,FPK$) If F *mem=AllocateMemory(FS) ReadData(F,*mem,FS) CloseFile(F) If UpdateResource_(hUnPacker,@Type$,@Name$,0,*mem,FS) EndUpdateResource_(hUnPacker,#False) MessageRequester(MyTittle,"Self Extracting PAK file created"+Chr(10)+FN) Else MessageRequester(MyTittle,"Unable to modify resource"+Chr(10)+FN,#MB_ICONSTOP) EndUpdateResource_(hUnPacker,#True) EndIf FreeMemory(*mem) Else MessageRequester(MyTittle,"Can't open"+Chr(10)+FPK$,#MB_ICONSTOP) EndUpdateResource_(hUnPacker,#True) EndIf Else MessageRequester(MyTittle,"Unable to modify file"+Chr(10)+FN,#MB_ICONSTOP) EndIf EndProcedure Procedure PackerProgress(SourcePosition, DestinationPosition) Result.f = (SourcePosition/SourceSize)*100 ;Result.f=(SourcePosition/DestinationPosition)*100 SetGadgetState(ProgressGadget, Round(Result,0)) ; Process all the window event befor quit ;Debug "Start DP="+Str(DestinationPosition-SourcePosition) ;Debug "SourceP = "+Str(SourcePosition) ;Debug "DestP = "+Str(DestinationPosition) ;Debug "SourceSize = "+Str(SourceSize) Repeat WE=WindowEvent() If WE=#PB_Event_CloseWindow ProcedureReturn 0 EndIf Until WE=0 ;Debug "Return 1" ProcedureReturn 1 EndProcedure Procedure.l PackFiles(FN.s) If Left(FN,1)=Chr(34) FN=Mid(FN,2,Len(FN)-2) EndIf MainPath.s=GetPathPart(FN) PackFileLength=0 TotalFiles.l=CountList(FileList()) If TotalFiles<1 ProcedureReturn #False EndIf FullList.s="" ForEach FileList() If FileSize(FileList())<1 If Left(FileList(),1)=Chr(34) FileList()=Mid(FileList(),2,Len(FileList())-2) If FileSize(FileList())<1 If FileSize(MainPath+FileList())<1 MessageRequester(MyTittle,FileList()+Chr(10)+"Is not a valid file.",#MB_ICONSTOP) ProcedureReturn #False EndIf EndIf Else If FileSize(MainPath+FileList())<1 MessageRequester(MyTittle,FileList()+Chr(10)+"Is not a valid file.",#MB_ICONSTOP) ProcedureReturn #False EndIf EndIf EndIf ;- adjust FileList() for Relative Path If MainPath=Left(GetPathPart(FileList()),Len(MainPath)) FileList()=Right(FileList(),Len(FileList())-Len(MainPath)) If FileSize(MainPath+FileList())<1 MessageRequester(MyTittle,"Improperly Adjusted"+Chr(10)+FileList(),#MB_ICONSTOP) ProcedureReturn #False EndIf Else If FileSize(MainPath+FileList())<1 MessageRequester(MyTittle,FileList()+Chr(10)+"Needs to be relocated to "+Chr(10)+MainPath,#MB_ICONSTOP) ProcedureReturn #False EndIf EndIf ;- create packing list FullList=FullList+FileList()+Chr(10) Next ;- Window win=OpenWindow(#PB_Any, 100, 200, 300, 40, "Waffle Packer - Progress Window") If win StickyWindow(win,1) DisableWindow(#WINDOW,1) CreateGadgetList(WindowID(win)) ProgressGadget=ProgressBarGadget(#PB_Any, 10, 10, 280, 20, 0, 100) If CreatePack(NewExtension(FN,"wpk")) ;- Packing List *Source=AllocateMemory(Len(FullList)+1) PokeS(*Source,FullList) *Target = AllocateMemory(Len(FullList)+9) PackerCallback(@PackerProgress()) SetWindowTitle(win,"Waffle Packer - Packing List") SourceSize=Len(FullList)+1 AddPackMemory(*Source,Len(FullList)+1,9) ;CallDebugger ;Debug FullList ;- Finish Pack FCount.l=CountString(FullList,Chr(10)) For N=1 To FCount TFN.s=StringField(FullList,N,Chr(10)) ;CallDebugger ;Debug TFN SetWindowTitle(win,"Waffle Packer - "+GetFilePart(TFN)) ;Debug "Using - "+MainPath+TFN ;Debug "Size = "+Str(FileSize(MainPath+TFN)) SourceSize=FileSize(MainPath+TFN) AddPackFile(MainPath+TFN,9) ;CallDebugger Next N ClosePack() ;Debug "Done" ;- Done CloseWindow(win) DisableWindow(#WINDOW,0) FreeMemory(*Target) FreeMemory(*Source) ProcedureReturn #True Else MessageRequester(MyTittle,"Unable to create File"+Chr(10)+FN,#MB_ICONSTOP) ProcedureReturn #False EndIf Else ProcedureReturn #False EndIf EndProcedure Procedure.l Compress(FN.s,CMode,EFlag.l) ;set EFlag to 0 to block error reporting ;this scans FileList() and compresses ;each file. Then combines all files into one package ;then makes a self-extracting package ..... ;available modes are: ;0="No Compression") ;1="Compress on EXE build only") ;2="Compress on Final builds") ;3="Compress on ALL builds") ;4="Make Run Time Compression") ;5="Make Stripped Compression") ;6="Make Compressed Patch") ;this assumes that an *.exe already built ;and that that file has been added to FileList() ;so, all we need do is read FileList() Select CMode Case 0 ;no compression ProcedureReturn Case 4 ;- Make Run Time ;this makes a special source code (with no code) ;then builds it to blank.exe ;next, Another special source code is built (DO : Sync : Loop) ;and this code is built as dummy.exe ;blank and dummy are compared for first byte difference .... ;a new file runtime.001 is made ;runtime.001 is then compressed to runtime.wpk BlankDBA.s=NewFileName(FN,"Blank.dba") F.l=CreateFile(#PB_Any,BlankDBA) If F CloseFile(F) RunProgram(Chr(34)+Compiler+Chr(34),"-b "+Chr(34)+NewExtension(BlankDBA,"EXE")+Chr(34)+" "+Chr(34)+BlankDBA+Chr(34),"",1) Else If EFlag MessageRequester(MyTittle,"Unable to create"+Chr(10)+BlankDBA,#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf BlankDBA.s=NewFileName(FN,"Blank.dba") F.l=CreateFile(#PB_Any,BlankDBA) If F WriteStringN(F,"DO : Sync : Loop") CloseFile(F) RunProgram(Chr(34)+Compiler+Chr(34),"-b "+Chr(34)+NewFileName(BlankDBA,"Source.EXE")+Chr(34)+" "+Chr(34)+BlankDBA+Chr(34),"",1) Else If EFlag MessageRequester(MyTittle,"Unable to create"+Chr(10)+NewFileName(BlankDBA,"Source.EXE"),#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf F=ReadFile(#PB_Any,NewExtension(BlankDBA,"EXE")) If F *Blank=AllocateMemory(Lof(F)) ReadData(F,*Blank,Lof(F)) CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to Open"+Chr(10)+NewExtension(BlankDBA,"EXE"),#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf F=ReadFile(#PB_Any,NewFileName(BlankDBA,"Source.EXE")) If F *Source=AllocateMemory(Lof(F)) ReadData(F,*Source,Lof(F)) CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to Open"+Chr(10)+NewFileName(BlankDBA,"Source.EXE"),#MB_ICONSTOP) EndIf FreeMemory(*Blank) ProcedureReturn #False EndIf ;compare memoryies For n=0 To MemorySize(*Blank) If PeekB(*Blank+n)<>PeekB(*Source+n) Break EndIf Next n ;CallDebugger ;Debug "Size Match = "+Str(n) ReAllocateMemory(*Source,n) CopyMemory(*Blank,*Source,n) FreeMemory(*Blank) ;now save RunTime.001 F=CreateFile(#PB_Any,NewFileName(BlankDBA,"Runtime.001")) If F WriteData(F,*Source,MemorySize(*Source)) CloseFile(F) FreeMemory(*Source) Else If EFlag MessageRequester(MyTittle,"Unable to Save"+Chr(10)+NewFileName(BlankDBA,"Runtime.001"),#MB_ICONSTOP) EndIf FreeMemory(*Source) ProcedureReturn #False EndIf ;create packing list headers ClearList(FileList()) AddElement(FileList()) FileList()=NewFileName(BlankDBA,"Runtime.001") If PackFiles(NewFileName(BlankDBA,"Runtime.wpk")) AddResource(NewFileName(BlankDBA,"Runtime.EXE")) Else If EFlag MessageRequester(MyTittle,"Unable to make runtime.wpk") EndIf ClearList(FileList()) DeleteFile(BlankDBA) DeleteFile(NewFileName(BlankDBA,"Source.EXE")) DeleteFile(NewFileName(BlankDBA,"Blank.EXE")) ProcedureReturn #False EndIf ;then some cleanup ClearList(FileList()) DeleteFile(BlankDBA) DeleteFile(NewFileName(BlankDBA,"Source.EXE")) DeleteFile(NewFileName(BlankDBA,"Blank.EXE")) If EFlag MessageRequester(MyTittle,"Created - "+NewFileName(BlankDBA,"Runtime.001"),#MB_ICONINFORMATION) EndIf ProcedureReturn #True Case 5 ;- Make Stripped COmpression ;this build source as normal ... source.exe ;then the first bytes (length of runtime.001) are removed ;and a new file source.002 is made ;this is then compressed as normal RunSize.l=FileSize(NewFileName(FN,"RunTime.001")) If RunSize<1 If EFlag MessageRequester(MyTittle,"Unable to locate file"+Chr(10)+NewFileName(FN,"Runtime.001"),#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf ;last item is always the exename LastElement(FileList()) If Left(FileList(),1)=Chr(34) FileList()=Mid(FileList(),2,Len(FileList())-2) EndIf F=ReadFile(#PB_Any,GetPathPart(FN)+FileList()) If F *mem=AllocateMemory(Lof(F)) ReadData(F,*mem,Lof(f)) CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to open file"+Chr(10)+GetPathPart(FN)+FileList(),#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf F=CreateFile(#PB_Any,NewExtension(GetPathPart(FN)+FileList(),"002")) If F FileList()=NewExtension(GetPathPart(FN)+FileList(),"002") WriteData(F,*mem+RunSize,MemorySize(*mem)-RunSize) msg$="Stripped EXE Created"+Chr(10) msg$=msg$+FileList()+Chr(10) msg$=msg$+"Original Size ="+Str(MemorySize(*mem))+Chr(10) msg$=msg$+"New Size ="+Str(MemorySize(*mem)-RunSize) If EFlag MessageRequester(MyTittle,msg$,#MB_ICONINFORMATION) EndIf CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to Create file"+Chr(10)+NewExtension(GetPathPart(FN)+FileList(),"002"),#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf If PackFiles(NewExtension(FN,"wpk")) AddResource(FN) Else If EFlag MessageRequester(MyTittle,"Unable to compress"+Chr(10)+FN) EndIf ProcedureReturn #False EndIf ProcedureReturn #True Case 6 ;- make compressed patch ;build source as Source.pat ;source.pat is compared to Source.exe and ;a new file PSource.pat is made ;this is then compressed to Source.wpk ;last item is always the exename LastElement(FileList()) If Left(FileList(),1)=Chr(34) FileList()=Mid(FileList(),2,Len(FileList())-2) EndIf ;load patch file F.l=ReadFile(#PB_Any,GetPathPart(FN)+FileList()) If F *PAT=AllocateMemory(Lof(F)) ReadData(F,*PAT,Lof(F)) MaxPat=Lof(F)-1 MaxMEM=MAXPat CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to Open file"+Chr(10)+GetPathPart(FN)+FileList(),#MB_ICONSTOP) EndIf ProcedureReturn #False EndIf ;load previous exe file F.l=ReadFile(#PB_Any,GetPathPart(FN)+NewExtension(FileList(),"EXE")) If F *EXE=AllocateMemory(Lof(F)) ReadData(F,*EXE,Lof(F)) MaxEXE=Lof(F)-1 If MaxEXE>MaxPat MaxMEM=MaxEXE EndIf CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to Open file"+Chr(10)+GetPathPart(FN)+NewExtension(FileList(),"EXE"),#MB_ICONSTOP) EndIf FreeMemory(*PAT) ProcedureReturn #False EndIf ;compare files and creat the real patch *mem=AllocateMemory(MaxMem+1) For start=0 To MaxMem If start>MaxPat Break ElseIf start>MaxEXE PokeB(*mem+start,PeekB(*PAT+start)) Else PokeB(*mem+start,PeekB(*Pat+Start) ! PeekB(*EXE+start)) EndIf Next start ;save patch F=CreateFile(#PB_Any,GetPathPart(FN)+FileList()) If F WriteData(F,*MEM,start) CloseFile(F) Else If EFlag MessageRequester(MyTittle,"Unable to Save Patch"+Chr(10)+GetPathPart(FN)+FileList(),#MB_ICONSTOP) EndIf FreeMemory(*PAT) ProcedureReturn #False EndIf If PackFiles(NewExtension(FN,"wpk")) AddResource(FN) Else If EFlag MessageRequester(MyTittle,"Unable to compress"+Chr(10)+FN) EndIf ProcedureReturn #False EndIf ProcedureReturn #True Default ;- compress EXE ;build source to source.exe ;compress to source.wpk ;Debug "Default Compression" If PackFiles(NewExtension(FN,"wpk")) ;Debug "Done compression" AddResource(FN) Else If EFlag MessageRequester(MyTittle,"Unable to compress"+Chr(10)+FN) EndIf ProcedureReturn #False EndIf ProcedureReturn #True EndSelect EndProcedure ;- Datasection DataSection Unpacker: IncludeBinary "unpack.exe" EndPacker: EndDataSection