unit Zip;

{$F+,I-}

INTERFACE

uses
  windows, messages, sysutils;

const
  ZIP_BINARY = 0;
  ZIP_ASCII  = 1;
  ZIP_BUFSIZ = 35256;
  ZIP_OK     = 0;        { No Errors }
  ZIP_ERFrom = -1;       { Error Opening Input File }
  ZIP_ERTo   = -2;       { Error Opening Output File }
  ZIP_ERROR  = -3;       { other errors (No memory, Bad ZIP file) }

const

  cfOk      =  0;
  cfErrFrom = -1;
  cfErrTo   = -2;
  cfErrZip  = -3;
  cfErrCopy = -4;

 { CopyFile Modes }

type

  TCopyFile = ( cfNoZip, cfZip, cfUnZip );

const
  CompressionType: Word = ZIP_BINARY;

  function fZip( fromS, toS: {PathStr}string ): Integer; {returns Error Code }

  function fUnZip( fromS, toS: string{PathStr} ): Integer;

  function CopyFile( fFrom, fTo: {PathStr}string; mode: TCopyFile ): Integer;
          { Copy files using TDosStr; optionally Zip-ed }

IMPLEMENTATION


const
  DictionarySize:  Word = 4096;

var
  FromFile:        TMemoryStream;
  FromSize:        LongInt;
  ToFile:          TMemoryStream;
  Bufff :          Pointer;
  Result:          Integer;

  DiskFullError:   Boolean;
  UnexpectedEOF:   Boolean;

type
  zipIntFunc  = function( var Buff; var bSize: Word ): Word;

function Implode( Read, Write: zipIntFunc; Buf: Pointer;
                  var Ctype: Word; var bSize:Word): Integer;
external;

function Explode( Read, Write: zipIntFunc; Buf: Pointer):
         Integer;
external;

{$L IMPLODE.OBJ}

function zipReadData( var Buffer; var BufferSize: Word): Word;
var
   BytesRead: Word;
begin
   if FromFile.Status <> stOk then UnexpectedEOF := True;
   if BufferSize > FromSize then
   begin
      FromFile.Read( Buffer, Word(FromSize) );
      zipReadData := Word(FromSize)
   end
   else
   begin
      FromFile.Read( Buffer, BufferSize );
      zipReadData := BufferSize;
      Dec( FromSize, LongInt(BufferSize) )
   end;
   if FromFile.Status <> stOk then begin
      { UnexpectedEOF := True; }
      zipReadData := 0
   end
end;

function zipWriteData(var Buffer; var BytesRead: Word):
         Word;
var
   BytesWritten: Word;
begin
   ToFile.Write( Buffer, BytesRead );
   if ToFile.Status <> stOk then begin
      zipWriteData := 0;
      DiskFullError := True
   end else
      zipWriteData := BytesRead
end;

function fZip( fromS, toS: PathStr ): Integer;
begin
  FromFile.Init( fromS, stOpenRead);     { Open input file        }
  if FromFile.Status <> stOk then
  begin
     fZip := ZIP_ERFrom;
{     ErrorBox( FromFile, fromS ); }
     FromFile.Done;
     Exit
  end;
  FromSize := FromFile.GetSize;
  ToFile.Init( toS, stCreate );      { Create output file     }
  if ToFile.Status <> stOk then
  begin
     fZip := ZIP_ERTo;
     FromFile.Done;
{     ErrorBox( ToFile, toS );       }
     ToFile.Done;
     Exit
  end;
  GetMem( Bufff, ZIP_BUFSIZ );
  if Bufff = Nil then
  begin
     fZip := ZIP_ERROR;
     FromFile.Done;
     ToFile.Done; Exit
  end;
  result := implode( zipReadData, zipWriteData, Bufff,
                     CompressionType, DictionarySize );
  FreeMem( Bufff, ZIP_BUFSIZ );
  FromFile.Done;
  ToFile.Done;
  fZip := result;
end;

function fUnZip( fromS, toS: PathStr ): Integer;
begin
  FromFile.Init( fromS, stOpenRead );     { Open input file        }
  if FromFile.Status <> stOk then
  begin
     fUnZip := ZIP_ERFrom;
{     ErrorBox( FromFile, fromS ); }
     FromFile.Done;
     Exit
  end;
  FromSize := FromFile.GetSize;
  ToFile.Init( toS, stCreate );      { Create output file     }
  if ToFile.Status <> stOk then
  begin
     fUnZip := ZIP_ERTo;
     FromFile.Done;
{     ErrorBox( ToFile, toS ); }
     ToFile.Done;
     Exit
  end;
  GetMem( Bufff, ZIP_BUFSIZ );
  if Bufff = Nil then
  begin
     fUnZip := ZIP_ERROR;
     FromFile.Done;
     ToFile.Done;
     Exit
  end;
  result := explode( zipReadData, zipWriteData, Bufff);
  FreeMem( Bufff, ZIP_BUFSIZ );
  FromFile.Done;
  ToFile.Done;
  fUnZip := result
end;

function CopyFile( fFrom, fTo: PathStr; mode: TCopyFile ): Integer;
var
  io: Integer;
  procedure CopyDosFile;
  var
     S0,S1:   TDosStream;
     lLength: LongInt;
  begin
     S0.Init( fFrom, stOpenRead );
     if S0.Status <> stOk then
     begin
        io := cfErrFrom;
{        ErrorBox( S0, fFrom );}
        S0.Done;
        Exit
     end;
     S1.Init( fTo, stCreate );
     if S1.Status <> stOk then
     begin
        io := cfErrTo;
{        ErrorBox( S1, fTo );}
        S0.Done; S1.Done;
        Exit
     end;
     lLength := S0.GetSize;
     S1.CopyFrom( S0, lLength );
     if (S1.Status <> stOk) then
     begin
        io := cfErrCopy;
{        ErrorBox( S1, fTo );}
     end
     else
     if (S0.Status <> stOk) then
     begin
        io := cfErrCopy;
        {ErrorBox( S0, fFrom );}
     end;
     S1.Done; S0.Done
  end;

begin
  io := cfOk;
  DiskFullError := False;
  UnexpectedEOF := False;
  case mode of
    cfNoZip: CopyDosFile;
    cfZip:   io := fZip( fFrom, fTo );
    cfUnZip: io := fUnZip( fFrom, fTo );
  end;
  CopyFile := io;
  if DiskFullError OR UnexpectedEOF then CopyFile := cfErrCopy;
end;

end.
{ END OF ZIP.PAS }

