dxrdcompression.pas

Well known and usefull component for delphi 7

unit DXRDCompression;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXRDCompression
//    C++Author: Ed Ross
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2002
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (3rd Generation Code)
// ========================================================================
//  Description:
// ========================================================================
// The code is based upon source code found in "The C Users Journal", 1/92. It
// has been ported to Delphi by different people over the past 3 years, mainly
// Ozz Nixon and Richard Griffin. And has been incorporated into the BPDX
// socket suites by request from many customers who need compressed data. Since
// we do not own the original design rights, we include this component freely
// for use with any of our component suites.
///////////////////////////////////////////////////////////////////////////////

uses
   Classes;

{$I DXAddons.def}

type
   {$IFDEF OBJECTS_ONLY}
   TDXRDCompression=class
      {$ELSE}
   TDXRDCompression=class(TComponent)
      {$ENDIF}
   private
      fOnBlockLengthError:TNotifyEvent;
      fOnDataUnderrun:TNotifyEvent;
   protected
   public
      {$IFDEF OBJECTS_ONLY}
      constructor Create;
      {$ELSE}
      constructor Create(AOwner:TComponent); override;
      {$ENDIF}
      destructor Destroy; override;
      procedure CompressStreams(inStream, OutStream:TStream);
      procedure DecompressStreams(inStream, OutStream:TStream);
      procedure CompressString(const OriginalStr:string; var OutStr:string);
      procedure DecompressString(const OriginalStr:string; var OutStr:string);
      procedure CompressWindowsFileToFile(var infile, outfile:Integer);
      procedure DecompressWindowsFileToFile(var infile, outfile:Integer);
      procedure CompressBorlandFileToFile(var infile, outfile:file);
      procedure DecompressBorlandFileToFile(var infile, outfile:file);
   published
      property OnBlockLengthError:TNotifyEvent read fOnBlockLengthError
         write fOnBlockLengthError;
      property OnDataUnderrun:TNotifyEvent read fOnDataUnderrun
         write fOnDataUnderrun;
   end;

implementation

uses
   SysUtils,
   DXString;

const
   HASH_LEN=4096;
   HASH_SIZE=HASH_LEN*Sizeof(word);
   BUFF_LEN=8192;

type
   PByte=^Byte;
   ByteArray=array[0..65000] of Byte;
   PByteArray=^ByteArray;

   PWord=^Word;
   WordArray=array[0..32000] of Word;
   PWordArray=^WordArray;

   {$IFDEF OBJECTS_ONLY}

constructor TDXRDCompression.Create;
{$ELSE}

constructor TDXRDCompression.Create(AOwner:TComponent);
{$ENDIF}
begin
   {$IFDEF OBJECTS_ONLY}
   inherited Create;
   {$ELSE}
   inherited Create(AOwner);
   {$ENDIF}
end;

destructor TDXRDCompression.Destroy;
begin
   inherited Destroy;
end;

function compress(ibuff:PByte; inbuff_len:Smallint; obuff:PByte;
   htable:Pointer):SmallInt;
var
   inbuff:PByte absolute ibuff;
   outbuff:PByte absolute obuff;
   hash_tbl:PWordArray absolute htable;
   in_idx:Pbyte;
   in_idxa:PByteArray absolute in_idx;
   inbuff_end,
      anchor,
      out_idx,
      outbuff_end,
      pat_idx:PByte;
   cnt,
      gap,
      c,
      hash,
      hashlen,
      ctrl_cnt,
      ctrl_bits:Word;
   ctrl_idx:PWord;

