paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-25 18:01:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

TZipper: set the compression level bit flag in the file header of deflate compressed files

Browse Source 
git-svn-id: trunk@22372 -
This commit is contained in:
nickysn 2012-09-11 21:22:34 +00:00
parent 3a6446e6d1
commit 0e1b582131
1 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
packages/paszlib/src/zipper.pp
View File

@ -137,6 +137,7 @@ Type
Procedure Compress; Virtual; Abstract;
Class Function ZipID : Word; virtual; Abstract;
Class Function ZipVersionReqd: Word; virtual; Abstract;
Function ZipBitFlag: Word; virtual; Abstract;
Property BufferSize : LongWord read FBufferSize;
Property OnPercent : Integer Read FOnPercent Write FOnPercent;
Property OnProgress : TProgressEvent Read FOnProgress Write FOnProgress;
@ -228,6 +229,7 @@ Type
Procedure Compress; override;
Class Function ZipID : Word; override;
Class Function ZipVersionReqd : Word; override;
Function ZipBitFlag : Word; override;
end;
{ TDeflater }
@ -240,6 +242,7 @@ Type
Procedure Compress; override;
Class Function ZipID : Word; override;
Class Function ZipVersionReqd : Word; override;
Function ZipBitFlag : Word; override;
Property CompressionLevel : TCompressionlevel Read FCompressionLevel Write FCompressionLevel;
end;
@ -323,7 +326,7 @@ Type
Protected
Procedure CloseInput(Item : TZipFileEntry);
Procedure StartZipFile(Item : TZipFileEntry);
Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word) : Boolean;
Function UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord;AMethod : Word; AZipVersionReqd : Word; AZipBitFlag : Word) : Boolean;
Procedure BuildZipDirectory;
Procedure DoEndOfFile;
Procedure ZipOneFile(Item : TZipFileEntry); virtual;
@ -728,6 +731,18 @@ begin
Result:=20;
end;
function TDeflater.ZipBitFlag: Word;
begin
case CompressionLevel of
clnone: Result := %110;
clfastest: Result := %100;
cldefault: Result := %000;
clmax: Result := %010;
else
Result := 0;
end;
end;
{ ---------------------------------------------------------------------
TInflater
---------------------------------------------------------------------}
@ -870,6 +885,11 @@ begin
Result:=10;
end;
function TShrinker.ZipBitFlag: Word;
begin
Result:=0;
end;
Procedure TShrinker.DoOnProgress(Const Pct: Double);
@ -1268,7 +1288,9 @@ Begin
End;
Function TZipper.UpdateZipHeader(Item : TZipFileEntry; FZip : TStream; ACRC : LongWord; AMethod : Word; AZipVersionReqd : Word) : Boolean;
function TZipper.UpdateZipHeader(Item: TZipFileEntry; FZip: TStream;
ACRC: LongWord; AMethod: Word; AZipVersionReqd: Word; AZipBitFlag: Word
): Boolean;
var
ZFileName : ShortString;
Begin
@ -1287,6 +1309,7 @@ Begin
begin
Compress_method:=AMethod;
Compressed_Size := FZip.Size;
Bit_Flag := Bit_Flag or AZipBitFlag;
if AZipVersionReqd > Extract_Version_Reqd then
Extract_Version_Reqd := AZipVersionReqd;
end;
@ -1381,6 +1404,7 @@ Var
CRC : LongWord;
ZMethod : Word;
ZVersionReqd : Word;
ZBitFlag : Word;
ZipStream : TStream;
TmpFileName : String;
@ -1404,10 +1428,11 @@ Begin
CRC:=Crc32Val;
ZMethod:=ZipID;
ZVersionReqd:=ZipVersionReqd;
ZBitFlag:=ZipBitFlag;
Finally
Free;
end;
If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd) then
If UpdateZipHeader(Item,ZipStream,CRC,ZMethod,ZVersionReqd,ZBitFlag) then
// Compressed file smaller than original file.
FOutStream.CopyFrom(ZipStream,0)
else