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

git-svn-id: trunk@22372 -

packages/paszlib/src/zipper.pp

@@ -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