Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBII/ECO_CFI.PAS

Pascal/Delphi Source File | 1992-06-26 | 52.5 KB | 1,554 lines

{
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
}
(*

         ┌────────────────[ File Information Report ]────────────────┐
         │                                                           │
         │   Sourcefile for The Fast Commander, V3.51 and higher.    │
         │   All material is protected and licensed.                 │
         │   (C) Copyright 1992 by EUROCON PANATIONAL CORPORATION.   │
         │   Written exclusively by Floor Naaijkens for              │
         │   UltiHouse Software / The ECO Group All Rights Reserved. │
         │   See various documentory files for further information   │
         │   on how to handle these files.                           │
         │                                                           │
         │   Filename:      ECO_CFI.PAS                              │
         │   Version:       3.51                                     │
         │   Last change:   02-05-91  14:14                          │
         │   Dependencies:  FIL·, EXT·, MEM·, SCN·, DOS·, ····,      │
         │                  ····, ····, ····, ····, ····, ····.      │
         │                                                           │
         └───────────────────────────────────────────────────────────┘

*)
{$I-,V-,F+,O+,D-,L-}
unit ECO_cfi; { cfi = compression file interface }

interface
uses
  dos

  ;

const
  cfismartmode : boolean = false; { niet verder zoeken na geen hit }
  cfisfx       : boolean = false; {       niet in exe & com kijken }

type
  cfityperecord = record
    cfiname      : string[67]; {filename only 12 chars!!!!!} {even meer !!}
    cfipath      : string[67]; {directory if used}
    cficrc       : longint;    {crc check}
    cfipsize     : longint;    {packed size file}
    cfiosize     : longint;    {original size file}
    cfitime      : longint;    {dos packed time}
    cfiattr      : byte;       {zip and lzh/lzs only}
    cfimethod    : word;       {soort compressie}
    cfiptotal    : longint;    {total packed size}
    cfiototal    : longint;    {total original size}
  end;
  str79          = string[79];
  str8           = string[8];


var
  cfierror          : boolean;
  cfifile           : file;                          { used by all routines }
  cfipos            : longint;               { position where info begins!! }
  cfifilename       : str79;
  cfitype           : cfityperecord;
  cfityp            : byte;                { type archive : zoo, arc, lzh etc }
  readcentralheader : boolean; { read also zip central header default false }



  procedure closecfi;
  function opencfifile(f : str79) : boolean;
  function cfinext : boolean;
  function dectohex(l : longint;cfityp : byte) : str8;



implementation

const
  arc = 1;
  zip = 2;
  lzh = 3;
  zoo = 4;
  dwc = 5;
  lbr = 6;
  arj = 7;


type
  dataarray = array [1..512] of byte;


