{
    $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.

 **********************************************************************}
{
  Copy from the zipper unit from FPC 2.3.1 rev 12624

  Remove it after a new FPC with the fixes from this unit is released!
}
{$mode objfpc}
{$h+}
unit fpszipper;

Interface

Uses
   SysUtils,Classes,ZStream;


Const
  { Signatures }
  END_OF_CENTRAL_DIR_SIGNATURE  = $06054B50;
  LOCAL_FILE_HEADER_SIGNATURE   = $04034B50;
  CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;

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                  :  LongWord;
     Compressed_Size        :  LongInt;
     Uncompressed_Size      :  LongInt;
     Filename_Length        :  Word;
     Extra_Field_Length     :  Word;
   end;

  { Define the Central Directory record types }

  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                :  LongWord;
    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;

  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 LongWord = (
    $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

  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   : LongWord;       { CRC calculation variable                   }
    FBufferSize : LongWord;
    FOnPercent  : Integer;
    FOnProgress : TProgressEvent;
    Procedure UpdC32(Octet: Byte);
  Public
    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
    Procedure Compress; Virtual; Abstract;
    Class Function ZipID : Word; virtual; Abstract;
    Property BufferSize : LongWord read FBufferSize;
    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
    Property Crc32Val : LongWord Read FCrc32Val Write FCrc32Val;
  end;

  { TDeCompressor }
  TDeCompressor = Class(TObject)
  Protected
    FInFile     : TStream;        { I/O file variables                         }
    FOutFile    : TStream;
    FCrc32Val   : LongWord;       { CRC calculation variable                   }
    FBufferSize : LongWord;
    FOnPercent  : Integer;
    FOnProgress : TProgressEvent;
    Procedure UpdC32(Octet: Byte);
  Public
    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
    Procedure DeCompress; Virtual; Abstract;
    Class Function ZipID : Word; virtual; Abstract;
    Property BufferSize : LongWord read FBufferSize;
    Property OnPercent : Integer Read FOnPercent Write FOnPercent;
    Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
    Property Crc32Val : LongWord 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    : LongWord;
    MaxInBufIdx :  LongWord;      { 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   :  LongWord;      { 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;
                           Out 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 : LongWord); 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 : LongWord);override;
    Procedure Compress; override;
    Class Function ZipID : Word; override;
    Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
  end;

  { TInflater }

  TInflater = Class(TDeCompressor)
  Public
    Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord);override;
    Procedure DeCompress; override;
    Class Function ZipID : Word; override;
  end;

  { TZipFileEntry }

  TZipFileEntry = Class(TCollectionItem)
  private
    FArchiveFileName: String;
    FDateTime: TDateTime;
    FDiskFileName: String;
    FHeaderPos: Longint;
    FCentralPos: LongInt;
    FSize: Integer;
    FStream: TStream;
    function GetArchiveFileName: String;
  Protected
    Property HdrPos : Longint Read FHeaderPos Write FheaderPos;
    property CentralPos: LongInt read FCentralPos write FCentralPos;
  Public
    Procedure Assign(Source : TPersistent); override;
    Property Stream : TStream Read FStream Write FStream;
  Published
    Property ArchiveFileName : String Read GetArchiveFileName Write FArchiveFileName;
    Property DiskFileName : String Read FDiskFileName Write FDiskFileName;
    Property Size : Integer Read FSize Write FSize;
    Property DateTime : TDateTime Read FDateTime Write FDateTime;
  end;

  { TZipFileEntries }

  TZipFileEntries = Class(TCollection)
  private
    function GetZ(AIndex : Integer): TZipFileEntry;
    procedure SetZ(AIndex : Integer; const AValue: TZipFileEntry);
  Public
    Function AddFileEntry(Const ADiskFileName : String): TZipFileEntry;
    Function AddFileEntry(Const ADiskFileName, AArchiveFileName : String): TZipFileEntry;
    Function AddFileEntry(Const AStream : TSTream; Const AArchiveFileName : String): TZipFileEntry;
    Property Entries[AIndex : Integer] : TZipFileEntry Read GetZ Write SetZ; default;
  end;


  { TZipper }

  TZipper = Class(TObject)
  Private
    FEntries: TZipFileEntries;
    FZipping    : Boolean;
    FBufSize    : LongWord;
    FFileName   :  String;         { Name of resulting Zip file                 }
    FFiles      : TStrings;
    FInMemSize  : Integer;
    FOutFile    : TFileStream;
    FInFile     : TStream;     { 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;
    function CheckEntries: Integer;
    procedure SetEntries(const AValue: TZipFileEntries);
  Protected
    Procedure OpenOutput;
    Procedure CloseOutput;
    Procedure CloseInput(Item : TZipFileEntry);
    Procedure StartZipFile(Item : TZipFileEntry);
    Function  UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word) : Boolean;
    Procedure BuildZipDirectory;
    Procedure DoEndOfFile;
    Procedure ZipOneFile(Item : TZipFileEntry); virtual;
    Function  OpenInput(Item : TZipFileEntry) : Boolean;
    Procedure GetFileInfo;
    Procedure SetBufSize(Value : LongWord);
    Procedure SetFileName(Value : String);
    Function CreateCompressor(Item : TZipFileEntry; AinFile,AZipStream : TStream) : TCompressor; virtual;
  Public
    Constructor Create;
    Destructor Destroy;override;
    Procedure ZipAllFiles; virtual;
    Procedure ZipFiles(AFileName : String; FileList : TStrings);
    Procedure ZipFiles(AFileName : String; Entries : TZipFileEntries);
    Procedure Clear;
  Public
    Property BufferSize : LongWord 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;
    Property Entries : TZipFileEntries Read FEntries Write SetEntries;
  end;

  { TYbZipper }

  { TUnZipper }

  TUnZipper = Class(TObject)
  Private
    FUnZipping  : Boolean;
    FBufSize    : LongWord;
    FFileName   :  String;         { Name of resulting Zip file                 }
    FOutputPath : String;
    FEntries    : TZipFileEntries;
    FFiles      : TStrings;
    FOutFile    : TFileStream;
    FZipFile     : 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 OpenInput;
    Procedure CloseOutput;
    Procedure CloseInput;
    Procedure ReadZipHeader(Item : TZipFileEntry; out ACRC : LongWord;out AMethod : Word);
    Procedure ReadZipDirectory;
    Procedure DoEndOfFile;
    Procedure UnZipOneFile(Item : TZipFileEntry); virtual;
    Function  OpenOutput(OutFileName : String) : Boolean;
    Procedure SetBufSize(Value : LongWord);
    Procedure SetFileName(Value : String);
    Procedure SetOutputPath(Value:String);
    Function CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor; virtual;
  Public
    Constructor Create;
    Destructor Destroy;override;
    Procedure UnZipAllFiles; virtual;
    Procedure UnZipFiles(AFileName : String; FileList : TStrings);
    Procedure UnZipAllFiles(AFileName : String);
    Procedure Clear;
  Public
    Property BufferSize : LongWord 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 OutputPath : String Read FOutputPath Write SetOutputPath;
    Property Files : TStrings Read FFiles;
    Property Entries : TZipFileEntries Read FEntries Write FEntries;
  end;

  EZipError = Class(Exception);

