{==============================================================================

  Compress and Decompress
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsCompress;

{$I KsCommonVer.Inc}

interface

uses Sysutils, Classes, ZKsStream;

const

  KsZSign: array [0..3] of char = 'KSLZ';

  CLevel: TCompressionLevel = clFastest;
  { One of - clNone, clFastest, clDefault, clMax; }

type

  TKsCompressionStream = class(TFileStream)
  private
    FUseMemory: boolean;
    FMemory: TMemoryStream;
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    procedure BeforeDestruction; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;

  TKsDecompressionStream = class(TFileStream)
  private
    FUseMemory: boolean;
    FMemory: TMemoryStream;
  public
    constructor Create(AFileName: string);
    destructor Destroy; override;
    procedure AfterConstruction; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
  end;

type
  EKsCompressError = class(Exception);

implementation {===============================================================}

const
  BufferSize = 4096;
var
  Buffer: array[0..BufferSize-1] of Byte;

{ TKsCompressionStream }

constructor TKsCompressionStream.Create(AFileName: string);
begin
  inherited Create(AFileName, fmCreate);
  FMemory := TMemoryStream.Create;
  FUseMemory := true;
end;

destructor TKsCompressionStream.Destroy;
begin
  FMemory.Free;
  inherited Destroy;
end;

{$IFDEF KS_ZLIB}
procedure TKsCompressionStream.BeforeDestruction;
var
  ZStream: TCompressionStream;
  Count: integer;
begin
  FUseMemory := false;
  Position := 0;
  { Save Sign }
  Write(KsZSign, SizeOf(KsZSign));
  { Compress }
  ZStream := TCompressionStream.Create(CLevel, Self);
  try
    FMemory.Position := 0;
    { Compress }
    while True do
    begin
      Count := FMemory.Read(Buffer, BufferSize);
      if Count <> 0 then
        ZStream.Write(Buffer, Count)
      else
        Break;
    end;
  finally
    ZStream.Free;
  end;
  { Destruction }
  inherited;
end;
{$ENDIF}

{$IFDEF KS_LZH}
procedure TKsCompressionStream.BeforeDestruction;
var
  LzhStream: TLZHStream;
  Count: integer;
begin
  FUseMemory := false;
  Position := 0;
  { Save Sign }
  Write(KsZSign, SizeOf(KsZSign));
  { Compress }
  LzhStream := TLzhStream.Create(FMemory, Self);
  try
    FMemory.Position := 0;
    { Compress }
    LzhStream.Pack(FMemory.Size);
  finally
    LzhStream.Free;
  end;
  { Destruction }
  inherited;
end;
{$ENDIF}

function TKsCompressionStream.Read(var Buffer; Count: Integer): Longint;
begin
  raise EKsCompressError.Create('Read Error');   
end;

function TKsCompressionStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
  if FUseMemory then
    Result := FMemory.Seek(Offset, Origin)
  else
    Result := inherited Seek(Offset, Origin);
end;

function TKsCompressionStream.Write(const Buffer; Count: Integer): Longint;
begin
  if FUseMemory then
    Result := FMemory.Write(Buffer, Count)
  else
    Result := inherited Write(Buffer, Count)
end;

{ TKsDecompressionStream }

constructor TKsDecompressionStream.Create(AFileName: string);
begin
  inherited Create(AFileName, fmOpenRead);
  FMemory := TMemoryStream.Create;
  FUseMemory := false;
end;

destructor TKsDecompressionStream.Destroy;
begin
  FMemory.Free;
  inherited Destroy;
end;

{$IFDEF KS_ZLIB}
procedure TKsDecompressionStream.AfterConstruction;
var
  ZStream: TDecompressionStream;
  Count: Integer;
  S: array [0..3] of Char;
begin
  inherited ;
  { Load from File }
  FUseMemory := false;
  { Load Sign }
  Read(S, SizeOf(KsZSign));
  if S <> KsZSign then Exit;
  { Decompress }
  ZStream := TDecompressionStream.Create(Self);
  try
    { Decompress }
    while True do
    begin
      Count := ZStream.Read(Buffer, BufferSize);
      if Count <> 0 then
        FMemory.WriteBuffer(Buffer, Count)
      else
        Break;
    end;
  finally
    ZStream.Free;
  end;
  FMemory.Position := 0;
  { Use memory }
  FUseMemory := true;
end;
{$ENDIF}

{$IFDEF KS_LZH}
procedure TKsDecompressionStream.AfterConstruction;
var
  LzhStream: TLzhStream;
  Count: Integer;
  S: array [0..3] of Char;
begin
  inherited ;
  { Load from File }
  FUseMemory := false;
  { Load Sign }
  Read(S, SizeOf(KsZSign));
  if S <> KsZSign then Exit;
  { Decompress }
  LzhStream := TLzhStream.Create(Self, FMemory);
  try
    { Decompress }
    LzhStream.Unpack;
  finally
    LzhStream.Free;
  end;
  FMemory.Position := 0;
  { Use memory }
  FUseMemory := true;
end;
{$ENDIF}

function TKsDecompressionStream.Read(var Buffer; Count: Integer): Longint;
begin
  if FUseMemory then
    Result := FMemory.Read(Buffer, Count)
  else
    Result := inherited Read(Buffer, Count)
end;

function TKsDecompressionStream.Seek(Offset: Integer;
  Origin: Word): Longint;
begin
  if FUseMemory then
    Result := FMemory.Seek(Offset, Origin)
  else
    Result := inherited Seek(Offset, Origin)
end;

function TKsDecompressionStream.Write(const Buffer;
  Count: Integer): Longint;
begin
  raise EKsCompressError.Create('Write Error');   
end;

end.




