unit uROCompression;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}
{$IFDEF FPC}
  {$IFDEF MSWINDOWS}
    {$DEFINE FPCMSWIN}
  {$ENDIF}
  {$IFDEF LINUX}
    {$DEFINE FPCLINUX}
  {$ENDIF}
  {$UNDEF MSWINDOWS}
  {$DEFINE LINUX}
{$ENDIF FPC}

interface

uses {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
     Classes;


{$IFDEF LINUX}
procedure ZCompressStream(anInputStream, aCompressedStream : TStream);
procedure ZDecompressStream(aCompressedStream, anOutputStream : TStream);
{$ENDIF LINUX}
function CompressStr(const aString : String) : String;
function DecompressStr(const aString : String) : String;
function CompressAndEncode(const aString: string): string;
function DecodeAndUnCompress(const aString: string): string;
procedure EncodeStream(anInputStream, anOutputStream: TStream);
procedure DecodeStream(anInputStream, anOutputStream: TStream);

implementation

uses 
  uROZLib, SysUtils;

const
  EncodeTable: array[0..63] of Char =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
    'abcdefghijklmnopqrstuvwxyz' +
    '0123456789+/';

  DecodeTable: array[#0..#127] of Integer = (
    Byte('='), 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
    64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64,
    64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 62, 64, 64, 64, 63,
    52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 64, 64, 64, 64, 64, 64,
    64,  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14,
    15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 64, 64, 64, 64, 64,
    64, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
    41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 64, 64, 64, 64, 64);

type
  PPacket = ^TPacket;
  TPacket = packed record
    case Integer of
      0: (b0, b1, b2, b3: Byte);
      1: (i: Integer);
      2: (a: array[0..3] of Byte);
      3: (c: array[0..3] of Char);
  end;

procedure EncodePacket(const Packet: TPacket; NumChars: Integer; OutBuf: PChar);
begin
  OutBuf[0] := EnCodeTable[Packet.a[0] shr 2];
  OutBuf[1] := EnCodeTable[((Packet.a[0] shl 4) or (Packet.a[1] shr 4)) and $0000003f];
  if NumChars < 2 then
    OutBuf[2] := '='
  else OutBuf[2] := EnCodeTable[((Packet.a[1] shl 2) or (Packet.a[2] shr 6)) and $0000003f];
  if NumChars < 3 then
    OutBuf[3] := '='
  else OutBuf[3] := EnCodeTable[Packet.a[2] and $0000003f];
end;

function DecodePacket(InBuf: PChar; var nChars: Integer): TPacket;
begin
  Result.a[0] := (DecodeTable[InBuf[0]] shl 2) or
    (DecodeTable[InBuf[1]] shr 4);
  NChars := 1;
  if InBuf[2] <> '=' then
  begin
    Inc(NChars);
    Result.a[1] := (DecodeTable[InBuf[1]] shl 4) or
      (DecodeTable[InBuf[2]] shr 2);
  end;
  if InBuf[3] <> '=' then
  begin
    Inc(NChars);
    Result.a[2] := (DecodeTable[InBuf[2]] shl 6) or DecodeTable[InBuf[3]];
  end;
end;

procedure EncodeStream(anInputStream, anOutputStream: TStream);
type
  PInteger = ^Integer;
var
  InBuf: array[0..509] of Byte;
  OutBuf: array[0..1023] of Char;
  BufPtr: PChar;
  I, J, K, BytesRead: Integer;
  Packet: TPacket;
begin
  K := 0;
  repeat
    BytesRead := anInputStream.Read(InBuf, SizeOf(InBuf));
    I := 0;
    BufPtr := OutBuf;
    while I < BytesRead do
    begin
      if BytesRead - I < 3 then
        J := BytesRead - I
      else J := 3;
      Packet.i := 0;
      Packet.b0 := InBuf[I];
      if J > 1 then
        Packet.b1 := InBuf[I + 1];
      if J > 2 then
        Packet.b2 := InBuf[I + 2];
      EncodePacket(Packet, J, BufPtr);
      Inc(I, 3);
      Inc(BufPtr, 4);
      Inc(K, 4);
      if K > 75 then
      begin
        BufPtr[0] := #$0D;
        BufPtr[1] := #$0A;
        Inc(BufPtr, 2);
        K := 0;
      end;
    end;
    anOutputStream.Write(Outbuf, BufPtr - PChar(@OutBuf));
  until BytesRead = 0;
end;

procedure DecodeStream(anInputStream, anOutputStream: TStream);
var
  InBuf: array[0..75] of Char;
  OutBuf: array[0..49] of Byte;
  InBufPtr, OutBufPtr: PChar;
  I, J, K, BytesRead: Integer;
  Packet: TPacket;

  procedure SkipWhite;
  var
    C: Char;
    NumRead: Integer;
  begin
    while True do
    begin
      NumRead := anInputStream.Read(C, 1);
      if NumRead = 1 then
      begin
        if C in ['0'..'9','A'..'Z','a'..'z','+','/','='] then
        begin
          anInputStream.Position := anInputStream.Position - 1;
          Break;
        end;
      end else Break;
    end;
  end;

begin
  repeat
    SkipWhite;
    BytesRead := anInputStream.Read(InBuf, SizeOf(InBuf));
    InBufPtr := InBuf;
    OutBufPtr := @OutBuf;
    I := 0;
    while I < BytesRead do
    begin
      Packet := DecodePacket(InBufPtr, J);
      K := 0;
      while J > 0 do
      begin
        OutBufPtr^ := Char(Packet.a[K]);
        Inc(OutBufPtr);
        Dec(J);
        Inc(K);
      end;
      Inc(InBufPtr, 4);
      Inc(I, 4);
    end;
    anOutputStream.Write(OutBuf, OutBufPtr - PChar(@OutBuf));
  until BytesRead = 0;
end;

function CompressStr(const aString : String) : String;
{$IFDEF LINUX}
var
  Buffer : Pointer;
  Size : Integer;
begin
  try
    try
      CompressBuf(PChar(aString), Length(aString), Buffer, Size);
      SetLength(Result, Size);
      Move(Buffer^, Result[1], Size);
    except
      Buffer := nil;
    end;
  finally
    FreeMem(Buffer);
  end;
end;
{$ELSE}
begin
  Result := aString;
  ZFastCompressString(Result, clMax);
end;
{$ENDIF LINUX}

function DecompressStr(const aString : String) : String;
{$IFDEF LINUX}
var
  Buffer : Pointer;
  Size : Integer;
begin
  try
    try
      DecompressBuf(PChar(aString), Length(aString), 0, Buffer, Size);
      SetLength(Result, Size);
      Move(Buffer^, Result[1], Size);
    except
      Buffer := nil;
    end;
  finally
    FreeMem(Buffer);
  end;
end;
{$ELSE}
begin
  Result := aString;
  ZFastDecompressString(Result);
end;
{$ENDIF LINUX}

{$IFDEF LINUX}
procedure ZCompressStream(anInputStream, aCompressedStream : TStream);
var
  zstream : TCompressionStream;
begin
  try
    zstream := TCompressionStream.Create(clMax, aCompressedStream);
    zstream.CopyFrom(anInputStream, 0);
  finally
    FreeAndNIL(zstream);
  end;
end;

procedure ZDecompressStream(aCompressedStream, anOutputStream : TStream);
var
  zstream : TDecompressionStream;
  buffer  : array of byte;
  bufflen : integer;
  lBufferSize: integer;
begin
  lBufferSize := 10*1024;

  SetLength(buffer,lBufferSize);
  zstream := TDecompressionStream.Create(aCompressedStream);
  try

    bufflen := zstream.Read(buffer[0], lBufferSize);
    while (bufflen>0) do begin
      anOutputStream.Write(buffer[0], bufflen);
      bufflen := zstream.Read(buffer[0], lBufferSize);
    end;

  finally
    FreeAndNIL(zstream);
  end;
end;
{$ENDIF}

function CompressAndEncode(const aString: string): string;
var
  fCompressedStream: TMemoryStream;
  fStreamCompressor: TCompressionStream;
  fStringStream: TStringStream;
begin
  fCompressedStream := TMemoryStream.Create;
  try
    fStreamCompressor := TCompressionStream.Create(clMax, (fCompressedStream));
    try
      fStreamCompressor.Write(aString[1], length(aString));
    finally
      FreeAndNil(fStreamCompressor);
    end;
    fStringStream := TStringStream.create('');
    try
      fCompressedStream.Position := 0;
      EncodeStream(fCompressedStream, fStringStream);
      Result := fStringStream.datastring;
    finally
      FreeAndNil(fStringStream);
    end;
  finally
    FreeAndNil(fCompressedStream);
  end;
end;

function DecodeAndUnCompress(const aString: string): string;
var
  fWorkStream: TMemoryStream;
  fEncodedStream: TMemoryStream;
  fStreamDeCompressor: TDecompressionStream;
  fBufLen: integer;
  fBuffer: array[0..16383] of byte;
begin
  fWorkStream := TMemoryStream.create;
  try
    fWorkStream.size := length(aString);
    move(aString[1], fWorkStream.memory^, fWorkStream.size);
    fWorkStream.position := 0;
    fEncodedStream := TMemoryStream.create;
    try
      DecodeStream(fWorkStream, fEncodedStream);
      fWorkStream.size := 0;
      fEncodedStream.position := 0;
      fStreamDeCompressor := TDecompressionStream.Create(fEncodedStream);
      try
        fBufLen := fStreamDeCompressor.Read(fBuffer, SizeOf(fBuffer));
        while fBufLen > 0 do
        begin
          fWorkStream.Write(fBuffer, fBufLen);
          fBufLen := fStreamDeCompressor.Read(fBuffer, SizeOf(fBuffer));
        end;
      finally
        FreeAndNil(fStreamDeCompressor);
      end;
    finally
      FreeAndnil(fEncodedStream);
    end;
    fWorkStream.position := 0;
    SetLength(Result, fWorkStream.size);
    move(fWorkStream.memory^, Result[1], fWorkStream.size);
  finally
    FreeAndNil(fWorkStream);
  end;
end;

end.