Implementation

ResourceString
  SErrBufsizeChange = 'Changing buffer size is not allowed while (un)zipping';
  SErrFileChange = 'Changing output file name is not allowed while (un)zipping';
  SErrInvalidCRC = 'Invalid CRC checksum while unzipping %s';
  SErrCorruptZIP = 'Corrupt ZIP file %s';
  SErrUnsupportedCompressionFormat = 'Unsupported compression format %d';
  SErrMissingFileName = 'Missing filename in entry %d';
  SErrMissingArchiveName = 'Missing archive filename in streamed entry %d';
  SErrFileDoesNotExist = 'File "%s" does not exist.';

{ ---------------------------------------------------------------------
    Auxiliary
  ---------------------------------------------------------------------}

{$IFDEF FPC_BIG_ENDIAN}
function SwapLFH(const Values: Local_File_Header_Type): Local_File_Header_Type;
begin
  with Values do
  begin
    Result.Signature := SwapEndian(Signature);
    Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
    Result.Bit_Flag := SwapEndian(Bit_Flag);
    Result.Compress_Method := SwapEndian(Compress_Method);
    Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
    Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
    Result.Crc32 := SwapEndian(Crc32);
    Result.Compressed_Size := SwapEndian(Compressed_Size);
    Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
    Result.Filename_Length := SwapEndian(Filename_Length);
    Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
  end;
