unit zlib4008;
{$INCLUDE 'jedi.inc'}

{
  Inno Setup
  Copyright (C) 1998-2003 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Declarations for zlib, plus various 'helper' functions

  $jrsoftware: issrc/Projects/zlib.pas,v 1.8 2003/05/25 06:03:04 jr Exp $
}

interface

uses
  SysUtils, FileClass, zlib;

{ *** High-level compression functions *** }

type
  TZStreamRec = {$IFDEF DELPHIXE2_UP} zlib.z_stream {$ELSE} zlib.TZStreamRec {$ENDIF} ;

type
  {$IFDEF DELPHI2009}
  NativeUInt = Longword; // solution for internal error C12079
  {$ENDIF}
  TBlockDeflateHeader = packed record
    CompressedSize, UncompressedSize, Adler: Longint;
  end;

  TNewBlockDeflateHeader = packed record
    CompressedSize, UncompressedSize: Longint;
  end;
  PDeflateBlockReadData = ^TDeflateBlockReadData;
  TDeflateBlockReadData = record
    F: TFile;
    StartPos, InBytesLeft: Longint;
    InBuffer, OutBuffer: array[0..4095] of Byte;
    InBufferCount, OutBufferStart, OutBufferCount: Integer;
    strm: TZStreamRec;
    Compressed, NoMoreData: Boolean;
  end;

procedure InflateBlockReadBegin(F: TFile; var Data: TDeflateBlockReadData);
procedure InflateBlockRead(var Data: TDeflateBlockReadData; var Buf;
  const Count: Cardinal);
procedure InflateBlockReadEnd(var Data: TDeflateBlockReadData);

type
  EZlibError = class(Exception);
  EZlibDataError = class(EZlibError);
  EZlibInternalError = class(EZlibError);

const
  SZlibDataError = 'zlib: Compressed data is corrupted';
  SZlibInternalError = 'zlib: Internal error. Code %d';


implementation

uses Compress, PtrMath;

{$IFNDEF DELPHI2009_UP}
{$L adler32.obj}
function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt; external;
{$ENDIF}

function zlibAllocMem(AppData: Pointer; Items, Size: {$IFDEF DELPHIXE2_UP} Cardinal {$ELSE} Integer {$ENDIF} ): Pointer; {$IFDEF DELPHIXE2_UP} cdecl; {$ELSE} register; {$ENDIF}
begin
  try
    GetMem(Result, Items * Size);
  except
    { trap any exception, because zlib expects a NULL result if it's out
      of memory }
    Result := nil;
  end;
end;

procedure zlibFreeMem(AppData, Block: Pointer); {$IFDEF DELPHIXE2_UP} cdecl; {$ELSE} register; {$ENDIF}
begin
  FreeMem(Block);
end;

function MemCheck(const Code: Integer): Integer;
begin
  if Code = Z_MEM_ERROR then
    OutOfMemoryError;
  Result := Code;
end;

function Check(const Code: Integer; const ValidCodes: array of Integer): Integer;
var
  I: Integer;
begin
  if Code = Z_MEM_ERROR then
    OutOfMemoryError;
  Result := Code;
  for I := Low(ValidCodes) to High(ValidCodes) do
    if ValidCodes[I] = Code then
      Exit;
  raise EZlibInternalError.CreateFmt(SZlibInternalError, [Code]);
end;

const
  BufferSize = {$IFDEF MSWINDOWS} 65536 {$ELSE} 32000 {$ENDIF};

procedure InitStream(var strm: TZStreamRec);
begin
  FillChar(strm, SizeOf(strm), 0);
  with strm do begin
    zalloc := zlibAllocMem;
    zfree := zlibFreeMem;
  end;
end;

const
  Actions: array[Boolean] of Integer = (Z_NO_FLUSH, Z_FINISH);

