Initial implementation of zipper class

git-svn-id: trunk@4413 -

.gitattributes

@@ -888,6 +888,7 @@ fcl/inc/whtml.pp svneol=native#text/plain
 fcl/inc/wtex.pp svneol=native#text/plain
 fcl/inc/xmlreg.pp svneol=native#text/plain
 fcl/inc/xregreg.inc svneol=native#text/plain
+fcl/inc/zipper.pp svneol=native#text/plain
 fcl/inc/zstream.pp svneol=native#text/plain
 fcl/linux/syncobjs.pp svneol=native#text/plain
 fcl/net/Makefile svneol=native#text/plain
@@ -1025,6 +1026,7 @@ fcl/tests/testsres.pp svneol=native#text/plain
 fcl/tests/testur.pp svneol=native#text/plain
 fcl/tests/testz.pp svneol=native#text/plain
 fcl/tests/testz2.pp svneol=native#text/plain
+fcl/tests/testzip.pp svneol=native#text/plain
 fcl/tests/threads.pp svneol=native#text/plain
 fcl/tests/tidea.pp svneol=native#text/plain
 fcl/tests/tstelcmd.pp svneol=native#text/plain

fcl/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/08/02]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/06/12]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince arm-gba powerpc64-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince arm-gba powerpc64-linux
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
@@ -310,9 +310,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override TARGET_DIRS+=xml image db shedit passrc net fpcunit
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_DIRS+=xml image db shedit passrc net fpcunit
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override TARGET_DIRS+=xml image db shedit passrc net fpcunit
 endif
@@ -433,9 +430,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override TARGET_UNITS+=contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex blowfish  process ssockets resolve fpasync simpleipc dbugmsg dbugintf
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex blowfish
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override TARGET_UNITS+=contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex blowfish
 endif
@@ -556,9 +550,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override TARGET_RSTS+=ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_RSTS+=ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override TARGET_RSTS+=ssockets cachecls resolve custapp cgiapp eventlog registry simpleipc
 endif
@@ -679,9 +670,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override TARGET_EXAMPLEDIRS+=tests
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_EXAMPLEDIRS+=tests
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override TARGET_EXAMPLEDIRS+=tests
 endif
@@ -725,127 +713,124 @@ ifeq ($(FULL_TARGET),powerpc64-linux)
 override TARGET_EXAMPLEDIRS+=tests
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
-endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+override CLEAN_UNITS+=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)
@@ -926,9 +911,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override COMPILER_OPTIONS+=-S2
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override COMPILER_OPTIONS+=-S2
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override COMPILER_OPTIONS+=-S2
 endif
@@ -1049,9 +1031,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc  unix
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override COMPILER_INCLUDEDIR+=$(OS_TARGET) inc
 endif
@@ -1172,9 +1151,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override COMPILER_SOURCEDIR+=$(OS_TARGET) inc
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-override COMPILER_SOURCEDIR+=$(OS_TARGET) inc
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 override COMPILER_SOURCEDIR+=$(OS_TARGET) inc
 endif
@@ -1642,7 +1618,7 @@ endif
 ifeq ($(OS_TARGET),amiga)
 EXEEXT=
 PPUEXT=.ppu
-ASMEXT=.s
+ASMEXT=.asm
 OEXT=.o
 SMARTEXT=.sl
 STATICLIBEXT=.a
@@ -2268,13 +2244,6 @@ REQUIRE_PACKAGES_ODBC=1
 REQUIRE_PACKAGES_ORACLE=1
 REQUIRE_PACKAGES_SQLITE=1
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_HASH=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_PASJPEG=1
-REQUIRE_PACKAGES_NETDB=1
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_HASH=1
@@ -3582,15 +3551,6 @@ TARGET_DIRS_PASSRC=1
 TARGET_DIRS_NET=1
 TARGET_DIRS_FPCUNIT=1
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-TARGET_DIRS_XML=1
-TARGET_DIRS_IMAGE=1
-TARGET_DIRS_DB=1
-TARGET_DIRS_SHEDIT=1
-TARGET_DIRS_PASSRC=1
-TARGET_DIRS_NET=1
-TARGET_DIRS_FPCUNIT=1
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 TARGET_DIRS_XML=1
 TARGET_DIRS_IMAGE=1
@@ -4110,9 +4070,6 @@ endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 TARGET_EXAMPLEDIRS_TESTS=1
 endif
-ifeq ($(FULL_TARGET),powerpc-amiga)
-TARGET_EXAMPLEDIRS_TESTS=1
-endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 TARGET_EXAMPLEDIRS_TESTS=1
 endif

fcl/Makefile.fpc

@@ -22,7 +22,7 @@ packages_emx=netdb
 
 # clean package units
 [clean]