end;

function SwapCFH(const Values: Central_File_Header_Type): Central_File_Header_Type;
begin
  with Values do
  begin
    Result.Signature := SwapEndian(Signature);
    Result.MadeBy_Version := SwapEndian(MadeBy_Version);
    Result.Extract_Version_Reqd := SwapEndian(Extract_Version_Reqd);
    Result.Bit_Flag := SwapEndian(Bit_Flag);
    Result.Compress_Method := SwapEndian(Compress_Method);
    Result.Last_Mod_Time := SwapEndian(Last_Mod_Time);
    Result.Last_Mod_Date := SwapEndian(Last_Mod_Date);
    Result.Crc32 := SwapEndian(Crc32);
    Result.Compressed_Size := SwapEndian(Compressed_Size);
    Result.Uncompressed_Size := SwapEndian(Uncompressed_Size);
    Result.Filename_Length := SwapEndian(Filename_Length);
    Result.Extra_Field_Length := SwapEndian(Extra_Field_Length);
    Result.File_Comment_Length := SwapEndian(File_Comment_Length);
    Result.Starting_Disk_Num := SwapEndian(Starting_Disk_Num);
    Result.Internal_Attributes := SwapEndian(Internal_Attributes);
    Result.External_Attributes := SwapEndian(External_Attributes);
    Result.Local_Header_Offset := SwapEndian(Local_Header_Offset);
  end;
end;

function SwapECD(const Values: End_of_Central_Dir_Type): End_of_Central_Dir_Type;
begin
  with Values do
  begin
    Result.Signature := SwapEndian(Signature);
    Result.Disk_Number := SwapEndian(Disk_Number);
    Result.Central_Dir_Start_Disk := SwapEndian(Central_Dir_Start_Disk);
    Result.Entries_This_Disk := SwapEndian(Entries_This_Disk);
    Result.Total_Entries := SwapEndian(Total_Entries);
    Result.Central_Dir_Size := SwapEndian(Central_Dir_Size);
    Result.Start_Disk_Offset := SwapEndian(Start_Disk_Offset);
    Result.ZipFile_Comment_Length := SwapEndian(ZipFile_Comment_Length);
  end;
end;
{$ENDIF FPC_BIG_ENDIAN}

Procedure DateTimeToZipDateTime(DT : TDateTime; out 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;

Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);

Var
  Y,M,D,H,N,S,MS : Word;

begin
  MS:=0;
  S:=(ZT and 31) shl 1;
  N:=(ZT shr 5) and 63;
  H:=(ZT shr 12) and 31;
  D:=ZD and 31;
  M:=(ZD shr 5) and 15;
  Y:=((ZD shr 9) and 127)+1980;
  DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
end;

{ ---------------------------------------------------------------------
    TDeCompressor
  ---------------------------------------------------------------------}


Procedure TDeCompressor.UpdC32(Octet: Byte);

Begin
  FCrc32Val := Crc_32_Tab[Byte(FCrc32Val XOR LongInt(Octet))] XOR ((FCrc32Val SHR 8) AND $00FFFFFF);
end;

constructor TDeCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
begin
  FinFile:=AInFile;
  FoutFile:=AOutFile;
  FBufferSize:=ABufSize;
  CRC32Val:=$FFFFFFFF;
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: LongWord);
begin
  FinFile:=AInFile;
  FoutFile:=AOutFile;
  FBufferSize:=ABufSize;
  CRC32Val:=$FFFFFFFF;
end;


{ ---------------------------------------------------------------------
    TDeflater
  ---------------------------------------------------------------------}

constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
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;

class function TDeflater.ZipID: Word;
begin
  Result:=8;
end;

{ ---------------------------------------------------------------------
    TInflater
  ---------------------------------------------------------------------}

constructor TInflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
begin
  Inherited;
end;


procedure TInflater.DeCompress;