var
  { heeft groote van de stap die genomen moet worden }
  internal_stap               :   longint;
  {   }
  internal_centralheaderfound :   boolean;
  { voor bekijken of een file die file wel is }
  data                        : dataarray;
  {  # bytes read from zoo file               }
  bytes_read                  :      word;
  cfinextproc                 : procedure;



procedure cfinextempty;
begin
  cfierror := true;
end;


procedure uppercase(var f : string);
var
  loop : byte;
  len  : byte absolute f;

begin
  for loop := 1 to len do f[loop] := upcase(f[loop]);
end;


const archive_marker        = 26      {  marks start of an archive header   };



procedure cfinextarc;
{ ---------------------------------------------------------------------- }
{                   map of archive file entry header                     }
{ ---------------------------------------------------------------------- }

const
  archive_header_length = 29      {  length of an archive header entry  };
  max_subdirs           = 20      {  maximum number of nested subdirs   };

type
  fnametype = array[1..13] of char;

  arc_entry_type = record
    marker   : byte      {  flags beginning of entry  };
    version  : byte      {  compression method        };
    filename : fnametype {  file and extension        };
    size     : longint   {  compressed size           };
    date     : word      {  packed date               };
    time     : word      {  packed time               };
    crc      : word      {  cyclic redundancy check   };
    olength  : longint   {  original length           };
  end;


var {  header for one file in archive  }
  arc_entry     : arc_entry_type absolute data;
  {  nested directory names in       }
  {  archive                         }
  subdir_names  : array [1..max_subdirs] of string[13];
  subdir_depth  : integer;             {  current subdirectory in archive }
  arcfilename   : string[79];          {  long file name              }
  loop          : byte;
  timedate      : longint;
  timedatew     : array [1..2] of word absolute timedate;



  function convertmethod(m : word) : word;
  var
    cm : word;

  begin
    case m of
      1 : cm := 1; {stored 1, file header lacks length field, (sea)}
      2 : cm := 2; {stored 2? (sea)}
      3 : cm := 3; {crunched (sea)}
      4 : cm := 4; {crunched (sea)}
      5 : cm := 5; {crunched (sea)}
      6 : cm := 6; {crunched (sea)}
      7 : cm := 7; {crunched (sea)}
      8 : cm := 8; {crunched (sea)}
      9 : cm := 9; {squashed (only pkware)}
     10 : cm := 10; {curshed (only nogate)}
     11 : cm := 11; {distlled (only nogate)}
     else cm := 255; {unknown}
    end;
    convertmethod := cm
  end;




begin
  if cfierror then exit;
  cfierror := true; {assume error}
  seek(cfifile, cfipos+internal_stap);
  if ioresult <> 0 then exit; {error}
  blockread(cfifile, arc_entry, sizeof(arc_entry_type), bytes_read);
  if ioresult <> 0 then exit;
  if (bytes_read<2) or (bytes_read<>sizeof(arc_entry_type)) then exit;
  if arc_entry.marker <> archive_marker then exit;

{ internal_stap wordt afzonderlijk gezet aangezien lengte afhangt van version }
  inc(cfipos, internal_stap); {dit is algemeen de stap niet!}
  with arc_entry do case version of
    0     : exit; {end of archive}
    1..19 : begin {compressed file}
      if (bytes_read<archive_header_length) then exit;
      internal_stap := archive_header_length + size;

      { wat ben ik hier in gods naam aan het doen????? }
      if version = 1 then begin
        olength := size;
        version := 2;
        dec(internal_stap, 2);
      end;
    end;
    30    : begin { subdirectory begins  }
      if (bytes_read<archive_header_length) then exit;
      internal_stap := archive_header_length;
      if subdir_depth < max_subdirs then begin
        inc(subdir_depth);
        subdir_names[subdir_depth] := copy(filename, 1,
          pred(pos(#0, filename))
        );
      end;
    end;
    31    : begin {end of subdirectory}
      { remove this subdirectory from current nesting }
      if (subdir_depth>0) then dec(subdir_depth);
      internal_stap := 2; {end of dir length}
    end;
    { if other version number just check for length en update internal_stap }
    else begin
      if (bytes_read<archive_header_length) then exit;
      internal_stap := archive_header_length + size;
    end;
  end; { end of case }


  cfitype.cfiname := copy(arc_entry.filename, 1,
    pred(pos(#0, arc_entry.filename))
  );

 { nu subdirectory's nog aan elkaar breien als ze bestaan natuurlijk }
 arcfilename := '';
 if subdir_depth > 0 then begin
   for loop := 1 to subdir_depth do
     arcfilename := concat(arcfilename, subdir_names[loop], '\');
   delete(arcfilename, length(arcfilename), 1); { del laatste char }
 end;
 cfitype.cfipath := arcfilename;

 with cfitype do begin
   cfipsize  := arc_entry.size;
   cfiosize  := arc_entry.olength;

   timedatew[1] := arc_entry.time;
   timedatew[2] := arc_entry.date;
   cfitime   := timedate;

   cficrc    := arc_entry.crc;
   cfiattr   := 0; {geen info in arc files}
   cfimethod := convertmethod(arc_entry.version);
 end;

 cfierror := false;
end;



function testforarc(var data : dataarray) : boolean;
begin
  testforarc := false;
  if data[1] <> archive_marker then exit;
  cfityp := arc;
  testforarc := true;
end;



const
  zip_local_header_signature    = $04034b50;



  procedure cfinextzip;
  { ---------------------------------------------------------------------- }
  {                map of zip file entry headers                           }
  { ---------------------------------------------------------------------- }

  const
    zip_central_header_signature  = $02014b50;
    zip_end_central_dir_signature = $06054b50;

  type {  structure of a local file header  }
    zip_local_header_type = record
      signature           : longint  {  header signature         };
      version             : word     {  vers. needed to extract  };
      bitflag             : word     {  general flags            };
      compressionmethod   : word     {  compression type used    };
      timedate            : longint  {  file creation time&date  };
      crc32               : longint  {  32-bit crc of file       };
      compressedsize      : longint  {  compressed size of file  };
      uncompressedsize    : longint  {  original size of file    };
      filenamelength      : word     {  length of file name      };
      extrafieldlength    : word     {  length of extra stuff    };
    end;

    {  structure of the central directory record  }
    zip_central_header_type = record
      signature           : longint {  header signature         };
      versionmadeby       : word    {  system id/program vers.  };
      versionneeded       : word    {  vers. needed to extract  };
      bitflag             : word    {  general flags            };
      compressionmethod   : word    {  compression type used    };
      timedate            : longint {  file creation time&date  };
      crc32               : longint {  32-bit crc of file       };
      compressedsize      : longint {  compressed size of file  };
      uncompressedsize    : longint {  original size of file    };
      filenamelength      : word    {  length of file name      };
      extrafieldlength    : word    {  length of extra stuff    };
      commentfieldlength  : word    {  length of comments       };
      diskstartnumber     : word    {  disk # file starts on    };
      internalattributes  : word    {  text/non-text flags      };
      externalattributes  : longint {  file system attributes   };
      localheaderoffset   : longint {  where local hdr starts   };
    end;

  var
    zip_entrylocal   : zip_local_header_type;{ local header }
    zip_entrycentral : zip_central_header_type absolute data;{ central header }
    zipfilename      : str79;
    e                : string[4]; {extention}




  function readfilename(var len : word) : boolean;
  begin
    readfilename := false;
    if len > 79 then len := 79; {niet echt goed maar moet kunnen}
    blockread(cfifile, zipfilename[1], len, bytes_read);
    if ioresult <> 0 then exit;
    if bytes_read<>len then exit;
    zipfilename[0] := chr(len);
    with cfitype do begin
      fsplit(zipfilename, cfipath, cfiname, e);
      cfiname := concat(cfiname, e);
    end;
    readfilename := true;
  end;



  function convertmethod1(m : word) : word;
  var cm : word;
  begin
    case m of
      0  : cm := 50; {stored}
      1  : cm := 51; {shrunk}
      2  : cm := 52; {reduced factor 1}
      3  : cm := 53; {reduced factor 2}
      4  : cm := 54; {reduced factor 3}
      5  : cm := 55; {reduced factor 4}
      6  : cm := 56; {imploding}
      else cm := 255; {unknown}
    end;
    convertmethod1 := cm
  end;



  function convertmethod2(m : word) : word;
  var cm : word;
  begin
    case m of
      0  : cm := 80; {stored}
      1  : cm := 81; {shrunk}
      2  : cm := 82; {reduced factor 1}
      3  : cm := 83; {reduced factor 2}
      4  : cm := 84; {reduced factor 3}
      5  : cm := 85; {reduced factor 4}
      6  : cm := 86; {imploding}
      else cm := 255; {unknow}
     end;
     convertmethod2 := cm
   end;


begin
  if cfierror then exit; { er is een error dus we gaan niet verder }
  cfierror := true; { assume error }
  seek(cfifile, cfipos+internal_stap);
  if ioresult <> 0 then exit; {error}
  if not internal_centralheaderfound then begin
    blockread(cfifile, zip_entrylocal, sizeof(zip_local_header_type), bytes_read);
    if ioresult <> 0 then exit;
    if bytes_read < sizeof(zip_local_header_type) then exit; {error}
    {  nu checken wat gelezen is  }
    if zip_entrylocal.signature = zip_local_header_signature then
     { info wordt ingevuld in cfitype }
    with cfitype do begin
      if not readfilename(zip_entrylocal.filenamelength) then exit;
      cficrc    := zip_entrylocal.crc32;
      cfipsize  := zip_entrylocal.compressedsize;
      cfiosize  := zip_entrylocal.uncompressedsize;
      cfitime   := zip_entrylocal.timedate;
      cfimethod := convertmethod1(zip_entrylocal.compressionmethod);
      cfiattr   := 0; {niet aanwezig in local header}

      inc(cfipos, internal_stap);
      internal_stap := sizeof(zip_local_header_type) +
                       zip_entrylocal.filenamelength +
                       zip_entrylocal.extrafieldlength +
                       zip_entrylocal.compressedsize;
      cfierror  := false;
      exit;
    end;
  end;



  { als het geen local header is of zijn daar al voorbij dan central header }
  { bekijken zie source hieronder                                           }
  if not readcentralheader then exit;

  if internal_centralheaderfound then begin
    blockread(cfifile, zip_entrycentral, sizeof(zip_central_header_type),
              bytes_read);
    if ioresult <> 0 then exit;
    if bytes_read < sizeof(zip_central_header_type) then exit; {error}
  end;

  if (not internal_centralheaderfound) and (
    zip_entrylocal.signature=zip_central_header_signature
  ) then begin
    seek(cfifile, cfipos+internal_stap);
    if ioresult <> 0 then exit; {error}
    blockread(cfifile, zip_entrycentral, sizeof(zip_central_header_type),
      bytes_read
    );
    if ioresult <> 0 then exit;
    if bytes_read < sizeof(zip_central_header_type) then exit; {error}
    internal_centralheaderfound := true;
  end;

  if (internal_centralheaderfound) and
     (zip_entrycentral.signature=zip_central_header_signature) then
   { info wordt ingevuld in cfitype }
  with cfitype do begin
    if not readfilename(zip_entrycentral.filenamelength) then exit;
    cficrc    := zip_entrycentral.crc32;
    cfipsize  := zip_entrycentral.compressedsize;
    cfiosize  := zip_entrycentral.uncompressedsize;
    cfitime   := zip_entrycentral.timedate;
    cfimethod := convertmethod2(zip_entrycentral.compressionmethod);
    cfiattr   := zip_entrycentral.externalattributes;

    inc(cfipos, internal_stap);
    internal_stap := sizeof(zip_central_header_type) +
      zip_entrycentral.filenamelength +
      zip_entrycentral.extrafieldlength +
      zip_entrycentral.commentfieldlength;
    cfierror := false;
    exit;
  end;
end;




function testforzip(var data : dataarray) : boolean;
var signature : longint absolute data;
begin
  testforzip := false;
  if signature <> zip_local_header_signature then exit;

  cfityp := zip;
  testforzip := true;
end;




{define dochecksum}

{ ---------------------------------------------------------------------- }
{                   map of lzh file entry header                         }
{ ---------------------------------------------------------------------- }

type char5           = array[1..5] of char;

     lzh_entry_type  = record
      reclen   : byte      {  header record length      };
      checksum : byte      {  checksum of header bytes  };
      compress : char5     {  compression type          };
      csize    : longint   {  compressed size           };
      osize    : longint   {  original size             };
      timedate : longint   {  packed time&date          };
      attr     : word      {  file attributes           };
      fnamelen : byte      {  length of file name       };
     end;


procedure cfinextlzh;
var lzh_entry     : lzh_entry_type absolute data;
    lenname       : byte;
    lzhfilename   : str79;
    e             : string[4];
    crccheck      : word;

  function convertmethod : word;
  var cm : word;
  begin
   cm := 255; {unknown}
   with lzh_entry do
    begin
     {lzh}
     if compress = '-lh0-' then cm := 200;
     if compress = '-lh1-' then cm := 201;
     if compress = '-lh2-' then cm := 202;
     if compress = '-lh3-' then cm := 203;
     if compress = '-lh4-' then cm := 204;
     if compress = '-lh5-' then cm := 205;

     {lzs vanaf 230 }
     if compress = '-lz0-' then cm := 230;{?}
     if compress = '-lz1-' then cm := 231;{?}
     if compress = '-lz2-' then cm := 232;{?}
     if compress = '-lz3-' then cm := 233;{?}
     if compress = '-lz4-' then cm := 234;
     if compress = '-lz5-' then cm := 235;
    end; {with}

   convertmethod := cm
  end;

begin
 if cfierror then exit; { als error dan niet verder want wie weet! }
 cfierror := true; { assume error }
 seek(cfifile, cfipos+internal_stap);
 if ioresult <> 0 then exit; {error}
 blockread(cfifile, lzh_entry, sizeof(lzh_entry_type), bytes_read);
 if ioresult <> 0 then exit;
 if bytes_read <> sizeof(lzh_entry_type) then exit;
 lenname := lzh_entry.fnamelen;
 blockread(cfifile, lzhfilename[1], lenname, bytes_read);
 if ioresult <> 0 then exit;
 if lzh_entry.fnamelen <> bytes_read then exit;
 blockread(cfifile, crccheck, sizeof(crccheck), bytes_read);
 if ioresult <> 0 then exit;
 if sizeof(crccheck) <> bytes_read then exit;

 lzhfilename[0] := chr(lzh_entry.fnamelen);

 with cfitype do
  begin
   fsplit(lzhfilename, cfipath, cfiname, e);
   cfiname   := concat(cfiname, e);
   cficrc    := crccheck;
   cfipsize  := lzh_entry.csize;
   cfiosize  := lzh_entry.osize;
   cfitime   := lzh_entry.timedate;
   cfiattr   := lzh_entry.attr;
   cfimethod := convertmethod; {moet toch wat invullen niet}
   inc(cfipos, internal_stap);
   internal_stap := lzh_entry.reclen + lzh_entry.csize + 2; {2 van crc}
   if internal_stap < 0 then exit; {fout ??!}
  end;
 cfierror := false;
end;


function testforlzh(var data : dataarray) : boolean;
var lzhentry : lzh_entry_type absolute data;
    f        : str79;
    loop     : integer;
    crc      : word;
    crcw     : array [1..2] of byte absolute crc;

  { berekent crc van entry }
  function mksum : byte;
  var i        : byte;
      checksum : byte;
      lzhcheck : array[1..sizeof(lzh_entry_type)] of byte absolute data;
  begin
   checksum := 0;

   for i := 3 to 22 do checksum := (checksum + lzhcheck[i]);
   for i := 1 to lzhentry.fnamelen do checksum := (checksum + ord(f[i]));
   checksum := checksum+lo(crc);
   checksum := checksum+hi(crc);

   mksum := checksum;
  end;

begin
 testforlzh := false;

 if lzhentry.fnamelen > 79 then exit;
 for loop := sizeof(lzh_entry_type) to sizeof(lzh_entry_type)+
             lzhentry.fnamelen do
  f[loop-sizeof(lzh_entry_type)] := chr(data[loop]);

 crcw[1] := data[sizeof(lzh_entry_type)+lzhentry.fnamelen+1];
 crcw[2] := data[sizeof(lzh_entry_type)+lzhentry.fnamelen+2];

{$IFDEF DOCHECKSUM}
 if mksum <> lzhentry.checksum then exit;
{$ENDIF}

 cfityp := lzh;
 testforlzh := true;
end;


const valid_zoo  = $fdc4a7dc            {  valid zoo tag           };

procedure cfinextzoo;
{ ---------------------------------------------------------------------- }
{                   maps of zoo file headers and entries                 }
{ ---------------------------------------------------------------------- }

const pathsize   = 256                  {  max length of pathname  };
      fnamesize  = 13                   {  size of dos filename    };
      lfnamesize = 256                  {  size of long filename   };

type fname_type       = array [1..fnamesize] of char;
     lfname_type      = array [1..lfnamesize] of char;
     path_type        = array [1..pathsize] of char;

     {  one entry in zoo library fixed part of entry       }
     zoo_entry_type  = record
      zoo_tag     : longint              {  tag -- redundancy check  };
      zoo_type    : byte                 {  type of directory entry  };
      pack_method : byte                 {  0 = no packing, 1 = normal lzw  };
      next        : longint              {  pos'n of next directory entry  };
      offset      : longint              {  position of this file  };
      date        : word                 {  dos format date  };
      time        : word                 {  dos format time  };
      file_crc    : word                 {  crc of this file  };
      org_size    : longint              {  original file size  };
      size_now    : longint              {  compressed file size  };
      major_ver   : byte                 {  version required to extract ...  };
      minor_ver   : byte                 {  this file (minimum)              };
      deleted     : byte                 {  will be 1 if deleted, 0 if not  };
      struc       : byte                 {  file structure if any  };
      comment     : longint              {  points to comment;  zero if none  };
      cmt_size    : word                 {  length of comment, 0 if none  };
      fname       : fname_type           {  filename  };

      var_dir_len : integer              {  length of variable part of dir entry  };
      time_zone   : byte                 {  time zone where file was created  };
      dir_crc     : word                 {  crc of directory entry  };
     end;

                                   {  variable part of entry  }

   zoo_varying_type = array [1..4+pathsize+lfnamesize] of char;

   {  varying field definitions follow   }
   {  for descriptive purposes.  any or  }
   {  all of these can be missing,       }
   {  depending upon the setting of      }
   {  var_dir_len above and namlen and   }
   {  dirlen here.                       }

  function convertmethod(m : word) : word;
  var cm : word;
  begin
   case m of
    0 : cm := 100; {stored}
    1 : cm := 101; {lwz compression}
    else cm := 255; {unknown}
   end;
   convertmethod := cm
  end;

var namlen        : byte             {  length of long filename   };
    dirlen        : byte             {  length of directory name  };
    system_id     : integer          {  filesystem id             };

    zoo_entry     : zoo_entry_type;
    zoo_varying   : zoo_varying_type     {  varying part of zoo entry        };
    zoo_pos       : longint              {  current byte offset in zoo file  };
    zoofilename   : string               {  long file name                   };
    directname    : string               {  directory name                   };
    timedate      : longint;
    timedatew     : array [1..2] of word absolute timedate;
begin
 if cfierror then exit; { er is een error dus we gaan niet verder }
 cfierror := true; { assume error }
{  cfipos kan niet wordt gebruikt aangezien ze worden aangegeven door  }
{  de internal_stap die de presiezer plek heeft                        }
 seek(cfifile, {cfipos+}internal_stap);
 if ioresult <> 0 then exit; {error}
 blockread(cfifile, zoo_entry, sizeof(zoo_entry_type), bytes_read);
 if ioresult <> 0 then exit;
 if bytes_read < sizeof(zoo_entry_type) then exit;
 if zoo_entry.zoo_tag <> valid_zoo then exit;

 {  get filename and posibele directory and proces this information  }
 { here we get short name }
 cfitype.cfipath := '';
 cfitype.cfiname := copy(zoo_entry.fname, 1, pred(pos(#0, zoo_entry.fname)));

 if zoo_entry.var_dir_len > 0 then
  begin
   blockread(cfifile, zoo_varying, zoo_entry.var_dir_len, bytes_read);
    if ioresult <> 0 then exit;
    if (bytes_read=zoo_entry.var_dir_len) then with zoo_entry do
     begin { here we get long name }
      { get length names }
      namlen := ord(zoo_varying[1]);
      dirlen := ord(zoo_varying[2]);
      {  get system_id  }
      if (namlen+dirlen+2) < var_dir_len then
       move(zoo_varying[namlen+dirlen+3], system_id, 2)
       else system_id := 4095;

      if (dirlen>0) or (namlen>0) then
       begin
        {  get filename wordt niet ondersteund want kan langer zijn dan  }
        {  12 charakters                                                 }
        if namlen>0 then
         begin
          move(zoo_varying[3], zoofilename[1], pred(namlen));
          zoofilename[0] := chr(pred(namlen));
         end;{ else} zoofilename := cfitype.cfiname;
        { get directory name }
        if (dirlen>0) then
         begin
          move(zoo_varying[3+namlen], directname[1], pred(dirlen));
          directname[0] := chr(pred(dirlen));
          { append '/' if system_id says so }
          if (system_id<=2) then
           if (directname[length(directname)] <> '/') then
            directname := directname+'/';
          cfitype.cfipath := directname;
         end;
       end;
     end;
  end;

 if zoo_entry.deleted <> 0 then cfitype.cfiname := '*DELETED*';
 if zoo_entry.next = 0 then exit; {einde zoo file}

 with cfitype do
  begin
   cficrc    := zoo_entry.file_crc;
   cfipsize  := zoo_entry.size_now;
   cfiosize  := zoo_entry.org_size;

   timedatew[1] := zoo_entry.time;
   timedatew[2] := zoo_entry.date;
   cfitime   := timedate;
   cfiattr   := 0;
   cfimethod := convertmethod(zoo_entry.pack_method);

   cfipos := internal_stap;
   internal_stap := zoo_entry.next;
   cfierror := false;
  end;
end;


function testforzoo(var data : dataarray) : boolean;
{  deze procedure checkt op zoo file en als hij er een vindt dan wordt de  }
{  eerste file entry opgeslagen in internal_stap                           }
{ ---------------------------------------------------------------------- }
{                   maps of zoo file headers and entries                 }
{ ---------------------------------------------------------------------- }
const siz_text   = 20                   {  length of header text   };
type header_text_type = array [1..siz_text] of char;
     {  zoo file header  }
     zoo_header_type = record
      header_text : header_text_type     {  character text       };
      zoo_tag     : longint              {  identifies archives  };
      zoo_start   : longint              {  where data starts    };
      zoo_minus   : longint              {  consistency check    };
      zoo_major   : char                 {  major version #      };
      zoo_minor   : char                 {  minor version #      };
     end;

var zoo_header    : zoo_header_type absolute data; {  header for zoo file  }
begin
 testforzoo := false; {assume no zoo file}
 {wordt van uitgegaan dat start = 0 }
 if zoo_header.zoo_tag <> valid_zoo then exit; {geen zoo file}

 internal_stap := zoo_header.zoo_start;
 cfityp := zoo;
 testforzoo := true; {zoo file checks so far ok}
end;


function blockpos(var buffer;size : word;s : string) : integer;
{ search in buffer of size bytes for the string s }
begin
{ load "buffer" address into es:di, "buffer" offset into bx, length(s) -
  1 into dx, contents of "s[1]" into al, offset of "s[2]" into si, and
  "size" - length(s) + 1 into cx.  if "size" < length(s), or if
  length(s) = 0, return zero. }

  inline($1e/               {        push    ds           }
         $16/               {        push    ss           }
         $1f/               {        pop     ds           }
         $c4/$be/>buffer/   {        les     di, buffer[bp]}
         $89/$fb/           {        mov     bx, di        }
         $8b/$8e/>size/     {        mov     cx, size[bp]  }
         $8d/$b6/>s+2/      {        lea     si, s+2[bp]   }
         $8a/$86/>s+1/      {        mov     al, s+1[bp]   }
         $8a/$96/>s/        {        mov     dl, s[bp]     }
         $84/$d2/           {        test    dl, dl        }
         $74/$23/           {        jz      error        }
         $fe/$ca/           {        dec     dl           }
         $30/$f6/           {        xor     dh, dh        }
         $29/$d1/           {        sub     cx, dx        }
         $76/$1b/           {        jbe     error        }

  { scan the es:di buffer, looking for the first occurrence of "s[1]."  if
    not found prior to reaching length(s) characters before the end of the
    buffer, return zero.  if length(s) = 1, the entire string has been
    found, so report success. }

       $fc/               {        cld                  }
       $f2/               {next:   repne                }
       $ae/               {        scasb                }
       $75/$16/           {        jne     error        }
       $85/$d2/           {        test    dx, dx        }
       $74/$0c/           {        jz      found        }

  { compare "s" (which is at ss:si) with the es:di buffer, in both cases
    starting with the first byte just past the length byte of the string.
    if "s" does not match what is at the di position of the buffer, reset
    the registers to the values they had just prior to the comparison, and
    look again for the next occurrence of the length byte. }

         $51/               {        push    cx           }
         $57/               {        push    di           }
         $56/               {        push    si           }
         $89/$d1/           {        mov     cx, dx        }
         $f3/               {        repe                 }
         $a6/               {        cmpsb                }
         $5e/               {        pop     si           }
         $5f/               {        pop     di           }
         $59/               {        pop     cx           }
         $75/$ec/           {        jne     next         }

  { string found in buffer.  set ax to the offset, within buffer, of the
    first byte of the string (the length byte), assuming that the first
    byte of the buffer is at offset 1. }

         $89/$f8/           {found:  mov     ax, di        }
         $29/$d8/           {        sub     ax, bx        }
         $eb/$02/           {        jmp     short return }

  { an "error" condition.  return zero. }

         $31/$c0/           {error:  xor     ax, ax        }
         $89/$46/$fe/       {return: mov     [bp-2], ax    }
         $1f)               {        pop     ds           }
end;


{ ---------------------------------------------------------------------- }
{    names of the months and days in each month for date conversions     }
{ ---------------------------------------------------------------------- }
const {  # of seconds local time leads/lags  }
      {  greenwich mean time (gmt)           }
      gmt_difference        : word    = 7 * 3600;
      use_daylight_savings  : boolean = true;
      days_per_month : array[1..12] of byte
                       = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );

{ ---------------------------------------------------------------------- }
{    starting/ending dates for daylight savings time from 1980 to now    }
{ ---------------------------------------------------------------------- }

type
   daylight_savings_record = record
                                starting_time : longint;
                                ending_time   : longint;
                             end;

var
   daylight_savings_time : array[1980..2000] of daylight_savings_record;


procedure get_unix_style_date(     date  : longint;
                               var year  : word;
                               var month : word;
                               var day   : word;
                               var hour  : word;
                               var mins  : word;
                               var secs  : word );

{ ---------------------------------------------------------------------- }
{                                                                        }
{      procedure:  get_unix_style_date                                   }
{                                                                        }
{      purpose:    converts date in unix form to ymd, hms form           }
{                                                                        }
{ ---------------------------------------------------------------------- }

const
   secs_per_year      = 31536000;
   secs_per_leap_year = 31622400;
   secs_per_day       = 86400;
   secs_per_hour      = 3600;
   secs_per_minute    = 60;

var
   rdate     : longint;
   savedate  : longint;
   t         : longint;

begin {  get_unix_style_date  }
                                   {  starting date is january 1, 1970  }
   year  := 1970;
   month := 1;

   rdate    := date - gmt_difference;
   savedate := rdate;
                                   {  sweep out year  }
   while( rdate > 0 ) do
      begin

         if ( year mod 4 ) = 0 then
            t := secs_per_leap_year
         else
            t := secs_per_year;

         rdate := rdate - t;

         inc( year );

      end;

   rdate := rdate + t;

   dec( year );
                                   {  adjust for daylight savings time  }
                                   {  if necessary                      }
   if use_daylight_savings then
      with daylight_savings_time[year] do
         begin
            if ( ( savedate >= starting_time ) and
                 ( savedate <= ending_time   )     ) then
               rdate := rdate + secs_per_hour;
         end;

                                   {  adjust for leap year  }

   if ( ( year mod 4 ) = 0 ) then
      days_per_month[ 2 ] := 29
   else
      days_per_month[ 2 ] := 28;

                                   {  sweep out month  }
   while( rdate > 0 ) do
      begin

         t     := longint( days_per_month[ month ] ) * secs_per_day;

         rdate := rdate - t;

         inc( month );

      end;

   rdate := rdate + t;

   dec( month );
                                   {  get day  }

   day   := ( rdate + pred( secs_per_day ) ) div secs_per_day;
   rdate := rdate - longint( pred( day ) ) * secs_per_day;

                                   {  get time within day  }

   hour  := rdate div secs_per_hour;
   rdate := rdate mod secs_per_hour;

   mins  := rdate div secs_per_minute;
   secs  := rdate mod secs_per_minute;

end   {  get_unix_style_date  };

{  de dataarray wordt altijd gebruikt om groote stukken data te bewaren  }
{  hierdoor is het stack gebruik een stuk lager                          }
type fnametype = array [1..13] of char;

procedure cfinextdwc;
type {  individual file entry  }
     dwc_entry_type  = record
      filename : fnametype {  file and extension        };
      size     : longint   {  original size             };
      time     : longint   {  packed date and time unix };
      new_size : longint   {  compressed size           };
      fpos     : longint   {  position in dwc file      };
      method   : byte      {  compression method        };
      sz_c     : byte      {  size of comment           };
      sz_d     : byte      {  size of dir name on add   };
      crc      : word      {  cyclic redundancy check   };
     end;


  function convertmethod(m : word) : word;
  var cm : word;
  begin
   case m of
    2 : cm := 250; {stored}
    1 : cm := 251; {crunched}
    else cm := 255; {unknown}
   end;
   convertmethod := cm
  end;


    {  entry for one file in dwc lib    }
var dwcentry : dwc_entry_type absolute data;
    dt       : datetime;
begin
 cfierror := true; {assume error}
 seek(cfifile, {cfipos+}internal_stap);
 if ioresult <> 0 then exit;
 blockread(cfifile, dwcentry, sizeof(dwc_entry_type), bytes_read);
 if ioresult <> 0 then exit;
 if bytes_read < sizeof(dwc_entry_type) then exit;

 with cfitype do
  begin
   cfiname   := copy(dwcentry.filename, 1, pred(pos(#0, dwcentry.filename)));
   cfipath   := '';
   cfipsize  := dwcentry.new_size;
   cfiosize  := dwcentry.size;
   cfimethod := convertmethod(dwcentry.method);
   cfiattr   := 0; {niet in dwc}
   cficrc    := dwcentry.crc;
   get_unix_style_date(dwcentry.time, dt.year, dt.month, dt.day, dt.hour,
                       dt.min, dt.sec);
   packtime(dt, cfitime);
   cfipos := internal_stap;
   internal_stap := internal_stap + bytes_read; {next entry zoiets als zoo}
  end;

 cfierror := false;
end;


function testfordwc(var data : dataarray) : boolean;
const bufsize    = 256;
      maxentries = 1800              {  maximum # of files in dwc file  };

type id_type   = array [1..3] of char;
     {  header for entire dwc file  }
     dwc_header_type = record
      size    : word       {  size of archive structure, future expansion  };
      ent_sz  : byte       {  size of directory entry, future expansion    };
      header  : fnametype  {  name of header file to print on listings     };
      time    : longint    {  time stamp of last modification to archive   };
      entries : longint    {  number of entries in archive                 };
      id_3    : id_type    {  the string "DWC" to identify archive         };
     end;

var buf          : array [1..bufsize] of char absolute data;
    count        : word;
    l            : longint;
    dwcpos       : longint;
    id_found     : boolean;
    i            : integer;
    dwcheader    : dwc_header_type absolute data;
    dir_size     : word;{  size in bytes of directory  }
begin
 testfordwc := false;
 l := filesize(cfifile); count := 1;
 id_found := false;

 repeat
  dwcpos := l - (count*bufsize-pred(count)*5);
  if dwcpos < 0 then dwcpos := 0;
  seek(cfifile, dwcpos);
  if ioresult <> 0 then exit;
  fillchar(buf, bufsize, #0);{empty buff (just to be sure) }
  blockread(cfifile, buf, bufsize, bytes_read);
  if ioresult <> 0 then exit;
  i := blockpos(buf, bufsize, 'DWC');
  if i <> 0 then id_found := true else inc(count);
 until (count>10) or (id_found);

 if id_found then
  begin
   { we found true end of dwc file (i hope)  }
   dwcpos := dwcpos + i + 2;
   seek(cfifile, dwcpos-sizeof(dwc_header_type));
   if ioresult <> 0 then exit;
   blockread(cfifile, dwcheader, sizeof(dwc_header_type), bytes_read);
   if ioresult <> 0 then exit;
   if bytes_read < sizeof(dwc_header_type) then exit;
   {  check # of entries for reasonableness  }
   if (dwcheader.entries<0) or (dwcheader.entries>maxentries) then exit;
   with dwcheader do
    begin
     dir_size := entries * ent_sz;
     internal_stap := dwcpos - (dir_size + size);
    end;{with}
  end;

 seek(cfifile, 0); {zoals standaard bij andere archives}
 if ioresult <> 0 then exit;
 cfityp := dwc;
 testfordwc := true;
end;


var lbr_dir_size  : integer;        {  # of entries in library directory      }
{ ---------------------------------------------------------------------- }
{               map of library file (.lbr) entry header                  }
{ ---------------------------------------------------------------------- }
const lbr_header_length = 32          {  length of library file header entry    };

type lbr_entry_type = record
      flag  : byte                   {  lbr - entry flag            };
      name  : array [1..8] of char   {  file name                   };
      ext   : array [1..3] of char   {  extension                   };
      offset: word                   {  offset within library       };
      n_sec : word                   {  number of 128-byte sectors  };
      crc   : word                   {  crc (optional)              };
      date  : word                   {  # days since 1/1/1978       };
      udate : word                   {  date of last update         };
      time  : word                   {  packed time                 };
      utime : word                   {  time of last update         };
      pads  : array [1..6] of char   {  currently unused            };
     end;


procedure cfinextlbr;
const ndays : array [1..12] of integer = ( 31, 28, 31, 30, 31, 30,
                                           31, 31, 30, 31, 30, 31  );
var lbrentry      : lbr_entry_type; {  header describing one file in library  }
    timedate      : longint;
    timedatew     : array [1..2] of word absolute timedate;
    month         : integer;
    year          : integer;
    done          : boolean;
    t             : integer;

  function convertmethod : word;
  begin
   convertmethod := 181;
  end;

begin
 cfierror := true;
 seek(cfifile, cfipos+internal_stap);
 if ioresult <> 0 then exit;

 blockread(cfifile, lbrentry, sizeof(lbr_entry_type), bytes_read);
 if ioresult <> 0 then exit;
 if bytes_read < lbr_header_length then exit;
 if lbrentry.flag <> 0 then exit;
 with lbrentry do
  begin
  {  pick up time/date of creation this  }
  {  entry if specified.  if the update  }
  {  time/date is different, then we     }
  {  will report that instead.           }

   if time = 0 then
    begin
     time := utime;
     date := udate;
    end else if (time<>utime) or (date<>udate) then
              begin
               time := utime;
               date := udate;
              end;
  {  convert date from library format of  }
  {  # days since 1/1/1978 to dos format  }
   month := 1;
   year  := 78;
   {  this is done using brute force.  }
   repeat
   {  account for leap years  }

    t := 365 + ord(year mod 4 = 0);

   {  see if we have less than 1 year left  }

    done := (date<t);

    if (not done) then
     begin
      year := succ(year);
      date := date - t;
     end;

   until done;
   {  now get months and days within year  }
   repeat
    t := ndays[month] + ord((month = 2) and (year mod 4 = 0));

    done := (date<t) ;

    if (not done) then
     begin
      month := succ(month);
      date  := date - t;
     end;

   until done;
   {  if > 1980, convert to dos date  }
   {  else leave unconverted.         }

   if (year>=80) then
    date := (year - 80) shl 9 + month shl 5 + date
    else date := 0;
  end;{with}

 with cfitype do
  begin
   cfiname      := copy(lbrentry.name, 1, pred(pos(' ', lbrentry.name)));
   if cfiname = '' then cfiname := lbrentry.name;
   if lbrentry.ext <> '   ' then cfiname := concat(cfiname, '.', lbrentry.ext);
   cfiosize     := lbrentry.n_sec * 128;
   cfipsize     := lbrentry.n_sec;

   timedatew[1] := lbrentry.time;
   timedatew[2] := lbrentry.date;
   cfitime      := timedate;

   cficrc       := lbrentry.crc;
   cfiattr      := 0; {niet aanwezig}

   cfimethod := convertmethod;

   inc(cfipos, internal_stap);
   internal_stap := lbr_header_length;
  end;

 cfierror := false;
end;


function testforlbr(var data : dataarray) : boolean;
var lbrentry   : lbr_entry_type absolute data;
begin
 testforlbr := false;
  with lbrentry do
   begin
    if lbrentry.flag <> 0 then exit;
    internal_stap := lbr_header_length;
   end;

 cfityp := lbr;
 testforlbr := true;
end;


{ ---------------------------------------------------------------------- }
{                   map of arj file entry header                         }
{ ---------------------------------------------------------------------- }

const arjheaderid1 = $60ea;
      arjheaderid2 = 60000;

type arj_entry_type   = record
      headerid        : word;
      headersize      : word; {  size after first_hdr_size  }
      first_hdr_size  : byte;
      res             : byte;
      archiveversion  : byte; {  version needed to extract  }
      hostos          : byte;
      arjflags        : byte;
      method          : byte;
      filetype        : byte;
      reserved        : byte;{byte}
      timedate        : longint;
      compsize        : longint; {  compressed size  }
      orgsize         : longint; {  orginal size  }
      orgcrc          : longint;
      fileaccesmode   : word;
      entrynamepos    : word;
      hostdata        : word;
      {  extra data follows  }
     end;


procedure cfinextarj;
var arj_entry     : arj_entry_type;
    lenname       : byte;
    arjfilename   : str79;
    extraheader   : word;

  function convertmethod(m : word) : word;
  var cm : word;
  begin
   case m of
    0 : cm := 190; {stored}
    1 : cm := 191; {1..3 compressed most}
    2 : cm := 192;
    3 : cm := 193;
    4 : cm := 194; {compressed fastest}
    else cm := 255; {unknown}
   end;
   convertmethod := cm
  end;

begin
 if cfierror then exit; { als error dan niet verder want wie weet! }
 cfierror := true; { assume error }
 seek(cfifile, cfipos+internal_stap);
 if ioresult <> 0 then exit; {error}
 blockread(cfifile, arj_entry, sizeof(arj_entry), bytes_read);
 if bytes_read < sizeof(arj_entry) then exit;
 if (arj_entry.headerid<>arjheaderid1) and (arj_entry.headerid<>arjheaderid2)
  then exit;
 if arj_entry.headersize = 0 then exit;

 extraheader := (arj_entry.headersize-arj_entry.first_hdr_size);

 with arj_entry do
  begin
   blockread(cfifile, data, extraheader, bytes_read);
   if ioresult <> 0 then exit;

   for lenname := 1 to extraheader do
    begin
     if data[lenname] = 0 then
      begin
       arjfilename[0] := chr(lenname-1);
       lenname := extraheader;
      end else arjfilename[lenname] := chr(data[lenname]);
    end;
  end; {with}

 with cfitype do
  begin
   cfiname   := arjfilename;
   cfipath   := '';
   cficrc    := arj_entry.orgcrc;
   cfipsize  := arj_entry.compsize;
   cfiosize  := arj_entry.orgsize;
   cfitime   := arj_entry.timedate;
   cfimethod := convertmethod(arj_entry.method);
   cfiattr   := arj_entry.fileaccesmode;

   inc(cfipos, internal_stap);
   internal_stap := arj_entry.headersize+arj_entry.compsize+10;

   cfierror := false;
   exit;
  end; {with}
end;


function testforarj(var data : dataarray) : boolean;
var arj_entry : arj_entry_type absolute data;
begin
 testforarj := false;
 if (arj_entry.headerid<>arjheaderid1) and (arj_entry.headerid<>arjheaderid2)
  then exit;

 internal_stap := arj_entry.headersize + 10;{10???????}
 cfityp := arj;
 testforarj := true;
end;


procedure closecfi;
begin
 close(cfifile);
 { gewoon fout opvangen }
 if ioresult <> 0 then;
end;

function opencfifile;
const datablock = 100;
var ext        : string[4]; {extentie string}
    readbuffer : boolean; {test of data moet worden ingelezen}
    isarchive  : boolean;
begin
{ initialiseren van enkele variabelen }
 cfifilename := f;
 cfipos := 0; internal_stap := 0; internal_centralheaderfound := false;
 cfierror := true; opencfifile := false;
 with cfitype do
  begin
   cfiptotal := 0;
   cfiototal := 0;
  end;

{ openen van file }
 assign(cfifile, f);
 reset(cfifile, 1);
 if ioresult <> 0 then exit;

 { testen op soort file met behulp van extentie }
 ext := copy(f, succ(pos('.', f)), 3); {get extention}
 uppercase(ext); isarchive := false;
{ bij dwc staat het aan het einde van de file !!!!! dus geen zin om dubbel }
{ iets te laden. data wordt gebruikt als buffer                            }
 if (ext='DWC') then isarchive := testfordwc(data);

 readbuffer := false;
 if (not isarchive) then
  begin
   if (ext<>'ZIP') or (ext<>'PAK') or (ext<>'ARC') or (ext<>'PKA') or
      (ext<>'ZOO') or (ext<>'LBR') or (ext<>'ARJ') then
      begin
       if cfismartmode and (ext<>'EXE') and (ext<>'COM') then
        readbuffer := true;
       if cfisfx and ((ext='EXE') or (ext='COM')) then
        readbuffer := true;
      end else readbuffer := true;
  end;


 fillchar(data, sizeof(data), #0); { fill with nothing }
 if readbuffer then
  begin
   blockread(cfifile, data, datablock);
   if ioresult <> 0 then exit;
   seek(cfifile, 0);
   if ioresult <> 0 then exit;
  end;

 if (not isarchive) and (readbuffer) then
  begin {geen dwc of andere extentie}
   if (ext='PAK') or (ext='ARC') or (ext='PKA') then
    isarchive := testforarc(data);
   if (ext='ZIP') then isarchive := testforzip(data);
   if (ext='LZH') or (ext='ICE') or (ext='LZS') then
    isarchive := testforlzh(data);
   if (ext='ZOO') then isarchive := testforzoo(data);
   if (ext='LBR') then isarchive := testforlbr(data);
   if (ext='ARJ') then isarchive := testforarj(data);
  end;

 if (readbuffer) and (not isarchive) and (cfismartmode) and ((ext<>'COM')
    or (ext<>'EXE')) then
  begin {geen hit met extentie zoek het zelf uit}
  {  dit kan alleen bij zip, lzh/lzs, zoo, arc files  }
   if not isarchive then isarchive := testforarc(data);
   if not isarchive then isarchive := testforzip(data);
   if not isarchive then isarchive := testforzoo(data);
   if not isarchive then isarchive := testforlzh(data);
   if not isarchive then isarchive := testforarj(data);
  end;

 if isarchive then
  begin
   case cfityp of
    arc : cfinextproc := cfinextarc;
    zip : cfinextproc := cfinextzip;
    lzh : cfinextproc := cfinextlzh;
    zoo : cfinextproc := cfinextzoo;
    dwc : cfinextproc := cfinextdwc;
    lbr : cfinextproc := cfinextlbr;
    arj : cfinextproc := cfinextarj;
   end; {case}
  end;

 if not isarchive then begin
   closecfi;
   cfinextproc := cfinextempty;
   exit;
  end;
 cfierror := false; opencfifile := true;
end;

function cfinext;
label repeatagain;
begin
repeatagain:
 cfinext := false;
 {pointer naar een variabele procedure zie cfityp}
 cfinextproc;

 if not cfierror then with cfitype do
  begin
   inc(cfiptotal, cfipsize);
   inc(cfiototal, cfiosize);
   uppercase(cfiname);
   if cfiname='*DELETED*' then goto repeatagain;
   uppercase(cfipath);
   cfinext := true;
  end;
end;


{ local procedure to mask out and store nybbles in a string }
procedure maskout;
begin
inline(
  $b5/$04/           {     mov  ch, 4         ; number of digits }
  $b1/$04/           { l1: mov  cl, 4         ; set count to 4 bits }
  $d3/$c3/           {     rol  bx, cl        ; left digit to right }
  $88/$d8/           {     mov  al, bl        ; move to al }
  $24/$0f/           {     and  al, 15        ; mask off left digit }
  $04/$30/           {     add  al, '0'       ; convert hex to ascii }
  $3c/$39/           {     cmp  al, '9'       ; is it > 9? }
  $76/$02/           {     jbe  l2            ; jump if digit = 0 to 9 }
  $04/$07/           {     add  al, 7         ; digit is a to f }
  $47/               { l2: inc  di            ; increment string index }
  $26/$88/$05/       {     mov  es:[di], al   ; store byte in string }
  $fe/$cd/           {     dec  ch            ; decrement digit count }
  $75/$e8);          {     jnz  l1            ; if not 0, keep on scanning }
end;   { maskout }

function declongtohex(l : longint) : str8;
begin
inline(
  $c4/$7e/$0a/       {     les  di, string    ; load string }
  $26/$c6/$05/$08/   {     mov  es:[di], 8    ; set length byte }
  $8b/$5e/$08);      {     mov  bx, [bp+8]    ; load high word of longint }
  maskout;
inline(
  $8b/$5e/$06);      {     mov  bx, [bp+6]    ; load low word of longint }
  maskout;
end;  { hexlongint }

function dectohex;
var temp : str8;
begin
 temp := declongtohex(l);
 if (cfityp<>zip) and (cfityp<>arj) then
  begin
   delete(temp, 1, 4);
   temp := '  '+temp;
  end;
 dectohex := temp;
end;



begin
  cfierror := true; cfipos := 0;
  readcentralheader := false; internal_stap := 0;
  internal_centralheaderfound := false;
  cfinextproc := cfinextempty;
end.