-units=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish
+units=adler gzcrc gzio infblock infcodes inffast inftrees infutil minigzip paszlib trees zbase zcompres zdeflate zinflate zuncompr zutil pthreads streamio blowfish zipper
 
 [target]
 dirs=xml image db shedit passrc net fpcunit

fcl/inc/zipper.pp

@@ -0,0 +1,1038 @@
+{
+    $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+unit zipper;
+
+Interface
+
+Uses 
+   SysUtils,Classes, ZStream;
+
+
+Const
+   LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
+
+Type
+   Local_File_Header_Type = Packed Record
+     Signature              :  LongInt;
+     Extract_Version_Reqd   :  Word;
+     Bit_Flag               :  Word;
+     Compress_Method        :  Word;
+     Last_Mod_Time          :  Word;
+     Last_Mod_Date          :  Word;
+     Crc32                  :  LongInt;
+     Compressed_Size        :  LongInt;
+     Uncompressed_Size      :  LongInt;
+     Filename_Length        :  Word;
+     Extra_Field_Length     :  Word;
+   end;
+
+{ Define the Central Directory record types }
+
+Const
+   CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
+
+Type
+  Central_File_Header_Type = Packed Record
+    Signature            :  LongInt;
+    MadeBy_Version       :  Word;
+    Extract_Version_Reqd :  Word;
+    Bit_Flag             :  Word;
+    Compress_Method      :  Word;
+    Last_Mod_Time        :  Word;
+    Last_Mod_Date        :  Word;
+    Crc32                :  LongInt;
+    Compressed_Size      :  LongInt;
+    Uncompressed_Size    :  LongInt;
+    Filename_Length      :  Word;
+    Extra_Field_Length   :  Word;
+    File_Comment_Length  :  Word;
+    Starting_Disk_Num    :  Word;
+    Internal_Attributes  :  Word;
+    External_Attributes  :  LongInt;
+    Local_Header_Offset  :  LongInt;
+  End;
+
+Const
+  END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
+
+Type
+  End_of_Central_Dir_Type =  Packed Record
+    Signature               :  LongInt;
+    Disk_Number             :  Word;
+    Central_Dir_Start_Disk  :  Word;
+    Entries_This_Disk       :  Word;
+    Total_Entries           :  Word;
+    Central_Dir_Size        :  LongInt;
+    Start_Disk_Offset       :  LongInt;
+    ZipFile_Comment_Length  :  Word;
+  end;
+
+Const
+  Crc_32_Tab : Array[0..255] of LongInt = (
+    $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
+    $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
+    $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
+    $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
+    $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
+    $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
+    $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
+    $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
+    $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
+    $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
+    $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
+    $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
+    $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
+    $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
+    $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
+    $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
+    $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
+    $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
+    $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
+    $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
+    $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
+    $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
+    $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
+    $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
+    $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
+    $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
+    $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
+    $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
+    $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
+    $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
+    $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
+    $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
+  );
+
+Type
+
+  TZipItem   = Class(TObject)
+    Path : String;
+    Name : String;
+    Size : LongInt;
+    DateTime : TDateTime;
+  end;
+
+  TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
+  TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : Double) of object;   
+  TOnStartFileEvent = Procedure(Sender : TObject; Const AFileName : String) of object;
+  
+Type
+
+  { TCompressor }
+  TCompressor = Class(TObject)
+  Protected
+    FInFile     :  TStream;        { I/O file variables                         }
+    FOutFile    :  TStream;
+    FCrc32Val    :  LongInt;       { CRC calculation variable                   }
+    FBufferSize : Cardinal;
+    FOnPercent  : Integer;
+    FOnProgress : TProgressEvent;
+    Procedure UpdC32(Octet: Byte);
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : Cardinal); virtual;
+    Procedure Compress; Virtual; Abstract;
+    Class Function ZipID : Word; virtual; Abstract;
+    Property BufferSize : Cardinal read FBufferSize;
+    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+    Property Crc32Val : Longint Read FCrc32Val Write FCrc32Val;
+  end;
+
+  { TShrinker }
+  
+Const
+   TABLESIZE   =   8191; 
+   FIRSTENTRY  =    257; 
+
+Type
+  CodeRec =  Packed Record
+    Child   : Smallint;
+    Sibling : Smallint;
+    Suffix  : Byte;
+  end;
+  CodeArray   =  Array[0..TABLESIZE] of CodeRec;
+  TablePtr    =  ^CodeArray;
+
+  FreeListPtr    =  ^FreeListArray;
+  FreeListArray  =  Array[FIRSTENTRY..TABLESIZE] of Word;
+
+  BufPtr      =  PByte;
+  
+  TShrinker = Class(TCompressor)
+  Private
+    FBufSize    : Cardinal;
+    MaxInBufIdx :  Cardinal;      { Count of valid chars in input buffer       }
+    InputEof    :  Boolean;       { End of file indicator                      }
+    CodeTable   :  TablePtr;      { Points to code table for LZW compression   }
+    FreeList    :  FreeListPtr;   { Table of free code table entries           }
+    NextFree    :  Word;          { Index into free list table                 }
+
+    ClearList   :  Array[0..1023] of Byte;  { Bit mapped structure used in     }
+                                            {    during adaptive resets        }
+    CodeSize    :  Byte;     { Size of codes (in bits) currently being written }
+    MaxCode     :  Word;   { Largest code that can be written in CodeSize bits }
+    InBufIdx,                     { Points to next char in buffer to be read   }
+    OutBufIdx   :  Cardinal;      { Points to next free space in output buffer }
+    InBuf,                        { I/O buffers                                }
+    OutBuf      :  BufPtr;
+    FirstCh     :  Boolean;  { Flag indicating the START of a shrink operation }
+    TableFull   :  Boolean;  { Flag indicating a full symbol table             }
+    SaveByte    :  Byte;     { Output code buffer                              }
+    BitsUsed    :  Byte;     { Index into output code buffer                   }
+    BytesIn     :  LongInt;  { Count of input file bytes processed             }
+    BytesOut    :  LongInt;  { Count of output bytes                           }
+    FOnBytes    : Longint;
+    Procedure FillInputBuffer;
+    Procedure WriteOutputBuffer;
+    Procedure FlushOutput;
+    Procedure PutChar(B : Byte);
+    procedure PutCode(Code : Smallint);
+    Procedure InitializeCodeTable;
+    Procedure Prune(Parent : Word);
+    Procedure Clear_Table;
+    Procedure Table_Add(Prefix : Word; Suffix : Byte);
+    function  Table_Lookup(TargetPrefix : Smallint;
+                           TargetSuffix : Byte;
+                           Var FoundAt  : Smallint) : Boolean;
+    Procedure Shrink(Suffix : Smallint);
+    Procedure ProcessLine(Const Source : String);
+    Procedure DoOnProgress(Const Pct : Double); Virtual;
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : Cardinal); override;
+    Destructor Destroy; override;
+    Procedure Compress; override;
+    Class Function ZipID : Word; override;
+  end;
+  
+  { TDeflater }
+
+  TDeflater = Class(TCompressor)
+  private
+    FCompressionLevel: TCompressionlevel;
+  Public
+    Constructor Create(AInFile, AOutFile : TStream; ABufSize : Cardinal);override;
+    Procedure Compress; override;
+    Class Function ZipID : Word; override;
+    Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
+  end;
+
+  { TZipper }
+
+  TZipper = Class(TObject)
+  Private
+    FZipping    : Boolean;
+    FBufSize    : Cardinal;
+    FFileName   :  String;         { Name of resulting Zip file                 }
+    FFiles      : TStrings;
+    FInMemSize  : Integer;
+    FOutFile    : TFileStream;
+    FInFile     : TFileStream;     { I/O file variables                         }
+    LocalHdr    : Local_File_Header_Type;
+    CentralHdr  : Central_File_Header_Type;
+    EndHdr      : End_of_Central_Dir_Type;
+
+    FOnPercent  : LongInt;
+    FOnProgress : TProgressEvent;
+    FOnEndOfFile : TOnEndOfFileEvent;   
+    FOnStartFile : TOnStartFileEvent;
+  Protected  
+    Procedure OpenOutput;
+    Procedure CloseOutput;
+    Procedure CloseInput;
+    Procedure StartZipFile(Item : TZipItem);
+    Function  UpdateZipHeader(Item : TZipItem; FZip : TStream; ACRC : Integer;AMethod : Word) : Boolean;
+    Procedure BuildZipDirectory;
+    Procedure DoEndOfFile;
+    Procedure ZipOneFile(Item : TZipItem); virtual;
+    Function  OpenInput(InFileName : String) : Boolean;
+    Procedure GetFileInfo;
+    Procedure SetBufSize(Value : Cardinal);
+    Procedure SetFileName(Value : String);
+    Function CreateCompressor(Item : TZipItem; AinFile,AZipStream : TStream) : TCompressor; virtual;
+  Public
+    Constructor Create;
+    Destructor Destroy;
+    Procedure ZipAllFiles; virtual;
+    Procedure ZipFiles(AFileName : String; FileList : TStringList);
+    Procedure Clear;
+  Public
+    Property BufferSize : Cardinal Read FBufSize Write SetBufSize;
+    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
+    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
+    Property OnStartFile : TOnStartFileEvent Read FOnStartFile Write FOnStartFile;
+    Property OnEndFile : TOnEndOfFileEvent Read FOnEndOfFile Write FOnEndOfFile;
+    Property FileName : String Read FFileName Write SetFileName;
+    Property Files : TStrings Read FFiles;
+    Property InMemSize : Integer Read FInMemSize Write FInMemSize;
+  end;
+
+  EZipError = Class(Exception);
+
+Implementation
+
+{ ---------------------------------------------------------------------
+    Auxiliary
+  ---------------------------------------------------------------------}
+  
+Procedure DateTimeToZipDateTime(DT : TDateTime; Var ZD,ZT : Word);
+
+Var
+  Y,M,D,H,N,S,MS : Word;
+
+begin
+  DecodeDate(DT,Y,M,D);
+  DecodeTime(DT,H,N,S,MS);
+  Y:=Y-1980;
+  ZD:=d+(32*M)+(512*Y);
+  ZT:=(S div 2)+(32*N)+(2048*h);
+end;
+
+{ ---------------------------------------------------------------------
+    TCompressor
+  ---------------------------------------------------------------------}
+  
+
+Procedure TCompressor.UpdC32(Octet: Byte);
+
+Begin
+  FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
+end;
+
+constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: Cardinal);
+begin
+  FinFile:=AInFile;
+  FoutFile:=AOutFile;
+  FBufferSize:=ABufSize;
+  CRC32Val:=$FFFFFFFF;
+end;
+
+
+{ ---------------------------------------------------------------------
+    TDeflater
+  ---------------------------------------------------------------------}
+  
+constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: Cardinal);
+begin
+  Inherited;
+  FCompressionLevel:=clDefault;
+end;
+
+
+procedure TDeflater.Compress;
+
+Var
+  Buf : PByte;
+  I,Count,NewCount : Integer;
+  C : TCompressionStream;
+  
+begin
+  CRC32Val:=$FFFFFFFF;
+  Buf:=GetMem(FBufferSize);
+  Try
+    C:=TCompressionStream.Create(FCompressionLevel,FOutFile,True);
+    Try
+      Repeat
+        Count:=FInFile.Read(Buf^,FBufferSize);
+        For I:=0 to Count-1 do
+          UpdC32(Buf[i]);
+        NewCount:=Count;
+        While (NewCount>0) do
+          NewCount:=NewCount-C.Write(Buf^,NewCount);
+      Until (Count=0);
+    Finally
+      C.Free;
+    end;
+  Finally
+    FreeMem(Buf);
+  end;
+  Crc32Val:=NOT Crc32Val;
+end;
+
+function TDeflater.ZipID: Word;
+begin
+  Result:=8;
+end;
+
+{ ---------------------------------------------------------------------
+    TShrinker
+  ---------------------------------------------------------------------}
+
+Const
+   DefaultInMemSize = 256*1024; { Files larger than 256k are processed on disk   }
+   DefaultBufSize =  16384;     { Use 16K file buffers                             }
+   MINBITS     =      9;        { Starting code size of 9 bits                     }
+   MAXBITS     =     13;        { Maximum code size of 13 bits                     }
+   SPECIAL     =    256;        { Special function code                            }
+   INCSIZE     =      1;        { Code indicating a jump in code size              }
+   CLEARCODE   =      2;        { Code indicating code table has been cleared      }
+   STDATTR     =    $23;        { Standard file attribute for DOS Find First/Next  }
+
+constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : Cardinal);
+begin
+  Inherited;
+  FBufSize:=ABufSize;
+  InBuf:=GetMem(FBUFSIZE);
+  OutBuf:=GetMem(FBUFSIZE);
+  CodeTable:=GetMem(SizeOf(CodeTable^));
+  FreeList:=GetMem(SizeOf(FreeList^));
+end;
+
+destructor TShrinker.Destroy;
+begin
+  FreeMem(CodeTable);
+  FreeMem(FreeList);
+  FreeMem(InBuf);
+  FreeMem(OutBuf);
+  inherited Destroy;
+end;
+
+Procedure TShrinker.Compress;
+
+Var
+   OneString : String;
+   Remaining : Word;
+
+begin
+  BytesIn := 1;
+  BytesOut := 1;
+  InitializeCodeTable;
+  FillInputBuffer;
+  FirstCh:= TRUE;
+  Crc32Val:=$FFFFFFFF;
+  FOnBytes:=Round((FInFile.Size * FOnPercent) / 100);
+  While NOT InputEof do
+    begin
+    Remaining:=Succ(MaxInBufIdx - InBufIdx);
+    If Remaining>255 then
+      Remaining:=255;
+    If Remaining=0 then
+      FillInputBuffer
+    else
+      begin
+      SetLength(OneString,Remaining);
+      Move(InBuf[InBufIdx], OneString[1], Remaining);
+      Inc(InBufIdx, Remaining);
+      ProcessLine(OneString);
+      end;
+    end;
+   Crc32Val := NOT Crc32Val;
+   ProcessLine('');
+end;
+
+function TShrinker.ZipID: Word;
+begin
+  Result:=1;
+end;
+
+
+
+Procedure TShrinker.FillInputBuffer;
+
+Begin
+   MaxInbufIDx:=FInfile.Read(InBuf[0], FBufSize);
+   If MaxInbufIDx=0 then
+      InputEof := TRUE
+   else
+      InputEOF := FALSE;
+   InBufIdx := 0;
+end;
+
+
+Procedure TShrinker.WriteOutputBuffer;
+Begin
+  FOutFile.WriteBuffer(OutBuf[0], OutBufIdx);
+  OutBufIdx := 0;
+end;
+
+
+Procedure TShrinker.PutChar(B : Byte);
+
+Begin
+  OutBuf[OutBufIdx] := B;
+  Inc(OutBufIdx);
+  If OutBufIdx>=FBufSize then
+    WriteOutputBuffer;
+  Inc(BytesOut);
+end;
+
+Procedure TShrinker.FlushOutput;
+Begin
+  If OutBufIdx>0 then
+    WriteOutputBuffer;
+End;
+
+
+procedure TShrinker.PutCode(Code : Smallint);
+
+var 
+  ACode : LongInt;
+  XSize : Smallint;
+    
+begin
+  if (Code=-1) then 
+    begin
+    if BitsUsed>0 then
+      PutChar(SaveByte);
+    end
+  else 
+    begin
+    ACode := Longint(Code);
+    XSize := CodeSize+BitsUsed;
+    ACode := (ACode shl BitsUsed) or SaveByte;
+    while (XSize div 8) > 0 do 
+      begin
+      PutChar(Lo(ACode));
+      ACode := ACode shr 8;
+      Dec(XSize,8);
+      end;
+    BitsUsed := XSize;
+    SaveByte := Lo(ACode);
+    end;
+end;
+
+
+Procedure TShrinker.InitializeCodeTable;
+
+Var
+   I  :  Word;
+Begin
+   For I := 0 to TableSize do 
+     begin
+     With CodeTable^[I] do 
+       begin
+       Child := -1;
+       Sibling := -1;
+       If (I<=255) then
+         Suffix := I;
+       end;
+     If (I>=257) then
+       FreeList^[I] := I;
+     end;
+   NextFree  := FIRSTENTRY;
+   TableFull := FALSE;
+end;
+
+
+Procedure TShrinker.Prune(Parent : Word);
+
+Var
+   CurrChild   : Smallint;
+   NextSibling : Smallint;
+Begin
+  CurrChild := CodeTable^[Parent].Child;
+  { Find first Child that has descendants .. clear any that don't }
+  While (CurrChild <> -1) AND (CodeTable^[CurrChild].Child = -1) do
+    begin
+    CodeTable^[Parent].Child := CodeTable^[CurrChild].Sibling;
+    CodeTable^[CurrChild].Sibling := -1;
+     { Turn on ClearList bit to indicate a cleared entry }
+    ClearList[CurrChild DIV 8] := (ClearList[CurrChild DIV 8] OR (1 SHL (CurrChild MOD 8)));
+    CurrChild := CodeTable^[Parent].Child;
+    end;
+  If CurrChild <> -1 then
+    begin   { If there are any children left ...}
+    Prune(CurrChild);
+    NextSibling := CodeTable^[CurrChild].Sibling;
+    While NextSibling <> -1 do
+      begin
+      If CodeTable^[NextSibling].Child = -1 then
+        begin
+        CodeTable^[CurrChild].Sibling := CodeTable^[NextSibling].Sibling;
+        CodeTable^[NextSibling].Sibling := -1;
+        { Turn on ClearList bit to indicate a cleared entry }
+        ClearList[NextSibling DIV 8] := (ClearList[NextSibling DIV 8] OR (1 SHL (NextSibling MOD 8)));
+        NextSibling := CodeTable^[CurrChild].Sibling;
+        end
+      else
+        begin
+        CurrChild := NextSibling;
+        Prune(CurrChild);
+        NextSibling := CodeTable^[CurrChild].Sibling;
+        end;
+      end;
+    end;
+end;
+
+
+Procedure TShrinker.Clear_Table;
+Var
+   Node : Word;
+Begin
+   FillChar(ClearList, SizeOf(ClearList), $00);
+   For Node := 0 to 255 do
+     Prune(Node);
+   NextFree := Succ(TABLESIZE);
+   For Node := TABLESIZE downto FIRSTENTRY do
+     begin
+     If (ClearList[Node DIV 8] AND (1 SHL (Node MOD 8))) <> 0 then
+       begin
+       Dec(NextFree);
+       FreeList^[NextFree] := Node;
+       end;
+     end;
+   If NextFree <= TABLESIZE then
+     TableFull := FALSE;
+end;
+
+
+Procedure TShrinker.Table_Add(Prefix : Word; Suffix : Byte);
+Var
+   FreeNode : Word;
+Begin
+  If NextFree <= TABLESIZE then
+    begin
+    FreeNode := FreeList^[NextFree];
+    Inc(NextFree);
+    CodeTable^[FreeNode].Child := -1;
+    CodeTable^[FreeNode].Sibling := -1;
+    CodeTable^[FreeNode].Suffix := Suffix;
+    If CodeTable^[Prefix].Child  = -1 then
+      CodeTable^[Prefix].Child := FreeNode
+    else
+      begin
+      Prefix := CodeTable^[Prefix].Child;
+      While CodeTable^[Prefix].Sibling <> -1 do
+        Prefix := CodeTable^[Prefix].Sibling;
+      CodeTable^[Prefix].Sibling := FreeNode;
+      end;
+    end;
+  if NextFree > TABLESIZE then
+    TableFull := TRUE;
+end;
+
+function TShrinker.Table_Lookup(    TargetPrefix : Smallint;
+                          TargetSuffix : Byte;
+                      Var FoundAt      : Smallint   ) : Boolean;
+
+var TempPrefix : Smallint;
+
+begin
+  TempPrefix := TargetPrefix;
+  Table_lookup := False;
+  if CodeTable^[TempPrefix].Child <> -1 then 
+    begin
+    TempPrefix := CodeTable^[TempPrefix].Child;
+    repeat
+      if CodeTable^[TempPrefix].Suffix = TargetSuffix then 
+        begin
+        Table_lookup := True;
+        break;
+        end;
+      if CodeTable^[TempPrefix].Sibling = -1 then
+        break;
+      TempPrefix := CodeTable^[TempPrefix].Sibling;
+    until False;
+  end;
+  if Table_Lookup then 
+    FoundAt := TempPrefix
+  else 
+    FoundAt := -1;
+end;
+
+Procedure TShrinker.Shrink(Suffix : Smallint);
+
+Const
+  LastCode : Smallint = 0;
+  
+Var
+  WhereFound : Smallint;
+   
+Begin
+  If FirstCh then
+    begin
+    SaveByte := $00;
+    BitsUsed := 0;
+    CodeSize := MINBITS;
+    MaxCode  := (1 SHL CodeSize) - 1;
+    LastCode := Suffix;
+    FirstCh  := FALSE;
+    end
+  else
+    begin
+    If Suffix <> -1 then
+      begin
+      If TableFull then
+        begin
+        Putcode(LastCode);
+        PutCode(SPECIAL);
+        Putcode(CLEARCODE);
+        Clear_Table;
+        Table_Add(LastCode, Suffix);
+        LastCode := Suffix;
+        end
+      else
+        begin
+        If Table_Lookup(LastCode, Suffix, WhereFound) then
+          begin
+          LastCode  := WhereFound;
+          end
+        else
+          begin
+          PutCode(LastCode);
+          Table_Add(LastCode, Suffix);
+          LastCode := Suffix;
+          If (FreeList^[NextFree] > MaxCode) and (CodeSize < MaxBits) then
+            begin
+            PutCode(SPECIAL);
+            PutCode(INCSIZE);
+            Inc(CodeSize);
+            MaxCode := (1 SHL CodeSize) -1;
+            end;
+          end;
+        end;
+      end
+    else
+      begin
+      PutCode(LastCode);
+      PutCode(-1);
+      FlushOutput;
+      end;
+    end;
+end;
+
+Procedure TShrinker.ProcessLine(Const Source : String);
+
+Var
+  I : Word;
+
+Begin
+  If Source = '' then
+    Shrink(-1)
+  else
+    For I := 1 to Length(Source) do
+      begin
+      Inc(BytesIn);
+      If (Pred(BytesIn) MOD FOnBytes) = 0 then
+        DoOnProgress(100 * ( BytesIn / FInFile.Size));
+      UpdC32(Ord(Source[I]));
+      Shrink(Ord(Source[I]));
+      end;
+end;
+
+{ ---------------------------------------------------------------------
+    TZipper
+  ---------------------------------------------------------------------}
+  
+
+Procedure TZipper.GetFileInfo;
+
+Var
+   Info : TSearchRec;
+   I       : Word;
+   NewNode : TZipItem;
+   
+
+Begin
+   For I := 0 to FFiles.Count-1 do
+     If FindFirst(FFiles[I], STDATTR, Info)=0 then
+       try
+         NewNode:=TZipItem.Create;
+         NewNode.Path := ExtractFilePath(FFiles[i]);
+         NewNode.Name := Info.Name;
+         NewNode.Size := Info.Size;
+         NewNode.DateTime:=FileDateToDateTime(Info.Time);
+         FFiles.Objects[i]:=NewNode;
+       finally
+         FindClose(Info);
+       end;
+end;
+
+Procedure TZipper.OpenOutput;
+
+Begin
+  FOutFile:=TFileStream.Create(FFileName,fmCreate);
+End;
+
+
+Function TZipper.OpenInput(InFileName : String) : Boolean;
+
+Begin
+  FInFile:=TFileStream.Create(InFileName,fmOpenRead);
+  Result:=True;
+  If Assigned(FOnStartFile) then
+    FOnStartFile(Self,InFileName);
+End;
+
+
+Procedure TZipper.CloseOutput;
+
+Begin
+  FreeAndNil(FOutFile);
+end;
+
+
+Procedure TZipper.CloseInput;
+
+Begin
+  FreeAndNil(FInFile);
+end;
+
+
+Procedure TZipper.StartZipFile(Item : TZipItem);
+
+Begin
+  FillChar(LocalHdr,SizeOf(LocalHdr),0);
+  With LocalHdr do
+    begin
+    Signature := LOCAL_FILE_HEADER_SIGNATURE;
+    Extract_Version_Reqd := 10;
+    Bit_Flag := 0;
+    Compress_Method := 1;
+    DateTimeToZipDateTime(Item.DateTime,Last_Mod_Date,Last_Mod_Time);
+    Crc32 := 0;
+    Compressed_Size := 0;
+    Uncompressed_Size := Item.Size;
+    FileName_Length := Length(Item.Name);
+    Extra_Field_Length := 0;
+  end ;
+End;
+
+
+Function TZipper.UpdateZipHeader(Item : TZipItem; FZip : TStream; ACRC : Integer; AMethod : Word) : Boolean;
+
+Begin
+  With LocalHdr do
+    begin
+    Compressed_Size := FZip.Size;
+    Crc32 := ACRC;
+    Compress_method:=AMethod;
+    Result:=Not (Compressed_Size >= Uncompressed_Size);
+    If Not Result then
+      begin                     { No...                          }
+      Compress_Method := 0;                  { ...change stowage type      }
+      Compressed_Size := Uncompressed_Size;  { ...update compressed size   }
+      end;
+    end;
+  FOutFile.WriteBuffer(LocalHdr,SizeOf(LocalHdr));
+  FOutFile.WriteBuffer(Item.Name[1],Length(Item.Name));
+End;
+
+
+Procedure TZipper.BuildZipDirectory;
+
+Var
+   SavePos   : LongInt;
+   HdrPos    : LongInt;
+   CenDirPos : LongInt;
+   Entries   : Word;
+   ZFileName  : ShortString;
+   
+Begin
+   Entries := 0;
+   CenDirPos := FOutFile.Position;
+   FOutFile.Seek(0,soFrombeginning);             { Rewind output file }
+   HdrPos := FOutFile.Position;
+   FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
+   Repeat
+     SetLength(ZFileName,LocalHdr.FileName_Length);
+     FOutFile.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
+     SavePos := FOutFile.Position;
+     FillChar(CentralHdr,SizeOf(CentralHdr),0);
+     With CentralHdr do 
+       begin
+       Signature := CENTRAL_FILE_HEADER_SIGNATURE;
+       MadeBy_Version := LocalHdr.Extract_Version_Reqd;
+       Move(LocalHdr.Extract_Version_Reqd, Extract_Version_Reqd, 26);
+       Last_Mod_Time:=localHdr.Last_Mod_Time;
+       Last_Mod_Date:=localHdr.Last_Mod_Date;
+       File_Comment_Length := 0;
+       Starting_Disk_Num := 0;
+       Internal_Attributes := 0;
+       External_Attributes := faARCHIVE;
+       Local_Header_Offset := HdrPos;
+       end;
+     FOutFile.Seek(0,soFromEnd);
+     FOutFile.WriteBuffer(CentralHdr,SizeOf(CentralHdr));
+     FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName));
+     Inc(Entries);
+     FOutFile.Seek(SavePos + LocalHdr.Compressed_Size,soFromBeginning);
+     HdrPos:=FOutFile.Position;
+     FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
+   Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE;
+   FOutFile.Seek(0,soFromEnd);
+   FillChar(EndHdr,SizeOf(EndHdr),0);
+   With EndHdr do 
+     begin
+     Signature := END_OF_CENTRAL_DIR_SIGNATURE;
+     Disk_Number := 0;
+     Central_Dir_Start_Disk := 0;
+     Entries_This_Disk := Entries;
+     Total_Entries := Entries;
+     Central_Dir_Size := FOutFile.Size-CenDirPos;
+     Start_Disk_Offset := CenDirPos;
+     ZipFile_Comment_Length := 0;
+     FOutFile.WriteBuffer(EndHdr, SizeOf(EndHdr));
+     end;
+end;
+
+Function TZipper.CreateCompressor(Item : TZipItem; AInFile,AZipStream : TStream) : TCompressor;
+
+begin
+  Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
+end;
+
+Procedure TZipper.ZipOneFile(Item : TZipItem);
+
+Var
+  CRC : Integer;
+  ZMethod : Word;
+  ZipStream : TStream;
+  TmpFileName : String;
+  
+Begin
+  OpenInput(Item.Path+Item.Name);
+  Try
+    StartZipFile(Item);
+    If (FInfile.Size<=FInMemSize) then
+      ZipStream:=TMemoryStream.Create
+    else
+      begin
+      TmpFileName:=ChangeFileExt(FFileName,'.tmp');
+      ZipStream:=TFileStream.Create(TmpFileName,fmCreate);
+      end;
+    Try
+      With CreateCompressor(Item, FinFile,ZipStream) do
+        Try
+          OnProgress:=Self.OnProgress;
+          OnPercent:=Self.OnPercent;
+          Compress;
+          CRC:=Crc32Val;
+          ZMethod:=ZipID;
+        Finally
+          Free;
+        end;
+      If UpdateZipHeader(Item,ZipStream,CRC,ZMethod) then
+        // Compressed file smaller than original file.
+        FOutFile.CopyFrom(ZipStream,0)
+      else
+        begin
+        // Original file smaller than compressed file.
+        FInfile.Seek(0,soFromBeginning);
+        FOutFile.CopyFrom(FInFile,0);
+        end;
+    finally
+      ZipStream.Free;
+      If (TmpFileName<>'') then
+        DeleteFile(TmpFileName);
+    end;
+  Finally
+    CloseInput;
+  end;  
+end;
+
+Procedure TShrinker.DoOnProgress(Const Pct: Double);
+
+begin
+  If Assigned(FOnProgress) then
+    FOnProgress(Self,Pct);
+end;
+
+
+Procedure TZipper.ZipAllFiles;
+Var
+   Item : TZipItem;
+   I : Integer;
+   
+Begin
+  FZipping:=True;
+  Try
+    GetFileInfo;
+    OpenOutput;
+    Try
+      For I:=0 to FFiles.Count-1 do
+        begin
+        Item:=FFiles.Objects[i] as TZipItem;
+        ZipOneFile(Item);
+        end;
+      BuildZipDirectory;
+    Finally
+       CloseOutput;
+    end;
+  finally
+    FZipping:=False;
+  end;
+end;
+
+
+Procedure TZipper.SetBufSize(Value : Cardinal);
+
+begin
+  If FZipping then
+    Raise EZipError.Create('Changing buffer size is not allowed while zipping');
+  If Value>=DefaultBufSize then
+    FBufSize:=Value;
+end;
+
+Procedure TZipper.SetFileName(Value : String);
+
+begin
+  If FZipping then
+    Raise EZipError.Create('Changing output file name is not allowed while zipping');
+  FFileName:=Value;
+end;
+
+Procedure TZipper.ZipFiles(AFileName : String; FileList : TStringList);
+
+begin
+  FFiles.Assign(FileList);
+  FFileName:=AFileName;
+  ZipAllFiles;
+end;
+
+Procedure TZipper.DoEndOfFile;
+
+Var
+  ComprPct : Double;
+
+begin
+  If (LocalHdr.Uncompressed_Size>0) then
+    ComprPct := (100.0 * (LocalHdr.Uncompressed_Size - LocalHdr.Compressed_Size)) / LocalHdr.Uncompressed_Size
+  else
+    ComprPct := 0;
+  If Assigned(FOnEndOfFile) then
+    FOnEndOfFile(Self,ComprPct);
+end;
+
+Constructor TZipper.Create;
+
+begin
+  FBufSize:=DefaultBufSize;
+  FInMemSize:=DefaultInMemSize;
+  FFiles:=TStringList.Create;
+  TStringlist(FFiles).Sorted:=True;
+  FOnPercent:=1;
+end;
+
+Procedure TZipper.Clear;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to FFiles.Count-1 do
+    FFiles.Objects[i].Free;
+  FFiles.Clear;  
+end;
+
+Destructor TZipper.Destroy;
+ 
+begin
+  Clear;
+  FreeAndNil(FFiles);
+  Inherited;
+end;
+
+End.

fcl/tests/README

@@ -65,3 +65,4 @@ ipcclient    Client part of SimpleIPC unit test, console app (MVC)
 testdebug    Client part of dbugintf debugging info test (MVC)
 testbf.pp    Test for BlowFish encryption (MVC)
 testbfs.pp   Test for BlowFish encryption/descryption stream (MVC)
+testzip.pp   Test for TZipper class (MVC)

fcl/tests/testzip.pp

@@ -0,0 +1,34 @@
+{
+    $Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+Program testzip;
+
+uses Classes,Zipper;
+
+Var
+  S : TStringList;
+  I : Integer;
+
+begin
+  S:=TStringList.Create;
+  For I:=2 to ParamCount do
+    S.Add(ParamStr(I));
+  With TZipper.Create do
+    try
+      ZipFiles(ParamStr(1),S);
+    Finally
+      Free;
+    end;  
+end.