Var
  Buf : PByte;
  I,Count : Integer;
  C : TDeCompressionStream;
begin
  CRC32Val:=$FFFFFFFF;
  Buf:=GetMem(FBufferSize);
  Try
    C:=TDeCompressionStream.Create(FInFile,True);
    Try
      Repeat
        Count:=C.Read(Buf^,FBufferSize);
        For I:=0 to Count-1 do
          UpdC32(Buf[i]);
        FOutFile.Write(Buf^,Count);
      Until (Count=0);
    Finally
      C.Free;
    end;
  Finally
    FreeMem(Buf);
  end;
  Crc32Val:=NOT Crc32Val;
end;

class function TInflater.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 : LongWord);
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;

class function TShrinker.ZipID: Word;
begin
  Result:=1;
end;


Procedure TShrinker.DoOnProgress(Const Pct: Double);

begin
  If Assigned(FOnProgress) then
    FOnProgress(Self,Pct);
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;
                      Out 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
  F : TZipFileEntry;
  Info : TSearchRec;
  I       : Longint;

Begin
  For I := 0 to FEntries.Count-1 do
    begin
    F:=FEntries[i];
    If F.Stream=Nil then
      begin
      If (F.DiskFileName='') then
        Raise EZipError.CreateFmt(SErrMissingFileName,[I]);
      If FindFirst(F.DiskFileName, STDATTR, Info)=0 then
        try
          F.Size:=Info.Size;
          F.DateTime:=FileDateToDateTime(Info.Time);
        finally
          FindClose(Info);
        end
      else
        Raise EZipError.CreateFmt(SErrFileDoesNotExist,[F.DiskFileName]);
      end
    else
      begin
      If (F.ArchiveFileName='') then
        Raise EZipError.CreateFmt(SErrMissingArchiveName,[I]);
      F.Size:=F.Stream.Size;
      end;
    end;
end;


procedure TZipper.SetEntries(const AValue: TZipFileEntries);
begin
  if FEntries=AValue then exit;
  FEntries.Assign(AValue);
end;

Procedure TZipper.OpenOutput;

Begin
  FOutFile:=TFileStream.Create(FFileName,fmCreate);
End;


Function TZipper.OpenInput(Item : TZipFileEntry) : Boolean;

Begin
  If (Item.Stream<>nil) then
    FInFile:=Item.Stream
  else
    FInFile:=TFileStream.Create(Item.DiskFileName,fmOpenRead);
  Result:=True;
  If Assigned(FOnStartFile) then
    FOnStartFile(Self,Item.ArchiveFileName);
End;


Procedure TZipper.CloseOutput;

Begin
  FreeAndNil(FOutFile);
end;


Procedure TZipper.CloseInput(Item : TZipFileEntry);

Begin
  If (FInFile<>Item.Stream) then
    FreeAndNil(FInFile)
  else
    FinFile:=Nil;
end;


Procedure TZipper.StartZipFile(Item : TZipFileEntry);

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 := 0;
    Extra_Field_Length := 0;
  end ;
End;


Function TZipper.UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord; AMethod : Word) : Boolean;
var
  ZFileName  : ShortString;
Begin
  ZFileName:=Item.ArchiveFileName;
  With LocalHdr do
    begin
    FileName_Length := Length(ZFileName);
    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({$IFDEF ENDIAN_BIG}SwapLFH{$ENDIF}(LocalHdr),SizeOf(LocalHdr));
  FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName));
End;


Procedure TZipper.BuildZipDirectory;

Var
   SavePos   : LongInt;
   HdrPos    : LongInt;
   CenDirPos : LongInt;
   ACount    : Word;
   ZFileName  : ShortString;

