{ $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; FSize: Integer; FStream: TStream; function GetArchiveFileName: String; Protected Property HdrPos : Longint Read FHeaderPos Write FheaderPos; 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.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:=Uncompressed_Size; ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,D); Item.DateTime:=D; ACrc:=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; 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,LocalHdr.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.