(*
function CustomDeflateData(const ReadProc: TZReadProc; const WriteProc: TZWriteProc;
  const ExtraData: Longint; const CompressionLevel: TCompressionLevel;
  var BytesWritten, Adler: Longint): Boolean;
var
  strm: TZStreamRec;
  I, O: Pointer;
  Finished: Boolean;
  Res: Integer;
  Written: Longint;
  Successful: Boolean;
begin
  Result := False;
  I := nil;
  O := nil;
  try
    GetMem(I, BufferSize);
    GetMem(O, BufferSize);
    BytesWritten := 0;
    InitStream(strm);
    Res := MemCheck(deflateInit_(strm, CompressionLevel, zlib_version, SizeOf(strm)));
    if Res <> Z_OK then
      raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
    Successful := False;
    try
      Finished := False;
      repeat
        if strm.avail_in = 0 then begin
          strm.next_in := I;
          strm.total_in := 0;
          if not Finished then begin
            strm.avail_in := ReadProc(I^, BufferSize, ExtraData);
            if strm.avail_in = 0 then
              Finished := True;
          end;
        end;
        strm.next_out := O;
        strm.avail_out := BufferSize;
        strm.total_out := 0;
        Res := MemCheck(deflate(strm, Actions[Finished]));
        if (Res <> Z_OK) and (Res <> Z_STREAM_END) then
          raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
        if strm.total_out <> 0 then begin
          Written := WriteProc(O^, strm.total_out, ExtraData);
          Inc(BytesWritten, Written);
          if Written <> strm.total_out then
            Exit;
        end;
      until Res = Z_STREAM_END;
      Adler := strm.adler;
      Successful := True;
    finally
      Res := MemCheck(deflateEnd(strm));
      { The only time Successful will be False if another exception
        was already raised. In that case, don't raise a new one }
      if Successful and (Res <> Z_OK) then
        raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
    end;
  finally
    if Assigned(O) then FreeMem(O {$IFNDEF MSWINDOWS}, BufferSize{$ENDIF});
    if Assigned(I) then FreeMem(I {$IFNDEF MSWINDOWS}, BufferSize{$ENDIF});
  end;
  Result := True;
end;

function CustomInflateData(const ReadProc: TZReadProc; const WriteProc: TZWriteProc;
  const ExtraData: Pointer; var Adler: Longint): Boolean;
var
  strm: TZStreamRec;
  I, O: Pointer;
  Finished: Boolean;
  A: Longint;
  Res: Integer;
begin
  Result := False;
  GetMem(I, BufferSize);
  try
    GetMem(O, BufferSize);
    try
      InitStream(strm);
      A := 1;
      Res := MemCheck(inflateInit_(strm, zlib_version, SizeOf(strm)));
      if Res <> Z_OK then
        raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
      try
        Finished := False;
        repeat
          if strm.avail_in = 0 then begin
            strm.next_in := I;
            strm.total_in := 0;
            if not Finished then begin
              strm.avail_in := ReadProc(I^, BufferSize, ExtraData);
              if strm.avail_in = 0 then
                Finished := True;
            end;
          end;
          strm.next_out := O;
          strm.avail_out := BufferSize;
          strm.total_out := 0;
          Res := MemCheck(inflate(strm, Z_NO_FLUSH));
          case Res of
            Z_OK, Z_STREAM_END: ;
            Z_DATA_ERROR: raise EZlibDataError.Create(SZlibDataError);
          else
            raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
          end;
          if strm.total_out <> 0 then begin
            if {$IFDEF MSWINDOWS}Integer({$ENDIF} WriteProc(O^, strm.total_out, ExtraData)
               {$IFDEF MSWINDOWS}){$ENDIF} <> strm.total_out then
              Exit;
            { For some reason, the adler field of strm gets reset to 1 after the last
              block of data has been decompressed, making it unusable. So it has to
              calculate the Adler-32 itself }
            A := adler32(A, O^, strm.total_out);
          end;
        until Res = Z_STREAM_END;
        Adler := A;
      finally
        Res := MemCheck(inflateEnd(strm));
        if Res <> Z_OK then
          raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
      end;
    finally
      FreeMem(O {$IFNDEF MSWINDOWS}, BufferSize{$ENDIF});
    end;
  finally
    FreeMem(I {$IFNDEF MSWINDOWS}, BufferSize{$ENDIF});
  end;
  Result := True;
end;

type
  PExtraData = ^TExtraData;
  TExtraData = record
    Source, Dest: Pointer;
    SourceSize, DestSize: Longint;
    SourceIsFile, DestIsFile: Boolean;
  end;

function DataReadProc(var Buf; MaxBytes: Cardinal; ExtraData: Longint): Cardinal; far;
begin
  with PExtraData(ExtraData)^ do begin
    if {$IFDEF MSWINDOWS}Integer({$ENDIF} MaxBytes {$IFDEF MSWINDOWS}){$ENDIF} > SourceSize then
      MaxBytes := SourceSize;
    Result := MaxBytes;
    if SourceIsFile then
      BlockRead(File(Source^), Buf, MaxBytes)
    else begin
      Move(Source^, Buf, MaxBytes);
      {$IFDEF MSWINDOWS}
      Source := PtrAdd(Source, MaxBytes);
      {$ELSE}
      Inc(LongRec(Source).Lo, MaxBytes);
      {$ENDIF}
    end;
    Dec(SourceSize, MaxBytes);
  end;
end;

function DataWriteProc(var Buf; BufSize: Cardinal; ExtraData: Longint): Cardinal; far;
begin
  with PExtraData(ExtraData)^ do begin
    if (DestSize <> -1) and
       ({$IFDEF MSWINDOWS}Integer({$ENDIF} BufSize {$IFDEF MSWINDOWS}){$ENDIF} > DestSize) then
      BufSize := DestSize;
    Result := BufSize;
    if DestIsFile then
      BlockWrite(File(Dest^), Buf, BufSize)
    else begin
      Move(Buf, Dest^, BufSize);
      {$IFDEF MSWINDOWS}
      Dest := PtrAdd(Dest, BufSize);
      {$ELSE}
      Inc(LongRec(Dest).Lo, BufSize);
      {$ENDIF}
    end;
    if DestSize <> -1 then
      Dec(DestSize, BufSize);
  end;
end;

function DeflateData(var ASource; const ASourceSize: Longint; const ASourceIsFile: Boolean;
  var ADest; const ADestSize: Longint; const ADestIsFile: Boolean;
  const CompressionLevel: TCompressionLevel;
  var BytesWritten, Adler: Longint): Boolean;
var
  Extra: TExtraData;
begin
  with Extra do begin
    Source := @ASource;
    Dest := @ADest;
    SourceSize := ASourceSize;
    DestSize := ADestSize;
    SourceIsFile := ASourceIsFile;
    DestIsFile := ADestIsFile;
  end;
  Result := CustomDeflateData(DataReadProc, DataWriteProc, @Extra,
    CompressionLevel, BytesWritten, Adler);
end;

function InflateData(var ASource; const ASourceSize: Longint; const ASourceIsFile: Boolean;
  var ADest; const ADestSize: Longint; const ADestIsFile: Boolean;
  var Adler: Longint): Boolean;
var
  Extra: TExtraData;
begin
  with Extra do begin
    Source := @ASource;
    Dest := @ADest;
    SourceSize := ASourceSize;
    DestSize := ADestSize;
    SourceIsFile := ASourceIsFile;
    DestIsFile := ADestIsFile;
  end;
  Result := CustomInflateData(DataReadProc, DataWriteProc, @Extra,
    Adler);
end;

{ DeflateBlockWrite* & InflateBlockRead* }

procedure DeflateBlockWriteBegin(var F: File; const CompressionLevel: TCompressionLevel;
  var Data: TDeflateBlockWriteData);
var
  Res: Integer;
  HdrCRC: Longint;
  Hdr: TNewBlockDeflateHeader;
begin
  FillChar(Data, SizeOf(Data), 0);
  Data.Compressed := CompressionLevel <> Z_NO_COMPRESSION;
  Data.F := @F;
  Data.StartPos := FilePos(F);

  HdrCRC := 0;
  BlockWrite(F, HdrCRC, SizeOf(HdrCRC));
  Hdr.CompressedSize := 0;
  Hdr.UncompressedSize := 0;
  BlockWrite(F, Hdr, SizeOf(Hdr));

  with Data do begin
    InitStream(strm);
    if Compressed then begin
      Res := MemCheck(deflateInit_(strm, CompressionLevel, zlib_version, SizeOf(strm)));
      if Res <> Z_OK then
        raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
    end;
    strm.next_out := @OutBuffer;
    strm.avail_out := SizeOf(OutBuffer);
  end;
end;

procedure WriteOutputBuffer(var Data: TDeflateBlockWriteData;
  const OnlyIfFull: Boolean);
var
  CRC: Longint;
begin
  with Data do
    if (OnlyIfFull and (strm.avail_out = 0)) or
       (not OnlyIfFull and (strm.avail_out <> SizeOf(OutBuffer))) then begin
      CRC := GetCRC32(OutBuffer, SizeOf(OutBuffer) - strm.avail_out);
      BlockWrite(F^, CRC, SizeOf(CRC));
      BlockWrite(F^, OutBuffer, SizeOf(OutBuffer) - strm.avail_out);
      strm.next_out := @OutBuffer;
      strm.avail_out := SizeOf(OutBuffer);
    end;
end;

procedure DeflateBuf(var Data: TDeflateBlockWriteData; var Buf;
  var Count: Cardinal);
var
  Res: Integer;
  Bytes: Cardinal;
begin
  with Data do begin
    if Count = 0 then
      Exit;
    strm.avail_in := Count;
    strm.next_in := @Buf;
    repeat
      if Compressed then begin
        Res := MemCheck(deflate(strm, Z_NO_FLUSH));
        if Res <> Z_OK then
          raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
      end
      else begin
        Bytes := strm.avail_out;
        if Bytes > strm.avail_in then
          Bytes := strm.avail_in;
        Move(strm.next_in^, strm.next_out^, Bytes);
        Dec(strm.avail_in, Bytes);
        Inc(strm.next_in, Bytes);
        Inc(strm.total_in, Bytes);
        Dec(strm.avail_out, Bytes);
        Inc(strm.next_out, Bytes);
        Inc(strm.total_out, Bytes);
      end;
      WriteOutputBuffer(Data, True);
    until strm.avail_in = 0;
    Count := 0;
  end;
end;

procedure DeflateBlockWrite(var Data: TDeflateBlockWriteData; var Buf;
  Count: Cardinal);
var
  P: Pointer;
  Bytes: Cardinal;
begin
  with Data do begin
    if Count < SizeOf(InBuffer) then begin
      { for blocks < 4 KB, use a fast buffering routine instead of passing the
        small blocks to 'deflate' }
      P := @Buf;
      while Count <> 0 do begin
        Bytes := Count;
        if Bytes > SizeOf(InBuffer) - InBufferCount then
          Bytes := SizeOf(InBuffer) - InBufferCount;
        Move(P^, InBuffer[InBufferCount], Bytes);
        Inc(InBufferCount, Bytes);
        if InBufferCount = SizeOf(InBuffer) then
          DeflateBuf(Data, InBuffer, InBufferCount);
        Dec(Count, Bytes);
        P := PtrAdd(P, Bytes);
      end;
    end
    else begin
      { have to flush out whatever's in InBuffer first }
      DeflateBuf(Data, InBuffer, InBufferCount);
      DeflateBuf(Data, Buf, Count);
    end;
  end;
end;

procedure DeflateBlockWriteEnd(var Data: TDeflateBlockWriteData);
var
  Res: Integer;
  Pos: Longint;
  HdrCRC: Longint;
  Hdr: TNewBlockDeflateHeader;
begin
  with Data do begin
    DeflateBuf(Data, InBuffer, InBufferCount);
    if Compressed then begin
      repeat
        Res := MemCheck(deflate(strm, Z_FINISH));
        if (Res <> Z_OK) and (Res <> Z_STREAM_END) then
          raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
        WriteOutputBuffer(Data, True);
      until Res = Z_STREAM_END;
    end;
    WriteOutputBuffer(Data, False);
    if Compressed then begin
      Res := MemCheck(deflateEnd(strm));
      if Res <> Z_OK then
        raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
    end;

    Pos := FilePos(F^);
    Seek(F^, StartPos);
    if Compressed then
      Hdr.CompressedSize := strm.total_out
    else
      Hdr.CompressedSize := -1;
    Hdr.UncompressedSize := strm.total_in;
    HdrCRC := GetCRC32(Hdr, SizeOf(Hdr));
    BlockWrite(F^, HdrCRC, SizeOf(HdrCRC));
    BlockWrite(F^, Hdr, SizeOf(Hdr));
    Seek(F^, Pos);
  end;
end;

procedure DeflateBlockWriteCancel(var Data: TDeflateBlockWriteData);
begin
  if Data.Compressed then
    deflateEnd(Data.strm);
end;
*)

procedure InflateBlockReadBegin(F: TFile; var Data: TDeflateBlockReadData);
var
  Res: Integer;
  HdrCRC: Longint;
  Hdr: TNewBlockDeflateHeader;
begin
  FillChar(Data, SizeOf(Data), 0);
  Data.F := F;
  Data.StartPos := F.Position.Lo; //FilePos(F);

  if F.Position.Lo + SizeOf(HdrCRC) + SizeOf(Hdr) > F.CappedSize then
    raise EZlibDataError.Create(SZlibDataError);
  F.ReadBuffer(HdrCRC, SizeOf(HdrCRC));
  F.ReadBuffer(Hdr, SizeOf(Hdr));
  if HdrCRC <> GetCRC32(Hdr, SizeOf(Hdr)) then
    raise EZlibDataError.Create(SZlibDataError);
  if Hdr.CompressedSize <> -1 then begin
    Data.Compressed := True;
    Data.InBytesLeft := Hdr.CompressedSize;
  end
  else
    Data.InBytesLeft := Hdr.UncompressedSize;

  with Data do begin
    InitStream(strm);
    if Compressed then begin
      Res := MemCheck(inflateInit_(zlib.TZStreamRec(strm), zlib_version, SizeOf(strm)));
      if Res <> Z_OK then
        raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
    end;
    strm.next_out := @OutBuffer;
    strm.avail_out := SizeOf(OutBuffer);
  end;
end;

procedure InflateBlockRead(var Data: TDeflateBlockReadData; var Buf;
  const Count: Cardinal);
var
  B: Pointer;
  Left, OutCount: Cardinal;
  Len, CRC: Cardinal;
  Res: Integer;
begin
  with Data do begin
    B := @Buf;
    Left := Count;
    while Left <> 0 do begin
      if (strm.avail_in = 0) and (InBytesLeft <> 0) then begin
        Len := InBytesLeft;
        if Len > SizeOf(InBuffer) then Len := SizeOf(InBuffer);
        if F.Position.Lo + SizeOf(CRC) + Len > F.CappedSize then
          raise EZlibDataError.Create(SZlibDataError);
        F.ReadBuffer(CRC, SizeOf(CRC));
        F.ReadBuffer(InBuffer, Len);
        Dec(Data.InBytesLeft, Len);
        strm.next_in := @InBuffer;
        strm.avail_in := Len;
        if CRC <> Cardinal(GetCRC32(InBuffer, Len)) then
          raise EZlibDataError.Create(SZlibDataError);
      end;
      if (strm.avail_out <> 0) and
         (PtrDiff(strm.next_out, @OutBuffer[OutBufferStart]) < NativeInt(Left)) then begin
        if NoMoreData then
          raise EZlibDataError.Create(SZlibDataError);
        if Compressed then begin
          Res := MemCheck(inflate(zlib.TZStreamRec(strm), Z_NO_FLUSH));
          case Res of
            Z_OK: ;
            Z_STREAM_END: NoMoreData := True;
            Z_DATA_ERROR: raise EZlibDataError.Create(SZlibDataError);
          else
            raise EZlibInternalError.CreateFmt(SZlibInternalError, [Res]);
          end;
        end
        else begin
          OutCount := strm.avail_out;
          if NativeUInt(OutCount) > NativeUInt(strm.avail_in) then
            OutCount := strm.avail_in;
          Move(strm.next_in^, strm.next_out^, OutCount);
          Dec(strm.avail_in, OutCount);
          Inc(strm.next_in, OutCount);
          Inc(strm.total_in, OutCount);
          Dec(strm.avail_out, OutCount);
          Inc(strm.next_out, OutCount);
          Inc(strm.total_out, OutCount);
        end;
      end;
      if PtrDiff(strm.next_out, @OutBuffer[OutBufferStart]) > 0 then begin
        OutCount := PtrDiff(strm.next_out, @OutBuffer[OutBufferStart]);
        if OutCount > Left then OutCount := Left;
        Move(OutBuffer[OutBufferStart], B^, OutCount);
        Dec(Left, OutCount);
        B := PtrAdd(B, OutCount);
        Inc(OutBufferStart, OutCount);
        if OutBufferStart = SizeOf(OutBuffer) then begin
          strm.next_out := @OutBuffer;
          strm.avail_out := SizeOf(OutBuffer);
          OutBufferStart := 0;
        end;
      end;
    end;
  end;
end;

procedure InflateBlockReadEnd(var Data: TDeflateBlockReadData);
begin
  if Data.Compressed then
    inflateEnd(zlib.TZStreamRec(Data.strm));
end;

function CalcAdler32(CurAdler: Longint; const Buf; const BufSize: Cardinal): Longint;
begin
  Result := adler32(CurAdler, @Buf, BufSize);
end;

(*
var
  CRC32TableInited: Boolean;
  CRC32Table: array[Byte] of Longint;

procedure InitCRC32Table;
var
  CRC: Longint;
  I, N: Integer;
begin
  for I := 0 to 255 do begin
    CRC := I;
    for N := 0 to 7 do begin
      if Odd(CRC) then
        CRC := (CRC shr 1) xor Longint($EDB88320)
      else
        CRC := CRC shr 1;
    end;
    Crc32Table[I] := CRC;
  end;
end;

function UpdateCRC32(CurCRC: Longint; const Buf; BufSize: Cardinal): Longint;
var
  P: ^Byte;
begin
  if not CRC32TableInited then begin
    InitCRC32Table;
    CRC32TableInited := True;
  end;
  P := @Buf;
  while BufSize <> 0 do begin
    CurCRC := CRC32Table[Lo(CurCRC) xor P^] xor (CurCRC shr 8);
    Dec(BufSize);
    Inc(P);
  end;
  Result := CurCRC;
end;

function GetCRC32(const Buf; BufSize: Cardinal): Longint;
begin
  Result := UpdateCRC32(Longint($FFFFFFFF), Buf, BufSize) xor Longint($FFFFFFFF);
end;

procedure TransformCallInstructions(var Buf; Size: Integer; const Encode: Boolean);
{ Transforms addresses in relative CALL or JMP instructions to absolute ones
  if Encode is True, or the inverse if Encode is False.
  This transformation can lead to a higher compression ratio when compressing
  32-bit x86 code. }
type
  PByteArray = ^TByteArray;
  TByteArray = array[0..$7FFFFFFE] of Byte;
var
  P: PByteArray;
  I: Integer;
begin
  if Size < 5 then
    Exit;
  Dec(Size, 4);
  P := @Buf;
  I := 0;
  while I < Size do begin
    { Does it appear to be a CALL or JMP instruction with a relative 32-bit
      address? }
    if (P[I] = $E8) or (P[I] = $E9) then begin
      { Change the address to be relative to the beginning of the buffer,
        instead of relative to the next instruction. If decoding, do the
        opposite. }
      Inc(I, 5);
      if Encode then
        Inc(Longint((@P[I-4])^), I)
      else
        Dec(Longint((@P[I-4])^), I);
    end
    else
      Inc(I);
  end;
end;

{ TCustomCompressor }

constructor TCustomCompressor.Create(AWriteProc: TCompressorWriteProc;
  CompressionLevel: Integer);
begin
  inherited Create;
  FWriteProc := AWriteProc;
end;

{ TCustomDecompressor }

constructor TCustomDecompressor.Create(AReadProc: TDecompressorReadProc);
begin
  inherited Create;
  FReadProc := AReadProc;
end;

{ TZCompressor }

constructor TZCompressor.Create(AWriteProc: TCompressorWriteProc;
  CompressionLevel: Integer);
begin
  inherited Create(AWriteProc, CompressionLevel);
  InitStream(FStrm);
  FStrm.next_out := @FBuffer;
  FStrm.avail_out := SizeOf(FBuffer);
  Check(deflateInit_(FStrm, CompressionLevel, zlib_version, SizeOf(FStrm)), [Z_OK]);
  FInitialized := True;
end;

destructor TZCompressor.Destroy;
begin
  if FInitialized then
    deflateEnd(FStrm);
  inherited Destroy;
end;

procedure TZCompressor.FlushBuffer;
begin
  if FStrm.avail_out < SizeOf(FBuffer) then begin
    WriteProc(FBuffer, SizeOf(FBuffer) - FStrm.avail_out);
    FStrm.next_out := @FBuffer;
    FStrm.avail_out := SizeOf(FBuffer);
  end;
end;

procedure TZCompressor.Compress(const Buffer; Count: Longint);
begin
  FStrm.next_in := @Buffer;
  FStrm.avail_in := Count;
  while FStrm.avail_in > 0 do begin
    Check(deflate(FStrm, Z_NO_FLUSH), [Z_OK]);
    if FStrm.avail_out = 0 then
      FlushBuffer;
  end;
end;

procedure TZCompressor.Finish;
begin
  FStrm.next_in := nil;
  FStrm.avail_in := 0;
  { Note: This assumes FStrm.avail_out > 0. This shouldn't be a problem since
    Compress always flushes when FStrm.avail_out reaches 0. }
  while Check(deflate(FStrm, Z_FINISH), [Z_OK, Z_STREAM_END]) <> Z_STREAM_END do
    FlushBuffer;
  FlushBuffer;
end;

{ TZDecompressor }

constructor TZDecompressor.Create(AReadProc: TDecompressorReadProc);
begin
  inherited Create(AReadProc);
  InitStream(FStrm);
  FStrm.next_in := @FBuffer;
  FStrm.avail_in := 0;
  Check(inflateInit_(FStrm, zlib_version, SizeOf(FStrm)), [Z_OK]);
  FInitialized := True;
end;

destructor TZDecompressor.Destroy;
begin
  if FInitialized then
    inflateEnd(FStrm);
  inherited Destroy;
end;

procedure TZDecompressor.DecompressInto(var Buffer; Count: Longint);
begin
  FStrm.next_out := @Buffer;
  FStrm.avail_out := Count;
  while FStrm.avail_out > 0 do begin
    if FReachedEnd then  { unexpected EOF }
      raise EZlibDataError.Create(SZlibDataError);
    if FStrm.avail_in = 0 then begin
      FStrm.next_in := @FBuffer;
      FStrm.avail_in := ReadProc(FBuffer, SizeOf(FBuffer));
      { Note: If avail_in is zero while zlib still needs input, inflate() will
        return Z_BUF_ERROR. We interpret that as a data error (see below). }
    end;
    case Check(inflate(FStrm, Z_NO_FLUSH), [Z_OK, Z_STREAM_END, Z_DATA_ERROR, Z_BUF_ERROR]) of
      Z_STREAM_END: FReachedEnd := True;
      Z_DATA_ERROR, Z_BUF_ERROR: raise EZlibDataError.Create(SZlibDataError);
    end;
  end;
end;

procedure TZDecompressor.Reset;
begin
  FStrm.next_in := @FBuffer;
  FStrm.avail_in := 0;
  Check(inflateReset(FStrm), [Z_OK]);
  FReachedEnd := False;
end;
*)

end.