begin
   in_idx:=inbuff;
   inbuff_end:=Pointer(LongInt(inbuff)+inbuff_len);
   ctrl_idx:=Pointer(outbuff);
   ctrl_cnt:=0;
   ctrl_bits:=0;
   out_idx:=Pointer(longint(outbuff)+Sizeof(Word));
   outbuff_end:=Pointer(LongInt(outbuff)+(inbuff_len-48));
   if inbuff_len<=18 then begin
      FastMove(inbuff^, outbuff^, inbuff_len);
      Result:=0-inbuff_len;
      Exit;
   end;
   hashlen:=HASH_LEN-1;
   while LongInt(in_idx)<LongInt(inbuff_end) do begin
      if ctrl_cnt=16 then begin
         ctrl_idx^:=ctrl_bits;
         ctrl_cnt:=1;
         ctrl_idx:=Pointer(out_idx);
         Inc(out_idx, 2);
         if LongInt(out_idx)>LongInt(outbuff_end) then begin
            FastMove(inbuff^, outbuff^, inbuff_len);
            Result:=0-inbuff_len;
            Exit;
         end;
      end
      else
         Inc(ctrl_cnt);
      anchor:=in_idx;
      c:=in_idx^;
      Inc(in_idx);
      while (LongInt(in_idx)<longint(inbuff_end))
         and(in_idx^=c)
         and(LongInt(in_idx)-LongInt(anchor)<(HASH_LEN+18)) do
         Inc(in_idx);
      cnt:=LongInt(in_idx)-LongInt(anchor);
      if cnt>2 then begin
         if cnt<=18 then begin
            out_idx^:=cnt-3;
            Inc(out_idx);
            out_idx^:=c;
            Inc(out_idx);
         end
         else begin
            Dec(cnt, 19);
            out_idx^:=16+(cnt and $0F);
            Inc(out_idx);
            out_idx^:=cnt shr 4;
            Inc(out_idx);
            out_idx^:=c;
            Inc(out_idx);
         end;
         ctrl_bits:=(ctrl_bits shl 1)or 1;
         Continue;
      end;
      in_idx:=anchor;
      if (LongInt(inbuff_end)-LongInt(in_idx))>2 then begin
         hash:=((((in_idxa^[0]and 15)shl 8)or in_idxa^[1])xor
            ((in_idxa^[0]shr 4)or(in_idxa^[2]shl 4)))
            and hashlen;
         pat_idx:=in_idx;
         Fastmove(hash_tbl^[hash], pat_idx, 2);
         hash_tbl^[hash]:=Word(in_idx);
         gap:=LongInt(in_idx)-LongInt(pat_idx);
         if (gap<=HASH_LEN+2) then begin
            while (LongInt(in_idx)<LongInt(inbuff_end))
               and(LongInt(pat_idx)<LongInt(anchor))
               and(pat_idx^=in_idx^)
               and(LongInt(in_idx)-LongInt(anchor)<271) do begin
               Inc(in_idx);
               Inc(pat_idx);
            end;
            cnt:=LongInt(in_idx)-LongInt(anchor);
            if cnt>2 then begin
               Dec(gap, 3);
               if cnt<=15 then begin
                  out_idx^:=(cnt shl 4)+(gap and $0F);
                  Inc(out_idx);
                  out_idx^:=gap shr 4;
                  Inc(out_idx);
               end
               else begin
                  out_idx^:=32+(gap and $0F);
                  Inc(out_idx);
                  out_idx^:=gap shr 4;
                  Inc(out_idx);
                  out_idx^:=cnt-16;
                  Inc(out_idx);
               end;
               ctrl_bits:=(ctrl_bits shl 1)or 1;
               Continue;
            end;
         end;
      end;
      out_idx^:=c;
      Inc(out_idx);
      Inc(anchor);
      in_idx:=anchor;
      ctrl_bits:=ctrl_bits shl 1;
   end;
   ctrl_bits:=ctrl_bits shl(16-ctrl_cnt);
   ctrl_idx^:=ctrl_bits;
   Result:=LongInt(out_idx)-LongInt(outbuff);
end;

function Decompress(inbuff:PByte; inbuff_len:Word;
   outbuff:PByte):Integer;
var
   ctrl_bits,
      cmd,
      cnt,
      ofs,
      ctrl_mask:Word;
   inbuff_idx,
      outbuff_idx,
      inbuff_end,
      outbuff_src:PByte;