Begin
   ACount := 0;
   CenDirPos := FOutFile.Position;
   FOutFile.Seek(0,soFrombeginning);             { Rewind output file }
   HdrPos := FOutFile.Position;
   FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
{$IFDEF FPC_BIG_ENDIAN}
   LocalHdr := SwapLFH(LocalHdr);
{$ENDIF}
   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({$IFDEF FPC_BIG_ENDIAN}SwapCFH{$ENDIF}(CentralHdr),SizeOf(CentralHdr));
     FOutFile.WriteBuffer(ZFileName[1],Length(ZFileName));
     Inc(ACount);
     FOutFile.Seek(SavePos + LocalHdr.Compressed_Size,soFromBeginning);
     HdrPos:=FOutFile.Position;
     FOutFile.ReadBuffer(LocalHdr, SizeOf(LocalHdr));
{$IFDEF FPC_BIG_ENDIAN}
     LocalHdr := SwapLFH(LocalHdr);
{$ENDIF}
   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 := ACount;
     Total_Entries := ACount;
     Central_Dir_Size := FOutFile.Size-CenDirPos;
     Start_Disk_Offset := CenDirPos;
     ZipFile_Comment_Length := 0;
     FOutFile.WriteBuffer({$IFDEF FPC_BIG_ENDIAN}SwapECD{$ENDIF}(EndHdr), SizeOf(EndHdr));
     end;
end;

Function TZipper.CreateCompressor(Item : TZipFileEntry; AInFile,AZipStream : TStream) : TCompressor;

begin
  Result:=TDeflater.Create(AinFile,AZipStream,FBufSize);
end;

Procedure TZipper.ZipOneFile(Item : TZipFileEntry);

Var
  CRC : LongWord;
  ZMethod : Word;
  ZipStream : TStream;
  TmpFileName : String;

Begin
  OpenInput(Item);
  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(Item);
  end;
end;

Procedure TZipper.ZipAllFiles;

Var
   I : Integer;
   filecnt : integer;
Begin
  If CheckEntries=0 then
    Exit;
  FZipping:=True;
  Try
    GetFileInfo;
    OpenOutput;
    Try
      filecnt:=0;
      For I:=0 to FEntries.Count-1 do
        begin
        ZipOneFile(FEntries[i]);
        inc(filecnt);
        end;
      if filecnt>0 then
        BuildZipDirectory;
    finally
      CloseOutput;
    end;
  finally
    FZipping:=False;
  end;
end;


Procedure TZipper.SetBufSize(Value : LongWord);

begin
  If FZipping then
    Raise EZipError.Create(SErrBufsizeChange);
  If Value>=DefaultBufSize then
    FBufSize:=Value;
end;

Procedure TZipper.SetFileName(Value : String);

begin
  If FZipping then
    Raise EZipError.Create(SErrFileChange);
  FFileName:=Value;
end;

Procedure TZipper.ZipFiles(AFileName : String; FileList : TStrings);

begin
  FFiles.Assign(FileList);
  FFileName:=AFileName;
  ZipAllFiles;
end;

procedure TZipper.ZipFiles(AFileName: String; Entries: TZipFileEntries);
begin
  FFileName:=AFileName;
  FEntries.Assign(Entries);
  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;
  FEntries:=TZipFileEntries.Create(TZipFileEntry);
  FOnPercent:=1;
end;

Function TZipper.CheckEntries : Integer;

Var
  I : Integer;

begin
  If (FFiles.Count>0) and (FEntries.Count=0) then
    begin
    FEntries.Clear;
    For I:=0 to FFiles.Count-1 do
      begin
      FEntries.AddFileEntry(FFiles[i]);
      end;
    end;
  Result:=FEntries.Count;
end;


Procedure TZipper.Clear;

begin
  FEntries.Clear;
  FFiles.Clear;
end;

Destructor TZipper.Destroy;

begin
  Clear;
  FreeAndNil(FEntries);
  FreeAndNil(FFiles);
  Inherited;
end;


{ ---------------------------------------------------------------------
    TUnZipper
  ---------------------------------------------------------------------}

Procedure TUnZipper.OpenInput;

Begin
  FZipFile:=TFileStream.Create(FFileName,fmOpenRead);
End;


Function TUnZipper.OpenOutput(OutFileName : String) : Boolean;

Begin
  ForceDirectories(ExtractFilePath(OutFileName));
  FOutFile:=TFileStream.Create(OutFileName,fmCreate);
  Result:=True;
  If Assigned(FOnStartFile) then
    FOnStartFile(Self,OutFileName);
End;


Procedure TUnZipper.CloseOutput;

