mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 13:09:32 +02:00
* TUnzipper added
git-svn-id: trunk@6448 -
This commit is contained in:
peter
parent
2fe7c8ec82
commit
cb0007eb24
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1061,6 +1061,7 @@ fcl/tests/testrsre.pp svneol=native#text/plain
|
||||
fcl/tests/testrtf.pp svneol=native#text/plain
|
||||
fcl/tests/testser.pp svneol=native#text/plain
|
||||
fcl/tests/testsres.pp svneol=native#text/plain
|
||||
fcl/tests/testunzip.pp svneol=native#text/plain
|
||||
fcl/tests/testur.pp svneol=native#text/plain
|
||||
fcl/tests/testweb.pp svneol=native#text/plain
|
||||
fcl/tests/testz.pp svneol=native#text/plain
|
||||
|
||||
@ -17,12 +17,21 @@ unit zipper;
|
||||
|
||||
Interface
|
||||
|
||||
Uses
|
||||
SysUtils,Classes, ZStream;
|
||||
Uses
|
||||
SysUtils,Classes,Contnrs,ZStream;
|
||||
|
||||
|
||||
Const
|
||||
LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
|
||||
{ Signatures }
|
||||
{$ifdef FPC_BIG_ENDIAN}
|
||||
END_OF_CENTRAL_DIR_SIGNATURE = $504B0506;
|
||||
LOCAL_FILE_HEADER_SIGNATURE = $504B0304;
|
||||
CENTRAL_FILE_HEADER_SIGNATURE = $504B0102;
|
||||
{$else FPC_BIG_ENDIAN}
|
||||
END_OF_CENTRAL_DIR_SIGNATURE = $06054B50;
|
||||
LOCAL_FILE_HEADER_SIGNATURE = $04034B50;
|
||||
CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
|
||||
{$endif FPC_BIG_ENDIAN}
|
||||
|
||||
Type
|
||||
Local_File_Header_Type = Packed Record
|
||||
@ -32,19 +41,15 @@ Type
|
||||
Compress_Method : Word;
|
||||
Last_Mod_Time : Word;
|
||||
Last_Mod_Date : Word;
|
||||
Crc32 : LongInt;
|
||||
Crc32 : LongWord;
|
||||
Compressed_Size : LongInt;
|
||||
Uncompressed_Size : LongInt;
|
||||
Filename_Length : Word;
|
||||
Extra_Field_Length : Word;
|
||||
end;
|
||||
|
||||
{ Define the Central Directory record types }
|
||||
{ Define the Central Directory record types }
|
||||
|
||||
Const
|
||||
CENTRAL_FILE_HEADER_SIGNATURE = $02014B50;
|
||||
|
||||
Type
|
||||
Central_File_Header_Type = Packed Record
|
||||
Signature : LongInt;
|
||||
MadeBy_Version : Word;
|
||||
@ -53,7 +58,7 @@ Type
|
||||
Compress_Method : Word;
|
||||
Last_Mod_Time : Word;
|
||||
Last_Mod_Date : Word;
|
||||
Crc32 : LongInt;
|
||||
Crc32 : LongWord;
|
||||
Compressed_Size : LongInt;
|
||||
Uncompressed_Size : LongInt;
|
||||
Filename_Length : Word;
|
||||
@ -65,10 +70,6 @@ Type
|
||||
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;
|
||||
@ -81,7 +82,7 @@ Type
|
||||
end;
|
||||
|
||||
Const
|
||||
Crc_32_Tab : Array[0..255] of LongInt = (
|
||||
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,
|
||||
@ -123,39 +124,60 @@ Type
|
||||
Name : String;
|
||||
Size : LongInt;
|
||||
DateTime : TDateTime;
|
||||
HdrPos : Longint;
|
||||
end;
|
||||
|
||||
TProgressEvent = Procedure(Sender : TObject; Const Pct : Double) of object;
|
||||
TOnEndOfFileEvent = Procedure(Sender : TObject; Const Ratio : 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;
|
||||
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 : Cardinal); virtual;
|
||||
Constructor Create(AInFile, AOutFile : TStream; ABufSize : LongWord); virtual;
|
||||
Procedure Compress; Virtual; Abstract;
|
||||
Class Function ZipID : Word; virtual; Abstract;
|
||||
Property BufferSize : Cardinal read FBufferSize;
|
||||
Property BufferSize : LongWord read FBufferSize;
|
||||
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
|
||||
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
|
||||
Property Crc32Val : Longint Read FCrc32Val Write FCrc32Val;
|
||||
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;
|
||||
TABLESIZE = 8191;
|
||||
FIRSTENTRY = 257;
|
||||
|
||||
Type
|
||||
CodeRec = Packed Record
|
||||
@ -170,11 +192,11 @@ Type
|
||||
FreeListArray = Array[FIRSTENTRY..TABLESIZE] of Word;
|
||||
|
||||
BufPtr = PByte;
|
||||
|
||||
|
||||
TShrinker = Class(TCompressor)
|
||||
Private
|
||||
FBufSize : Cardinal;
|
||||
MaxInBufIdx : Cardinal; { Count of valid chars in input buffer }
|
||||
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 }
|
||||
@ -185,7 +207,7 @@ Type
|
||||
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 }
|
||||
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 }
|
||||
@ -206,35 +228,44 @@ Type
|
||||
Procedure Table_Add(Prefix : Word; Suffix : Byte);
|
||||
function Table_Lookup(TargetPrefix : Smallint;
|
||||
TargetSuffix : Byte;
|
||||
Var FoundAt : Smallint) : Boolean;
|
||||
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 : Cardinal); override;
|
||||
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 : Cardinal);override;
|
||||
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;
|
||||
|
||||
{ TZipper }
|
||||
|
||||
TZipper = Class(TObject)
|
||||
Private
|
||||
FZipping : Boolean;
|
||||
FBufSize : Cardinal;
|
||||
FBufSize : LongWord;
|
||||
FFileName : String; { Name of resulting Zip file }
|
||||
FFiles : TStrings;
|
||||
FInMemSize : Integer;
|
||||
@ -243,33 +274,32 @@ Type
|
||||
LocalHdr : Local_File_Header_Type;
|
||||
CentralHdr : Central_File_Header_Type;
|
||||
EndHdr : End_of_Central_Dir_Type;
|
||||
|
||||
FOnPercent : LongInt;
|
||||
FOnProgress : TProgressEvent;
|
||||
FOnEndOfFile : TOnEndOfFileEvent;
|
||||
FOnEndOfFile : TOnEndOfFileEvent;
|
||||
FOnStartFile : TOnStartFileEvent;
|
||||
Protected
|
||||
Protected
|
||||
Procedure OpenOutput;
|
||||
Procedure CloseOutput;
|
||||
Procedure CloseInput;
|
||||
Procedure StartZipFile(Item : TZipItem);
|
||||
Function UpdateZipHeader(Item : TZipItem; FZip : TStream; ACRC : Integer;AMethod : Word) : Boolean;
|
||||
Function UpdateZipHeader(Item : TZipItem; FZip : TStream; ACRC : LongWord;AMethod : Word) : Boolean;
|
||||
Procedure BuildZipDirectory;
|
||||
Procedure DoEndOfFile;
|
||||
Procedure ZipOneFile(Item : TZipItem); virtual;
|
||||
Function OpenInput(InFileName : String) : Boolean;
|
||||
Procedure GetFileInfo;
|
||||
Procedure SetBufSize(Value : Cardinal);
|
||||
Procedure SetBufSize(Value : LongWord);
|
||||
Procedure SetFileName(Value : String);
|
||||
Function CreateCompressor(Item : TZipItem; AinFile,AZipStream : TStream) : TCompressor; virtual;
|
||||
Public
|
||||
Constructor Create;
|
||||
Destructor Destroy;
|
||||
Destructor Destroy;override;
|
||||
Procedure ZipAllFiles; virtual;
|
||||
Procedure ZipFiles(AFileName : String; FileList : TStrings);
|
||||
Procedure Clear;
|
||||
Public
|
||||
Property BufferSize : Cardinal Read FBufSize Write SetBufSize;
|
||||
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;
|
||||
@ -279,19 +309,75 @@ Type
|
||||
Property InMemSize : Integer Read FInMemSize Write FInMemSize;
|
||||
end;
|
||||
|
||||
{ TYbZipper }
|
||||
|
||||
{ TUnZipper }
|
||||
|
||||
TUnZipper = Class(TObject)
|
||||
Private
|
||||
FUnZipping : Boolean;
|
||||
FBufSize : LongWord;
|
||||
FFileName : String; { Name of resulting Zip file }
|
||||
FOutputPath : String;
|
||||
FFiles : TStrings;
|
||||
FZipEntries : TFPObjectList;
|
||||
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 : TZipItem; out ACRC : LongWord;out AMethod : Word);
|
||||
Procedure ReadZipDirectory;
|
||||
Procedure DoEndOfFile;
|
||||
Procedure UnZipOneFile(Item : TZipItem); virtual;
|
||||
Function OpenOutput(OutFileName : String) : Boolean;
|
||||
Procedure SetBufSize(Value : LongWord);
|
||||
Procedure SetFileName(Value : String);
|
||||
Procedure SetOutputPath(Value:String);
|
||||
Function CreateDeCompressor(Item : TZipItem; 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;
|
||||
end;
|
||||
|
||||
EZipError = Class(Exception);
|
||||
|
||||
Implementation
|
||||
|
||||
ResourceString
|
||||
SErrBufsizeChange = 'Changing buffer size is not allowed while zipping';
|
||||
SErrOutputFileChange = 'Changing output file name is not allowed while zipping';
|
||||
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';
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Auxiliary
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Procedure DateTimeToZipDateTime(DT : TDateTime; Var ZD,ZT : Word);
|
||||
|
||||
Procedure DateTimeToZipDateTime(DT : TDateTime; out ZD,ZT : Word);
|
||||
|
||||
Var
|
||||
Y,M,D,H,N,S,MS : Word;
|
||||
@ -304,10 +390,46 @@ begin
|
||||
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);
|
||||
|
||||
@ -315,7 +437,7 @@ 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);
|
||||
constructor TCompressor.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
|
||||
begin
|
||||
FinFile:=AInFile;
|
||||
FoutFile:=AOutFile;
|
||||
@ -327,8 +449,8 @@ end;
|
||||
{ ---------------------------------------------------------------------
|
||||
TDeflater
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: Cardinal);
|
||||
|
||||
constructor TDeflater.Create(AInFile, AOutFile: TStream; ABufSize: LongWord);
|
||||
begin
|
||||
Inherited;
|
||||
FCompressionLevel:=clDefault;
|
||||
@ -341,7 +463,7 @@ Var
|
||||
Buf : PByte;
|
||||
I,Count,NewCount : Integer;
|
||||
C : TCompressionStream;
|
||||
|
||||
|
||||
begin
|
||||
CRC32Val:=$FFFFFFFF;
|
||||
Buf:=GetMem(FBufferSize);
|
||||
@ -370,6 +492,50 @@ 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
|
||||
---------------------------------------------------------------------}
|
||||
@ -384,7 +550,7 @@ Const
|
||||
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);
|
||||
constructor TShrinker.Create(AInFile, AOutFile : TStream; ABufSize : LongWord);
|
||||
begin
|
||||
Inherited;
|
||||
FBufSize:=ABufSize;
|
||||
@ -442,6 +608,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TShrinker.DoOnProgress(Const Pct: Double);
|
||||
|
||||
begin
|
||||
If Assigned(FOnProgress) then
|
||||
FOnProgress(Self,Pct);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TShrinker.FillInputBuffer;
|
||||
|
||||
@ -481,22 +654,22 @@ End;
|
||||
|
||||
procedure TShrinker.PutCode(Code : Smallint);
|
||||
|
||||
var
|
||||
var
|
||||
ACode : LongInt;
|
||||
XSize : Smallint;
|
||||
|
||||
|
||||
begin
|
||||
if (Code=-1) then
|
||||
if (Code=-1) then
|
||||
begin
|
||||
if BitsUsed>0 then
|
||||
PutChar(SaveByte);
|
||||
end
|
||||
else
|
||||
else
|
||||
begin
|
||||
ACode := Longint(Code);
|
||||
XSize := CodeSize+BitsUsed;
|
||||
ACode := (ACode shl BitsUsed) or SaveByte;
|
||||
while (XSize div 8) > 0 do
|
||||
while (XSize div 8) > 0 do
|
||||
begin
|
||||
PutChar(Lo(ACode));
|
||||
ACode := ACode shr 8;
|
||||
@ -513,9 +686,9 @@ Procedure TShrinker.InitializeCodeTable;
|
||||
Var
|
||||
I : Word;
|
||||
Begin
|
||||
For I := 0 to TableSize do
|
||||
For I := 0 to TableSize do
|
||||
begin
|
||||
With CodeTable^[I] do
|
||||
With CodeTable^[I] do
|
||||
begin
|
||||
Child := -1;
|
||||
Sibling := -1;
|
||||
@ -619,18 +792,18 @@ end;
|
||||
|
||||
function TShrinker.Table_Lookup( TargetPrefix : Smallint;
|
||||
TargetSuffix : Byte;
|
||||
Var FoundAt : Smallint ) : Boolean;
|
||||
Out FoundAt : Smallint ) : Boolean;
|
||||
|
||||
var TempPrefix : Smallint;
|
||||
|
||||
begin
|
||||
TempPrefix := TargetPrefix;
|
||||
Table_lookup := False;
|
||||
if CodeTable^[TempPrefix].Child <> -1 then
|
||||
if CodeTable^[TempPrefix].Child <> -1 then
|
||||
begin
|
||||
TempPrefix := CodeTable^[TempPrefix].Child;
|
||||
repeat
|
||||
if CodeTable^[TempPrefix].Suffix = TargetSuffix then
|
||||
if CodeTable^[TempPrefix].Suffix = TargetSuffix then
|
||||
begin
|
||||
Table_lookup := True;
|
||||
break;
|
||||
@ -640,9 +813,9 @@ begin
|
||||
TempPrefix := CodeTable^[TempPrefix].Sibling;
|
||||
until False;
|
||||
end;
|
||||
if Table_Lookup then
|
||||
if Table_Lookup then
|
||||
FoundAt := TempPrefix
|
||||
else
|
||||
else
|
||||
FoundAt := -1;
|
||||
end;
|
||||
|
||||
@ -650,10 +823,10 @@ Procedure TShrinker.Shrink(Suffix : Smallint);
|
||||
|
||||
Const
|
||||
LastCode : Smallint = 0;
|
||||
|
||||
|
||||
Var
|
||||
WhereFound : Smallint;
|
||||
|
||||
|
||||
Begin
|
||||
If FirstCh then
|
||||
begin
|
||||
@ -729,7 +902,7 @@ end;
|
||||
{ ---------------------------------------------------------------------
|
||||
TZipper
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
|
||||
Procedure TZipper.GetFileInfo;
|
||||
|
||||
@ -737,7 +910,7 @@ Var
|
||||
Info : TSearchRec;
|
||||
I : Word;
|
||||
NewNode : TZipItem;
|
||||
|
||||
|
||||
|
||||
Begin
|
||||
For I := 0 to FFiles.Count-1 do
|
||||
@ -805,7 +978,7 @@ Begin
|
||||
End;
|
||||
|
||||
|
||||
Function TZipper.UpdateZipHeader(Item : TZipItem; FZip : TStream; ACRC : Integer; AMethod : Word) : Boolean;
|
||||
Function TZipper.UpdateZipHeader(Item : TZipItem; FZip : TStream; ACRC : LongWord; AMethod : Word) : Boolean;
|
||||
|
||||
Begin
|
||||
With LocalHdr do
|
||||
@ -833,7 +1006,7 @@ Var
|
||||
CenDirPos : LongInt;
|
||||
Entries : Word;
|
||||
ZFileName : ShortString;
|
||||
|
||||
|
||||
Begin
|
||||
Entries := 0;
|
||||
CenDirPos := FOutFile.Position;
|
||||
@ -845,7 +1018,7 @@ Begin
|
||||
FOutFile.ReadBuffer(ZFileName[1], LocalHdr.FileName_Length);
|
||||
SavePos := FOutFile.Position;
|
||||
FillChar(CentralHdr,SizeOf(CentralHdr),0);
|
||||
With CentralHdr do
|
||||
With CentralHdr do
|
||||
begin
|
||||
Signature := CENTRAL_FILE_HEADER_SIGNATURE;
|
||||
MadeBy_Version := LocalHdr.Extract_Version_Reqd;
|
||||
@ -868,7 +1041,7 @@ Begin
|
||||
Until LocalHdr.Signature = CENTRAL_FILE_HEADER_SIGNATURE;
|
||||
FOutFile.Seek(0,soFromEnd);
|
||||
FillChar(EndHdr,SizeOf(EndHdr),0);
|
||||
With EndHdr do
|
||||
With EndHdr do
|
||||
begin
|
||||
Signature := END_OF_CENTRAL_DIR_SIGNATURE;
|
||||
Disk_Number := 0;
|
||||
@ -895,7 +1068,7 @@ Var
|
||||
ZMethod : Word;
|
||||
ZipStream : TStream;
|
||||
TmpFileName : String;
|
||||
|
||||
|
||||
Begin
|
||||
OpenInput(Item.Path+Item.Name);
|
||||
Try
|
||||
@ -934,22 +1107,14 @@ Begin
|
||||
end;
|
||||
Finally
|
||||
CloseInput;
|
||||
end;
|
||||
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
|
||||
@ -970,8 +1135,8 @@ Begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TZipper.SetBufSize(Value : Cardinal);
|
||||
|
||||
Procedure TZipper.SetBufSize(Value : LongWord);
|
||||
|
||||
begin
|
||||
If FZipping then
|
||||
@ -984,7 +1149,7 @@ Procedure TZipper.SetFileName(Value : String);
|
||||
|
||||
begin
|
||||
If FZipping then
|
||||
Raise EZipError.Create(SErrOutputFileChange);
|
||||
Raise EZipError.Create(SErrFileChange);
|
||||
FFileName:=Value;
|
||||
end;
|
||||
|
||||
@ -1028,15 +1193,259 @@ Var
|
||||
begin
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
FFiles.Objects[i].Free;
|
||||
FFiles.Clear;
|
||||
FFiles.Clear;
|
||||
end;
|
||||
|
||||
Destructor TZipper.Destroy;
|
||||
|
||||
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FFiles);
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TUnZipper
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Procedure TUnZipper.OpenInput;
|
||||
|
||||
Begin
|
||||
FZipFile:=TFileStream.Create(FFileName,fmOpenRead);
|
||||
End;
|
||||
|
||||
|
||||
Function TUnZipper.OpenOutput(OutFileName : String) : Boolean;
|
||||
|
||||
Begin
|
||||
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 : TZipItem; out ACRC : LongWord; out AMethod : Word);
|
||||
|
||||
Begin
|
||||
FZipFile.Seek(Item.HdrPos,soFromBeginning);
|
||||
FZipFile.ReadBuffer(LocalHdr,SizeOf(LocalHdr));
|
||||
With LocalHdr do
|
||||
begin
|
||||
SetLength(Item.Name,Filename_Length);
|
||||
FZipFile.ReadBuffer(Item.Name[1],Filename_Length);
|
||||
FZipFile.Seek(Extra_Field_Length,soCurrent);
|
||||
Item.Size:=Uncompressed_Size;
|
||||
ZipDateTimeToDateTime(Last_Mod_Date,Last_Mod_Time,Item.DateTime);
|
||||
ACrc:=Crc32;
|
||||
AMethod:=Compress_method;
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
Procedure TUnZipper.ReadZipDirectory;
|
||||
|
||||
Var
|
||||
i,
|
||||
EndHdrPos,
|
||||
CenDirPos : LongInt;
|
||||
NewNode : TZipItem;
|
||||
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));
|
||||
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));
|
||||
With CentralHdr do
|
||||
begin
|
||||
if Signature<>CENTRAL_FILE_HEADER_SIGNATURE then
|
||||
raise EZipError.CreateFmt(SErrCorruptZIP,[FZipFile.FileName]);
|
||||
NewNode:=TZipItem.Create;
|
||||
NewNode.HdrPos := Local_Header_Offset;
|
||||
SetLength(NewNode.Name,Filename_Length);
|
||||
FZipFile.ReadBuffer(NewNode.Name[1],Filename_Length);
|
||||
FZipFile.Seek(Extra_Field_Length+File_Comment_Length,soCurrent);
|
||||
FZipEntries.Add(NewNode);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TUnZipper.CreateDeCompressor(Item : TZipItem; AMethod : Word;AZipFile,AOutFile : TStream) : TDeCompressor;
|
||||
var
|
||||
Count : Int64;
|
||||
begin
|
||||
case AMethod of
|
||||
8 :
|
||||
Result:=TInflater.Create(AZipFile,AOutFile,FBufSize);
|
||||
else
|
||||
raise EZipError.CreateFmt(SErrUnsupportedCompressionFormat,[AMethod]);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TUnZipper.UnZipOneFile(Item : TZipItem);
|
||||
|
||||
Var
|
||||
Count : Longint;
|
||||
CRC : LongWord;
|
||||
ZMethod : Word;
|
||||
Begin
|
||||
Try
|
||||
ReadZipHeader(Item,CRC,ZMethod);
|
||||
OpenOutput(FOutputPath+Item.Name);
|
||||
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.Name]);
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
Finally
|
||||
CloseOutput;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TUnZipper.UnZipAllFiles;
|
||||
Var
|
||||
Item : TZipItem;
|
||||
I : Integer;
|
||||
|
||||
Begin
|
||||
FUnZipping:=True;
|
||||
Try
|
||||
OpenInput;
|
||||
Try
|
||||
ReadZipDirectory;
|
||||
For I:=0 to FZipEntries.Count-1 do
|
||||
begin
|
||||
Item:=FZipEntries[i] as TZipItem;
|
||||
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;
|
||||
FZipEntries:=TFPObjectList.Create(true);
|
||||
TStringlist(FFiles).Sorted:=True;
|
||||
FOnPercent:=1;
|
||||
end;
|
||||
|
||||
Procedure TUnZipper.Clear;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
FFiles.Objects[i].Free;
|
||||
FFiles.Clear;
|
||||
FZipEntries.Clear;
|
||||
end;
|
||||
|
||||
Destructor TUnZipper.Destroy;
|
||||
|
||||
begin
|
||||
Clear;
|
||||
FreeAndNil(FFiles);
|
||||
FreeAndNil(FZipEntries);
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
End.
|
||||
|
||||
30
fcl/tests/testunzip.pp
Executable file
30
fcl/tests/testunzip.pp
Executable file
@ -0,0 +1,30 @@
|
||||
{
|
||||
$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 testunzip;
|
||||
|
||||
uses Classes,Zipper;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
With TUnZipper.Create do
|
||||
try
|
||||
UnZipAllFiles(ParamStr(1));
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user