292 lines
7.5 KiB
ObjectPascal
292 lines
7.5 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ GZIP compress/decompress }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ Fast Reports, Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxGZip;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses {$IFNDEF FPC}Windows, {$ENDIF}Classes, SysUtils,
|
|
{$IFDEF CPUX64}
|
|
{$IFNDEF FPC}
|
|
ZLib,
|
|
{$ELSE}
|
|
frxZLib,
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
frxZLib,
|
|
{$ENDIF}
|
|
frxClass;
|
|
|
|
type
|
|
/// <summary>
|
|
/// The compression level.
|
|
/// </summary>
|
|
TfrxCompressionLevel = (gzNone, gzFastest, gzDefault, gzMax);
|
|
|
|
{$IFDEF DELPHI16}
|
|
/// <summary>
|
|
/// The TfrxGZipCompressor component lets you compress/decompress
|
|
/// FastReport files (.FR3 and .FP3). gzip algorithm is used for
|
|
/// compression.
|
|
/// </summary>
|
|
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
|
|
{$ENDIF}
|
|
TfrxGZipCompressor = class(TfrxCustomCompressor)
|
|
public
|
|
procedure Compress(Dest: TStream); override;
|
|
function Decompress(Source: TStream): Boolean; override;
|
|
end;
|
|
|
|
|
|
/// <summary>
|
|
/// Method compresses the Source stream and saves compressed data to the Dest
|
|
/// stream. gzip algorithm is used for compression. Optional parameter
|
|
/// FileName is used to store the file name into gzip header.
|
|
/// </summary>
|
|
/// <param name="Source">
|
|
/// Source stream
|
|
/// </param>
|
|
/// <param name="Dest">
|
|
/// Destination stream
|
|
/// </param>
|
|
/// <param name="Compression">
|
|
/// Compression level
|
|
/// </param>
|
|
/// <param name="FileNameW">
|
|
/// Used to store the file name into gzip header
|
|
/// </param>
|
|
procedure frxCompressStream(Source, Dest: TStream;
|
|
Compression: TfrxCompressionLevel = gzDefault; {$IFDEF Delphi12}FileNameW{$ELSE}FileName{$ENDIF}: String = '');
|
|
/// <summary>
|
|
/// Method decompresses the Source stream and saves uncompressed data to the
|
|
/// Dest stream. It returns the file name from gzip header.
|
|
/// </summary>
|
|
/// <param name="Source">
|
|
/// Source stream
|
|
/// </param>
|
|
/// <param name="Dest">
|
|
/// Destination stream
|
|
/// </param>
|
|
function frxDecompressStream(Source, Dest: TStream): AnsiString;
|
|
/// <summary>
|
|
/// Method compresses the Source stream and saves compressed data to the Dest
|
|
/// stream. Deflate algorithm is used for compression.
|
|
/// </summary>
|
|
/// <param name="Source">
|
|
/// Source stream
|
|
/// </param>
|
|
/// <param name="Dest">
|
|
/// Destination stream
|
|
/// </param>
|
|
/// <param name="Compression">
|
|
/// Compression level
|
|
/// </param>
|
|
procedure frxDeflateStream(Source, Dest: TStream;
|
|
Compression: TfrxCompressionLevel = gzDefault);
|
|
/// <summary>
|
|
/// Method decompresses the Source stream and saves uncompressed data to the
|
|
/// Dest stream. Inflate algorithm is used for decompression.
|
|
/// </summary>
|
|
/// <param name="Source">
|
|
/// Source stream
|
|
/// </param>
|
|
/// <param name="Dest">
|
|
/// Destination stream
|
|
/// </param>
|
|
procedure frxInflateStream(Source, Dest: TStream);
|
|
|
|
|
|
implementation
|
|
|
|
uses frxUtils;
|
|
|
|
procedure frxCompressStream(Source, Dest: TStream;
|
|
Compression: TfrxCompressionLevel = gzDefault; {$IFDEF Delphi12}FileNameW{$ELSE}FileName{$ENDIF}: String = '');
|
|
var
|
|
header: array [0..3] of Byte;
|
|
Compressor: TZCompressionStream;
|
|
Size: Cardinal;
|
|
CRC: Cardinal;
|
|
{$IFDEF Delphi12}
|
|
FileName: AnsiString;
|
|
{$ENDIF}
|
|
begin
|
|
CRC := frxStreamCRC32(Source);
|
|
Size := Source.Size;
|
|
{$IFDEF Delphi12}
|
|
FileName := AnsiString(FileNameW);
|
|
{$ENDIF}
|
|
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(-2, soFromCurrent);
|
|
|
|
// put compressed data
|
|
Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression){$IFNDEF FPC}{$IFDEF WIN64}, 15 {$ENDIF}{$ENDIF});
|
|
try
|
|
Compressor.CopyFrom(Source, 0);
|
|
finally
|
|
Compressor.Free;
|
|
end;
|
|
|
|
// get adler32 checksum
|
|
Dest.Seek(-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(2, soFromCurrent);
|
|
Dest.Write(FileName[1], Length(FileName));
|
|
|
|
// put crc32 and length
|
|
Dest.Seek(-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;
|
|
begin
|
|
Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression){$IFNDEF FPC}{$IFDEF WIN64}, 15 {$ENDIF}{$ENDIF});
|
|
try
|
|
Compressor.CopyFrom(Source, 0);
|
|
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(-2, soFromCurrent);
|
|
Result := (Signature[0] = $1F) and (Signature[1] = $8B);
|
|
if Result then
|
|
frxDecompressStream(Source, Stream);
|
|
Stream.Position := 0;
|
|
end;
|
|
|
|
end.
|