Begin
  FreeAndNil(FOutFile);
end;


Procedure TUnZipper.CloseInput;

Begin
  FreeAndNil(FZipFile);
end;


Procedure TUnZipper.ReadZipHeader(Item : TZipFileEntry; out ACRC : LongWord; out AMethod : Word);

Var
  S : String;
  D : TDateTime;
Begin
  FZipFile.Seek(Item.CentralPos,soFromBeginning);
  FZipFile.ReadBuffer(CentralHdr,SizeOf(CentralHdr));
  FZipFile.Seek(Item.HdrPos,soFromBeginning);
  FZipFile.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
{$IFDEF FPC_BIG_ENDIAN}
  LocalHdr := SwapLFH(LocalHdr);
{$ENDIF}
  With LocalHdr do
    begin
    SetLength(S,Filename_Length);
    FZipFile.ReadBuffer(S[1],Filename_Length);
    FZipFile.Seek(Extra_Field_Length,soCurrent);
    Item.ArchiveFileName:=S;
    Item.DiskFileName:=S;
    Item.Size:=CentralHdr.Uncompressed_Size;
    ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D);
    Item.DateTime:=D;
    ACrc:=CentralHdr.Crc32;
    AMethod:=Compress_method;
    end;
End;


Procedure TUnZipper.ReadZipDirectory;

Var
  i,
  EndHdrPos,
  CenDirPos : LongInt;
  NewNode   : TZipFileEntry;
  S : String;

Begin
  EndHdrPos:=FZipFile.Size-SizeOf(EndHdr);
  if EndHdrPos < 0 then
    raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
  FZipFile.Seek(EndHdrPos,soFromBeginning);
  FZipFile.ReadBuffer(EndHdr, SizeOf(EndHdr));
{$IFDEF FPC_BIG_ENDIAN}
  EndHdr := SwapECD(EndHdr);
{$ENDIF}
  With EndHdr do
    begin
    if Signature <> END_OF_CENTRAL_DIR_SIGNATURE then
      raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
    CenDirPos:=Start_Disk_Offset;
    end;
  FZipFile.Seek(CenDirPos,soFrombeginning);
  for i:=0 to EndHdr.Entries_This_Disk-1 do
    begin
    FZipFile.ReadBuffer(CentralHdr, SizeOf(CentralHdr));
{$IFDEF FPC_BIG_ENDIAN}
    CentralHdr := SwapCFH(CentralHdr);
{$ENDIF}
    With CentralHdr do
      begin
      if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
        raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
      NewNode:=FEntries.Add as TZipFileEntry;
      NewNode.HdrPos := Local_Header_Offset;
      NewNode.CentralPos := FZipFile.Position-SizeOf(CentralHdr);
      SetLength(S,Filename_Length);
      FZipFile.ReadBuffer(S[1],Filename_Length);
      NewNode.ArchiveFileName:=S;
      FZipFile.Seek(Extra_Field_Length+File_Comment_Length,soCurrent);
      end;
   end;
end;

