FastReport_FMX_2.8.12/LibD28x64/FMX.frxGZip.pas

{******************************************}
{                                          }
{             FastReport v4.0              }
{         GZIP compress/decompress         }
{                                          }
{          Copyright (c) 2004-2008         }
{          by Alexander Fediachov,         }
{             Fast Reports, Inc.           }
{                                          }
{******************************************}

unit FMX.frxGZip;

interface

{$I fmx.inc}
{$I frx.inc}

uses 
  System.Classes, System.ZLib,
  FMX.frxClass;


type
  TfrxCompressionLevel = (gzNone, gzFastest, gzDefault, gzMax);

{$I frxFMX_PlatformsAttribute.inc}
  TfrxGZipCompressor = class(TfrxCustomCompressor)
  public
    procedure Compress(Dest: TStream); override;
    function Decompress(Source: TStream): Boolean; override;
  end;


procedure frxCompressStream(Source, Dest: TStream;
  Compression: TfrxCompressionLevel = gzDefault; FileNameW: String = '');
function frxDecompressStream(Source, Dest: TStream): AnsiString;
procedure frxDeflateStream(Source, Dest: TStream;
  Compression: TfrxCompressionLevel = gzDefault);
procedure frxInflateStream(Source, Dest: TStream);


implementation

uses
  System.SysConst, System.SysUtils, FMX.frxUtils;

procedure frxCompressStream(Source, Dest: TStream;
  Compression: TfrxCompressionLevel = gzDefault; FileNameW: String = '');
var
  header: array [0..3] of Byte;
  Compressor: TZCompressionStream;
  Size: Cardinal;
  CRC: Cardinal;
  FileName: AnsiString;
begin
  CRC := frxStreamCRC32(Source);
  Size := Source.Size;
  FileName := AnsiString(FileNameW);
  if FileName = '' then
    FileName := '1';
  FileName := FileName + #0;

  // put gzip header
  header[0] := $1f; // ID1 (IDentification 1)
  header[1] := $8b; // ID2 (IDentification 2)
  header[2] := $8;  // CM (Compression Method) CM = 8 denotes the "deflate"
  header[3] := $8;  // FLG (FLaGs) bit 3   FNAME
  Dest.Write(header, 4);

  // reserve 4 bytes in MTIME field
  Dest.Write(header, 4);

  header[0] := 0; // XFL (eXtra FLags) XFL = 2 - compressor used maximum compression
  header[1] := 0; // OS (Operating System) 0 - FAT filesystem (MS-DOS, OS/2, NT/Win32)
  Dest.Write(header, 2);

  // original file name, zero-terminated
  Dest.Write(FileName[1], Length(FileName));

  // seek back to skip 2 bytes zlib header
  Dest.Seek(Int64(-2), soFromCurrent);

  // put compressed data
  Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression), 15);
  try
    Compressor.CopyFrom(Source, 0);
  finally
    Compressor.Free;
  end;

  // get adler32 checksum
  Dest.Seek(Int64(-4), soFromEnd);
  Dest.Read(header, 4);
  // write it to the header (to MTIME field)
  Dest.Position := 4;
  Dest.Write(header, 4);

  // restore original file name (it was corrupted by zlib header)
  Dest.Seek(Int64(2), soFromCurrent);
  Dest.Write(FileName[1], Length(FileName));

  // put crc32 and length
  Dest.Seek(Int64(-4), soFromEnd);
  Dest.Write(CRC, 4);
  Dest.Write(Size, 4);
end;

function frxDecompressStream(Source, Dest: TStream): AnsiString;
var
  s: AnsiString;
  header: array [0..3] of byte;
  adler32: Integer;
  FTempStream: TMemoryStream;
  UnknownPtr: Pointer;
  NewSize: Integer;
begin
  s := '';

  // read gzip header
  Source.Read(header, 4);
  if (header[0] = $1f) and (header[1] = $8b) and (header[2] = $8) then
  begin
    Source.Read(adler32, 4);
    Source.Read(header, 2);
    if (header[3] and $8) <> 0 then
    begin
      Source.Read(header, 1);
      while header[0] <> 0 do
      begin
        s := s + AnsiChar(Char(header[0]));
        Source.Read(header, 1);
      end;
    end;
  end;

  FTempStream := TMemoryStream.Create;
  try
    // put zlib header
    s := #$78#$DA;
    FTempStream.Write(s[1], 2);
    // put compressed data, skip gzip's crc32 and filelength
    FTempStream.CopyFrom(Source, Source.Size - Source.Position - 8);
    // put adler32
    FTempStream.Write(adler32, 4);

    // uncompress data and save it to the Dest
    ZDeCompress(FTempStream.Memory, FTempStream.Size, UnknownPtr, NewSize);
    Dest.Write(UnknownPtr^, NewSize);
    FreeMem(UnknownPtr, NewSize);
  finally
    FTempStream.Free;
  end;
  Result := s;
end;

procedure frxDeflateStream(Source, Dest: TStream;
  Compression: TfrxCompressionLevel = gzDefault);

var
  Compressor: TZCompressionStream;
{$IFDEF DELPHI28}
  function OldCopyFrom(const Source: TStream; Count: Int64; BufferSize: Integer): Int64;
  var
    N: Integer;
    Buffer: TBytes;
  begin
    if BufferSize <= 0 then
      raise ERangeError.CreateRes(@SRangeError);
    if Count <= 0 then
    begin
      Source.Position := 0;
      Count := Source.Size;
    end;
    Result := Count;
    if Count < BufferSize then BufferSize := Count;
    SetLength(Buffer, BufferSize);
    try
      while Count <> 0 do
      begin
        if Count > BufferSize then N := BufferSize else N := Count;
        Source.ReadBuffer(Buffer, N);
        Compressor.WriteBuffer(Buffer, N);
        Dec(Count, N);
      end;
    finally
      SetLength(Buffer, 0);
    end;
  end;
{$ENDIF}
begin
  Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression), 15);
  try
{$IFDEF DELPHI28}
    OldCopyFrom(Source, 0, $100000);
{$ELSE}
    Compressor .CopyFrom(Source, 0);
{$ENDIF}
  finally
    Compressor.Free;
  end;
end;

procedure frxInflateStream(Source, Dest: TStream);
var
  FTempStream: TMemoryStream;
  UnknownPtr: Pointer;
  NewSize: Integer;
begin
  FTempStream := TMemoryStream.Create;
  try
    FTempStream.CopyFrom(Source, 0);
    // uncompress data and save it to the Dest
    ZDeCompress(FTempStream.Memory, FTempStream.Size, UnknownPtr, NewSize);
    Dest.Write(UnknownPtr^, NewSize);
    FreeMem(UnknownPtr, NewSize);
  finally
    FTempStream.Free;
  end;
end;


{ TfrxGZipCompressor }

procedure TfrxGZipCompressor.Compress(Dest: TStream);
var
  Compression: TfrxCompressionLevel;
  FileName: String;
begin
  if IsFR3File then
  begin
    Compression := gzMax;
    FileName := '1.fr3';
  end
  else
  begin
    Compression := gzDefault;
    FileName := '1.fp3';
  end;
  frxCompressStream(Stream, Dest, Compression, FileName);
end;

function TfrxGZipCompressor.Decompress(Source: TStream): Boolean;
var
  Signature: array[0..1] of Byte;
begin
  Source.Read(Signature, 2);
  Source.Seek(Int64(-2), soFromCurrent);
  Result := (Signature[0] = $1F) and (Signature[1] = $8B);
  if Result then
    frxDecompressStream(Source, Stream);
  Stream.Position := 0;
end;

end.