begin
   ctrl_bits:=0;
   ctrl_mask:=0;
   inbuff_idx:=inbuff;
   outbuff_idx:=outbuff;
   inbuff_end:=Pointer(LongInt(inbuff)+inbuff_len);
   while LongInt(inbuff_idx)<LongInt(inbuff_end) do begin
      ctrl_mask:=ctrl_mask shr 1;
      if ctrl_mask=0 then begin
         ctrl_bits:=PWord(inbuff_idx)^;
         Inc(inbuff_idx, 2);
         ctrl_mask:=$8000;
      end;
      if (ctrl_bits and ctrl_mask)=0 then begin
         outbuff_idx^:=inbuff_idx^;
         Inc(outbuff_idx);
         Inc(inbuff_idx);
         Continue;
      end;
      cmd:=(inbuff_idx^shr 4)and $0F;
      cnt:=inbuff_idx^and $0F;
      Inc(inbuff_idx);
      case cmd of
         0:begin
               Inc(cnt, 3);
               FillChar2(outbuff_idx^, cnt, char(inbuff_idx^));
               Inc(inbuff_idx);
               Inc(outbuff_idx, cnt);
            end;
         1:begin
               Inc(cnt, inbuff_idx^shl 4);
               Inc(inbuff_idx);
               Inc(cnt, 19);
               FillChar2(outbuff_idx^, cnt, char(inbuff_idx^));
               Inc(inbuff_idx);
               Inc(outbuff_idx, cnt);
            end;
         2:begin
               ofs:=cnt+3;
               Inc(ofs, inbuff_idx^shl 4);
               Inc(inbuff_idx);
               cnt:=inbuff_idx^;
               Inc(inbuff_idx);
               Inc(cnt, 16);
               outbuff_src:=Pointer(LongInt(outbuff_idx)-ofs);
               FastMove(outbuff_src^, outbuff_idx^, cnt);
               Inc(outbuff_idx, cnt);
            end;
      else begin
            ofs:=cnt+3;
            Inc(ofs, inbuff_idx^shl 4);
            Inc(inbuff_idx);
            outbuff_src:=Pointer(LongInt(outbuff_idx)-ofs);
            FastMove(outbuff_src^, outbuff_idx^, cmd);
            Inc(outbuff_idx, cmd);
         end;
      end; {case}
   end;
   Result:=LongInt(outbuff_idx)-LongInt(outbuff);
end;

procedure TDXRDCompression.CompressBorlandFileToFile(var infile, outfile:file);
var
   code,
      bytes_read,
      compress_len:Integer;
   HashPtr:PWordArray;
   inputbuffer,
      outputbuffer:PByteArray;

begin
   Getmem(HashPtr, HASH_SIZE);
   Fillchar2(hashPtr^, HASH_SIZE, #0);
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   bytes_read:=BUFF_LEN;
   while bytes_read=BUFF_LEN do begin
      Blockread(infile, inputbuffer^, BUFF_LEN, bytes_read);
      compress_len:=Compress(PByte(inputbuffer), bytes_read,
         PByte(outputbuffer), HashPtr);
      Blockwrite(outfile, compress_len, 2, code);
      if compress_len<0 then compress_len:=0-compress_len;
      Blockwrite(outfile, outputbuffer^, compress_len, code);
   end;
   compress_len:=0;
   Blockwrite(outfile, compress_len, 2, code);
   Freemem(HashPtr, HASH_SIZE);
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;

procedure TDXRDCompression.CompressWindowsFileToFile(var infile,
   outfile:Integer);
var
   compress_len:Integer;
   bytes_read:DWord;
   HashPtr:PWordArray;
   inputbuffer,
      outputbuffer:PByteArray;

begin
   Getmem(HashPtr, HASH_SIZE);
   Fillchar2(hashPtr^, HASH_SIZE, #0);
   Getmem(inputbuffer, BUFF_LEN);
   Getmem(outputbuffer, BUFF_LEN);
   bytes_read:=BUFF_LEN;
   while bytes_read=BUFF_LEN do begin
      bytes_read:=FileRead(infile, inputbuffer^, BUFF_LEN);
      compress_len:=Compress(PByte(inputbuffer), bytes_read,
         PByte(outputbuffer), HashPtr);
      {code:=} FileWrite(outfile, compress_len, 2);
      if compress_len<0 then compress_len:=0-compress_len;
      {code:=} FileWrite(outfile, outputbuffer^, compress_len);
   end;
   compress_len:=0;
   {code:=} FileWrite(outfile, compress_len, 2);
   Freemem(HashPtr, HASH_SIZE);
   Freemem(inputbuffer, BUFF_LEN);
   Freemem(outputbuffer, BUFF_LEN);
end;