Function TUnZipper.CreateDeCompressor(Item : TZipFileEntry; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor;
begin
  case AMethod of
    8 :
      Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
  else
    raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
  end;
end;

Procedure TUnZipper.UnZipOneFile(Item : TZipFileEntry);

Var
  Count : Longint;
  CRC : LongWord;
  ZMethod : Word;
  OutputFileName : string;
Begin
  Try
    ReadZipHeader(Item,CRC,ZMethod);
    OutputFileName:=Item.DiskFileName;
    if FOutputPath<>'' then
      OutputFileName:=IncludeTrailingPathDelimiter(FOutputPath)+OutputFileName;
    OpenOutput(OutputFileName);
    if ZMethod=0 then
      begin
        Count:=FOutFile.CopyFrom(FZipFile,CentralHdr.Compressed_Size);
{$warning TODO: Implement CRC Check}
      end
    else
      With CreateDecompressor(Item, ZMethod, FZipFile, FOutFile) do
        Try
          OnProgress:=Self.OnProgress;
          OnPercent:=Self.OnPercent;
          DeCompress;
          if CRC<>Crc32Val then
            raise EZipError.CreateFmt(SErrInvalidCRC,[Item.ArchiveFileName]);
        Finally
          Free;
        end;
  Finally
    CloseOutput;
  end;
end;


Procedure TUnZipper.UnZipAllFiles;
Var
   Item : TZipFileEntry;
   I : Integer;
   AllFiles : Boolean;

Begin
  FUnZipping:=True;
  Try
    AllFiles:=(FFiles.Count=0);
    OpenInput;
    Try
      ReadZipDirectory;
      For I:=0 to FEntries.Count-1 do
        begin
        Item:=FEntries[i];
        if AllFiles or (FFiles.IndexOf(Item.ArchiveFileName)<>-1) then
          UnZipOneFile(Item);
        end;
    Finally
      CloseInput;
    end;
  finally
    FUnZipping:=False;
  end;
end;


Procedure TUnZipper.SetBufSize(Value : LongWord);

begin
  If FUnZipping then
    Raise EZipError.Create(SErrBufsizeChange);
  If Value>=DefaultBufSize then
    FBufSize:=Value;
end;

Procedure TUnZipper.SetFileName(Value : String);

begin
  If FUnZipping then
    Raise EZipError.Create(SErrFileChange);
  FFileName:=Value;
end;

Procedure TUnZipper.SetOutputPath(Value:String);
begin
  If FUnZipping then
    Raise EZipError.Create(SErrFileChange);
  FOutputPath:=Value;
end;

Procedure TUnZipper.UnZipFiles(AFileName : String; FileList : TStrings);

begin
  FFiles.Assign(FileList);
  FFileName:=AFileName;
  UnZipAllFiles;
end;

Procedure TUnZipper.UnZipAllFiles(AFileName : String);

begin
  FFileName:=AFileName;
  UnZipAllFiles;
end;

Procedure TUnZipper.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 TUnZipper.Create;

begin
  FBufSize:=DefaultBufSize;
  FFiles:=TStringList.Create;
  TStringlist(FFiles).Sorted:=True;
  FEntries:=TZipFileEntries.Create(TZipFileEntry);
  FOnPercent:=1;
end;

Procedure TUnZipper.Clear;

begin
  FFiles.Clear;
  FEntries.Clear;
end;

Destructor TUnZipper.Destroy;

begin
  Clear;
  FreeAndNil(FFiles);
  FreeAndNil(FEntries);
  Inherited;
end;

{ TZipFileEntry }

function TZipFileEntry.GetArchiveFileName: String;
begin
  Result:=FArchiveFileName;
  If (Result='') then
    Result:=FDiskFileName;
end;

procedure TZipFileEntry.Assign(Source: TPersistent);

Var
  Z : TZipFileEntry;

begin
  if Source is TZipFileEntry then
    begin
    Z:=Source as TZipFileEntry;
    FArchiveFileName:=Z.FArchiveFileName;
    FDiskFileName:=Z.FDiskFileName;
    FSize:=Z.FSize;
    FDateTime:=Z.FDateTime;
    FStream:=Z.FStream;
    end
  else
    inherited Assign(Source);
end;

{ TZipFileEntries }

function TZipFileEntries.GetZ(AIndex : Integer): TZipFileEntry;
begin
  Result:=TZipFileEntry(Items[AIndex]);
end;

procedure TZipFileEntries.SetZ(AIndex : Integer; const AValue: TZipFileEntry);
begin
  Items[AIndex]:=AValue;
end;

function TZipFileEntries.AddFileEntry(const ADiskFileName: String
  ): TZipFileEntry;
begin
  Result:=Add as TZipFileEntry;
  Result.DiskFileName:=ADiskFileName;
end;

function TZipFileEntries.AddFileEntry(const ADiskFileName,
  AArchiveFileName: String): TZipFileEntry;
begin
  Result:=AddFileEntry(ADiskFileName);
  Result.ArchiveFileName:=AArchiveFileName;
end;

function TZipFileEntries.AddFileEntry(const AStream: TSTream;
  const AArchiveFileName: String): TZipFileEntry;
begin
  Result:=Add as TZipFileEntry;
  Result.Stream:=AStream;
  Result.ArchiveFileName:=AArchiveFileName;
end;

End.
