POINT Software Programming/PPROG1.ISO/pascal/cx201/cxsub.pas

Pascal/Delphi Source File | 1994-03-01 | 13.0 KB | 463 lines

{
   CXSUB functions.
   Copyright (c) 1990-1994 Eugene Nelson, Four Lakes Computing.

   This file contains useful subroutines that may be used with Cx.
   See file CXSUB.DOC for interface information.
}

unit  cxsub;

{$F+}          {Required, do not change}
{$I-}          {Required, do not change}

{
   The following notes apply to the Pascal implementation of CXSUB:

      *  cx_decompress_ofile has another parameter, named extract,
         which is used to indicate if the output file should be
         written to (True or False).  If False, cx_decompress_ofile
         may be used as an integrity checker.

      *  A callback type, cxback, is used for progress and interrupt
         control  A callback function and an application specific
         pointer are passed to the CXSUB file compression routines.
         See file CXF.PAS for usage examples.

      *  The CXSUB functions 'trap' all out of memory and I/O
         error conditions.  These errors are returned as CXSUB_ERR*.
}

interface uses cx;
{------------------------------------------------------------------------}

const CXSUB_ERR_OPENS =       1;
const CXSUB_ERR_OPEND =       2;
const CXSUB_ERR_NOMEM =       3;
const CXSUB_ERR_READ =        4;
const CXSUB_ERR_WRITE =       5;
const CXSUB_ERR_CLOSE =       6;
const CXSUB_ERR_INVALID =     7;

type cxback = function(p: pointer): integer;

function cx_error_message(
                  err      :CXINT)     : string;

function cx_compress_ofile(
            var   ofile    :file       ;
            var   ifile    :file       ;
                  method   :CXINT      ;
                  bsize    :CXINT      ;
                  tsize    :CXINT      ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;

function cx_compress_file(
                  dst      :string     ;
                  src      :string     ;
                  method   :CXINT      ;
                  bsize    :CXINT      ;
                  tsize    :CXINT      ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;

function cx_decompress_ofile(
            var   ofile    :file       ;
            var   ifile    :file       ;
                  extract  :boolean    ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;

function cx_decompress_file(
                  dst      :string     ;
                  src      :string     ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;

implementation

{function cx_heap_func is used to avoid out of memory runtime errors}
{------------------------------------------------------------------------}
function cx_heap_func(size: word): integer;
begin
   cx_heap_func:= 1;
end;

{------------------------------------------------------------------------}
function cx_error_message(
                  err      :CXINT)     : string;
begin
   case err of
      CX_ERR_INVALID:    cx_error_message:= 'data could not be decompressed';
      CX_ERR_METHOD:     cx_error_message:= 'invalid compression method';
      CX_ERR_BUFFSIZE:   cx_error_message:= 'invalid buffer size';
      CX_ERR_TEMPSIZE:   cx_error_message:= 'invalid temp buffer size';
      CXSUB_ERR_OPENS:   cx_error_message:= 'could not open source';
      CXSUB_ERR_OPEND:   cx_error_message:= 'could not open destination';
      CXSUB_ERR_NOMEM:   cx_error_message:= 'insufficient memory';
      CXSUB_ERR_READ:    cx_error_message:= 'could not read from source';
      CXSUB_ERR_WRITE:   cx_error_message:= 'could not write to destination';
      CXSUB_ERR_CLOSE:   cx_error_message:= 'could not close destination';
      CXSUB_ERR_INVALID: cx_error_message:= 'source file is invalid or corrupt';
      else               cx_error_message:= 'unknown';
   end;
end;

{------------------------------------------------------------------------}
function cx_compress_pofile(
            var   ofile    :file       ;
            var   ifile    :file       ;
                  ibuff    :pointer    ;
                  obuff    :pointer    ;
                  tbuff    :pointer    ;
                  method   :CXINT      ;
                  bsize    :CXINT      ;
                  tsize    :CXINT      ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;
var
   t: pointer;
   j, k, crc: CXINT;

begin
   repeat
      if callback(p) <> 0
         then begin
            cx_compress_pofile:= 0;
            exit;
         end;

      BlockRead(ifile, ibuff^, bsize, j);
      if IOResult <> 0
      then begin
         cx_compress_pofile:= CXSUB_ERR_READ;
         exit;
      end;

      BlockWrite(ofile, j, CXINTSIZE);
      if IOResult <> 0
      then begin
         cx_compress_pofile:= CXSUB_ERR_WRITE;
         exit;
      end;

      if j <> 0
      then begin
         k:= CX_COMPRESS(method, obuff^, bsize, ibuff^, j, tbuff^, tsize);
         if k > j
         then begin
            cx_compress_pofile:= k;
            exit;
         end;

         BlockWrite(ofile, k, CXINTSIZE);
         if IOResult <> 0
         then begin
            cx_compress_pofile:= CXSUB_ERR_WRITE;
            exit;
         end;

         if k = j       {block could not be compressed}
            then t:= ibuff
            else t:= obuff;

         crc:= CX_CRC(t^, k);

         BlockWrite(ofile, crc, CXINTSIZE);
         if IOResult <> 0
         then begin
            cx_compress_pofile:= CXSUB_ERR_WRITE;
            exit;
         end;

         BlockWrite(ofile, t^, k);
         if IOResult <> 0
         then begin
            cx_compress_pofile:= CXSUB_ERR_WRITE;
            exit;
         end;
      end;
   until j = 0;

   cx_compress_pofile:= 0;
end;


{------------------------------------------------------------------------}
function cx_compress_ofile(
            var   ofile    :file       ;
            var   ifile    :file       ;
                  method   :CXINT      ;
                  bsize    :CXINT      ;
                  tsize    :CXINT      ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;
var
   ibuff, obuff, tbuff: pointer;
   err: CXINT;

begin
   HeapError:= @cx_heap_func;       {trap out of memory conditions}

   GetMem(ibuff, bsize);
   GetMem(obuff, bsize+CX_SLOP);
   GetMem(tbuff, tsize);

   HeapError:= nil;                 {restore heap error handler}

   if (ibuff = nil) or (obuff = nil) or (tbuff = nil)
   then begin
      if ibuff <> nil then FreeMem(ibuff, bsize);
      if obuff <> nil then FreeMem(obuff, bsize+CX_SLOP);
      if tbuff <> nil then FreeMem(tbuff, tsize);
      cx_compress_ofile:= CXSUB_ERR_NOMEM;
      Exit;
   end;

   cx_compress_ofile:= cx_compress_pofile(ofile, ifile, ibuff, obuff, tbuff,
                        method, bsize, tsize, callback, p);

   FreeMem(ibuff, bsize);
   FreeMem(obuff, bsize+CX_SLOP);
   FreeMem(tbuff, tsize);
end;


{------------------------------------------------------------------------}
function cx_compress_file(
                  dst      :string     ;
                  src      :string     ;
                  method   :CXINT      ;
                  bsize    :CXINT      ;
                  tsize    :CXINT      ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;
var
   ifile, ofile: file;
   j, k: CXINT;

begin
   Assign(ifile, src);
   Reset(ifile, 1);
   if IOResult <> 0
   then begin
      cx_compress_file:= CXSUB_ERR_OPENS;
      exit;
   end;

   Assign(ofile, dst);
   Rewrite(ofile, 1);
   if IOResult <> 0
   then begin
      Close(ifile);
      cx_compress_file:= CXSUB_ERR_OPEND;
      exit;
   end;

   k:= cx_compress_ofile(ofile, ifile, method, bsize, tsize, callback, p);

   Close(ifile);
   j:= IOResult;     {to clear any input file close IOresult}

   Close(ofile);
   if IOResult = 0
      then j:= 0
      else j:= CXSUB_ERR_CLOSE;

   if k = 0
      then cx_compress_file:= j
      else cx_compress_file:= k;
end;


{------------------------------------------------------------------------}
function cx_decompress_pofile(
            var   ofile    :file       ;
            var   ifile    :file       ;
                  extract  :boolean    ;
                  ibuff    :pointer    ;
                  obuff    :pointer    ;
                  tbuff    :pointer    ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;
var
   bsize,  j, k, crc: CXINT;
   t: pointer;

begin
   repeat
      BlockRead(ifile, j, CXINTSIZE);
      if IOResult <> 0
      then begin
         cx_decompress_pofile:= CXSUB_ERR_READ;
         exit;
      end;

      if j <> 0
      then begin
         if callback(p) <> 0
            then begin
               cx_decompress_pofile:= 0;
               exit;
            end;

         BlockRead(ifile, k, CXINTSIZE);
         if IOResult <> 0
         then begin
            cx_decompress_pofile:= CXSUB_ERR_READ;
            exit;
         end;

         if (k > j) or (k > CX_MAX_BUFFER) or (j > CX_MAX_BUFFER)
         then begin
            cx_decompress_pofile:= CXSUB_ERR_INVALID;
            exit;
         end;

         BlockRead(ifile, crc, CXINTSIZE);
         if IOResult <> 0
         then begin
            cx_decompress_pofile:= CXSUB_ERR_READ;
            exit;
         end;

         BlockRead(ifile, ibuff^, k);
         if IOResult <> 0
         then begin
            cx_decompress_pofile:= CXSUB_ERR_READ;
            exit;
         end;

         if CX_CRC(ibuff^, k) <> crc
         then begin
            cx_decompress_pofile:= CXSUB_ERR_INVALID;
            exit;
         end;

         if j = k
            then t:= ibuff
            else begin
               k:= CX_DECOMPRESS(obuff^, CX_MAX_BUFFER, ibuff^, k, tbuff^, CX_D_MINTEMP);
               if k > CX_MAX_BUFFER
               then begin
                  cx_decompress_pofile:= k;
                  exit;
               end;

               if j <> k
               then begin
                  cx_decompress_pofile:= CXSUB_ERR_INVALID;
                  exit;
               end;

               t:= obuff;
            end;

         if extract
         then begin
            BlockWrite(ofile, obuff^, j);
            if IOResult <> 0
            then begin
               cx_decompress_pofile:= CXSUB_ERR_WRITE;
               exit;
            end;
         end;
      end;
   until j = 0;

   cx_decompress_pofile:= 0;
end;

{------------------------------------------------------------------------}
function cx_decompress_ofile(
            var   ofile    :file       ;
            var   ifile    :file       ;
                  extract  :boolean    ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;
var
   ibuff, obuff, tbuff: pointer;
   err: CXINT;

begin
   HeapError:= @cx_heap_func;       {trap out of memory conditions}

   GetMem(ibuff, CX_MAX_BUFFER+CX_SLOP);
   GetMem(obuff, CX_MAX_BUFFER);
   GetMem(tbuff, CX_D_MINTEMP);

   HeapError:= nil;                 {restore  heap error handler}

   if (ibuff = nil) or (obuff = nil) or (tbuff = nil)
   then begin
      if ibuff <> nil then FreeMem(ibuff, CX_MAX_BUFFER+CX_SLOP);
      if obuff <> nil then FreeMem(obuff, CX_MAX_BUFFER);
      if tbuff <> nil then FreeMem(tbuff, CX_D_MINTEMP);
      cx_decompress_ofile:= CXSUB_ERR_NOMEM;
      Exit;
   end;

   cx_decompress_ofile:= cx_decompress_pofile(ofile, ifile, extract,
                           ibuff, obuff, tbuff, callback, p);

   FreeMem(ibuff, CX_MAX_BUFFER+CX_SLOP);
   FreeMem(obuff, CX_MAX_BUFFER);
   FreeMem(tbuff, CX_D_MINTEMP);
end;

{------------------------------------------------------------------------}
function cx_decompress_file(
                  dst      :string     ;
                  src      :string     ;
                  callback :cxback     ;
                  p        :pointer)   : CXINT;
var
   ifile, ofile: file;
   extract: boolean;
   j, k: CXINT;

begin
   Assign(ifile, src);
   Reset(ifile, 1);
   if IOResult <> 0
   then begin
      cx_decompress_file:= CXSUB_ERR_OPENS;
      exit;
   end;

   if dst = ''
   then extract:= False
   else begin
      extract:= True;
      Assign(ofile, dst);
      Rewrite(ofile, 1);
      if IOResult <> 0
      then begin
         Close(ifile);
         cx_decompress_file:= CXSUB_ERR_OPEND;
         exit;
      end;
   end;

   k:= cx_decompress_ofile(ofile, ifile, extract, callback, p);

   Close(ifile);
   j:= IOResult;     {to clear any input file close IOresult}

   if not extract
      then j:= 0
      else begin
         Close(ofile);
         if IOResult = 0
            then j:= 0
            else j:= CXSUB_ERR_CLOSE;
      end;

   if k = 0
      then cx_decompress_file:= j
      else cx_decompress_file:= k;
end;

end.