(*    IFL - Interior File Listing Utility
 *    Copyright 1989 by Martin Pollard.  All rights reserved.
 *
 *    IFL produces a listing of files contained in an archive file.
 *    Archive formats supported by IFL include:
 *
 *      ARC - Developed by System Enhancement Associates
 *           and enhanced by PKWARE (PKARC & PKPAK)
 *           and NoGate Consulting (PAK)
 *      LZH - Developed by Haruyasu Yoshizaki
 *      ZIP - Developed by PKWARE
 *      ZOO - Developed by Rahul Dhesi
 *
 *    Version history:
 *
 *    1.00 02/11/89 Initial release.
 *    1.10 02/24/89 1.  Added support for archives created with SEA's
 *              ARC 6.x, which uses new header codes to support
 *              subdirectory archiving.
 *            2.  Restructured much of the code, which made no
 *              operational difference but resulted in a much
 *              "cleaner" source file.
 *            3.  Added automatic extension support.  IFL will now
 *              cycle through all supported extensions until it
 *              finds the desired file.
 *    1.20 03/15/89 1.  Added ZOO archive support.
 *            2.  The message line above the headings was changed
 *              to "Archive <filename> contains the following
 *              files:".  The drive and pathname is no longer
 *              displayed before the filename.
 *            3.  Fixed a minor bug in which a non-archive file
 *              may be mistaken for a ZIP archive file when the
 *              the first byte is "P" (0x50) but the second is
 *              not "K" (0x4B).
 *    1.30 05/09/89 Added support for archive files created by LHARC
 *            (LZH format).
 *    1.40 07/15/89 1.  Made minor code changes to improve performance,
 *              particularly during automatic extension
 *              searching.
 *            2.  Added support for the Imploding compression
 *              method used in PKZIP v1.00.
 *            3.  Corrected errors in and updated documentation.
 *)

{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit file4;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  file0, file14,
  common;


{rcg11172000 had to change this to get it compiling under Free Pascal...}
{function substall(src,old,new:astr):astr;}
function substall(src,old,_new:astr):astr;

function getbyte(var fp:file):char;
procedure abend(var abort,next:boolean; message:string);
procedure details(var abort,next:boolean);
procedure lfi(fn:astr; var abort,next:boolean);
procedure lfin(rn:integer; var abort,next:boolean);
procedure lfii;

const
  L_SIG=$04034b50;   {* ZIP local file header signature *}
  C_SIG=$02014b50;   {* ZIP central dir file header signature *}
  E_SIG=$06054b50;   {* ZIP end of central dir signature *}
  Z_TAG=$fdc4a7dc;   {* ZOO entry identifier *}

  EXTS=6;     {* number of default extensions *}

  filext:array[0..EXTS-1] of string[4] = (
    '.ZIP',   {* ZIP format archive *}
    '.ARC',   {* ARC format archive *}
    '.PAK',   {* ARC format archive (PAK.EXE) *}
    '.ZOO',   {* ZOO format archive *}
    '.LZH',   {* LZH format archive *}
    '.ARK');  {* ARC format archive (CP/M ARK.COM) *}

  errmsg:array[0..5] of string[49] = (
    'Unable to access specified file',
    'Unexpected end of file',
    'Unexpected read error',
    'Invalid header ID encountered',
    'Can''t find next entry in archive',
    'File is not in ZIP/ZOO/PAK/LZH/ARC archive format');

  method:array[0..15] of string[9] = (
    'Directory',  {* Directory marker *}
    'Unknown! ',  {* Unknown compression type *}
    'Stored   ',  {* No compression *}
    'Packed   ',  {* Repeat-byte compression *}
    'Squeezed ',  {* Huffman with repeat-byte compression *}
    'crunched ',  {* Obsolete LZW compression *}
    'Crunched ',  {* LZW 9-12 bit with repeat-byte compression *}
    'Squashed ',  {* LZW 9-13 bit compression *}
    'Crushed  ',  {* LZW 2-13 bit compression *}
    'Shrunk   ',  {* LZW 9-13 bit compression *}
    'Reduced 1',  {* Probabilistic factor 1 compression *}
    'Reduced 2',  {* Probabilistic factor 2 compression *}
    'Reduced 3',  {* Probabilistic factor 3 compression *}
    'Reduced 4',  {* Probabilistic factor 4 compression *}
    'Frozen   ',  {* Modified LZW/Huffman compression *}
    'Imploded '); {* Shannon-Fano tree compression *}

type
  arcfilerec=record   {* structure of ARC archive file header *}
               filename:array[0..12] of char; {* filename *}
               c_size:longint;     {* compressed size *}
               mod_date:integer;   {* last mod file date *}
               mod_time:integer;   {* last mod file time *}
               crc:integer;        {* CRC *}
               u_size:longint;     {* uncompressed size *}
             end;

  zipfilerec=record   {* structure of ZIP archive file header *}
               version:integer;    {* version needed to extract *}
               bit_flag:integer;   {* general purpose bit flag *}
               method:integer;     {* compression method *}
               mod_time:integer;   {* last mod file time *}
               mod_date:integer;   {* last mod file date *}
               crc:longint;        {* CRC-32 *}
               c_size:longint;     {* compressed size *}
               u_size:longint;     {* uncompressed size *}
               f_length:integer;   {* filename length *}
               e_length:integer;   {* extra field length *}
             end;

  zoofilerec=record   {* structure of ZOO archive file header *}
               tag:longint;     {* tag -- redundancy check *}
               typ:byte;        {* type of directory entry (always 1 for now) *}
               method:byte;     {* 0 = Stored, 1 = Crunched *}
               next:longint;    {* position of next directory entry *}
               offset:longint;  {* position of this file *}
               mod_date:word;   {* modification date (DOS format) *}
               mod_time:word;   {* modification time (DOS format) *}
               crc:word;        {* CRC *}
               u_size:longint;  {* uncompressed size *}
               c_size:longint;  {* compressed size *}
               major_v:char;    {* major version number *}
               minor_v:char;    {* minor version number *}
               deleted:byte;    {* 0 = active, 1 = deleted *}
               struc:char;      {* file structure if any *}
               comment:longint; {* location of file comment (0 = none) *}
               cmt_size:word;   {* length of comment (0 = none) *}
               fname:array[0..12] of char; {* filename *}
               var_dirlen:integer; {* length of variable part of dir entry *}
               tz:char;         {* timezone where file was archived *}
               dir_crc:word;    {* CRC of directory entry *}
             end;
  lzhfilerec=record   {* structure of LZH archive file header *}
               h_length:byte;   {* length of header *}
               h_cksum:byte;    {* checksum of header bytes *}
               method:array[1..5] of char; {* compression type "-lh#-" *}
               c_size:longint;  {* compressed size *}
               u_size:longint;  {* uncompressed size *}
               mod_time:integer;{* last mod file time *}
               mod_date:integer;{* last mod file date *}
               attrib:integer;  {* file attributes *}
               f_length:byte;   {* length of filename *}
               crc:integer;     {* crc *}
             end;

  outrec=record   {* output information structure *}
           filename:string[255];             {* output filename *}
           date:integer;                     {* output date *}
           time:integer;                     {* output time *}
           typ:integer;                      {* output storage type *}
           csize:longint;                    {* output compressed size *}
           usize:longint;                    {* output uncompressed size *}
         end;

var
  accum_csize:longint;    {* compressed size accumulator *}
  accum_usize:longint;    {* uncompressed size accumulator *}
  files:integer;          {* number of files *}
  level:integer;          {* output directory level *}
  filetype:integer;       {* file type (1=ARC,2=ZIP,3=ZOO,4=LZH) *}
  out:outrec;
  aborted:boolean;

implementation

uses file3;

{rcg11172000 had to change this to get it compiling under Free Pascal...}
{function substall(src,old,new:astr):astr;}
function substall(src,old,_new:astr):astr;
var p:integer;
begin
  p:=1;
  while p>0 do begin
    p:=pos(old,src);
    if p>0 then begin
      insert(_new,src,p+length(old));
      delete(src,p,length(old));
    end;
  end;
  substall:=src;
end;

procedure lbrl(fn:astr; var abort,next:boolean);
var f:file;
    c,n,n1:integer;
    x:record
        st:byte;
        name:array[1..8] of char;
        ext:array[1..3] of char;
        index,len:integer;
        fil:array[1..16] of byte;
      end;
    i:astr;
begin
  nl;
  assign(f,fn);
  reset(f,32);
  blockread(f,x,1);
  c:=x.len*4-1;
  for n:=1 to c do begin
    blockread(f,x,1); i:='';
    if (x.st=0) and not abort then begin
      for n1:=1 to 8 do i:=i+x.name[n1];
      i:=i+'.';
      for n1:=1 to 3 do i:=i+x.ext[n1];
      i:=align(i)+' '+mrn(cstrr(x.len*128.0,10),7);
      printacr(i,abort,next);
    end;
  end;
  close(f);
end;

function mnz(l:longint; w:integer):astr;
var s:astr;
begin
  s:=cstrl(l);
  while length(s)<w do s:='0'+s;
  mnz:=s;
end;

function mnr(l:longint; w:integer):astr;
begin
  mnr:=mrn(cstrl(l),w);
end;

{*------------------------------------------------------------------------*}

procedure abend(var abort,next:boolean; message:string);
begin
  {*  abend - Display error message
   *}

  nl;
  sprompt(#3#7+'** '+#3#5+message+#3#7+' **');
  nl;
  aborted:=TRUE;
  abort:=TRUE;
  next:=TRUE;
end;

{*------------------------------------------------------------------------*}

procedure details(var abort,next:boolean);
var i,month,day,year,hour,minute,typ:integer;
    ampm:char;
    ratio:longint;
    outp:string;
begin
  {*  details - Calculate and display details line.
   *}

  typ:=out.typ;
  for i:=1 to length(out.filename) do
    out.filename[i]:=upcase(out.filename[i]);
  day:=out.date and $1f;                {* day = bits 4-0 *}
  month:=(out.date shr 5) and $0f;      {* month = bits 8-5 *}
  year:=((out.date shr 9) and $7f)+80;  {* year = bits 15-9 *}
  minute:=(out.time shr 5) and $3f;     {* minute = bits 10-5 *}
  hour:=(out.time shr 11) and $1f;      {* hour = bits 15-11 *}

  if (month>12) then dec(month,12);     {* adjust for month > 12 *}
  if (year>99) then dec(year,100);      {* adjust for year > 1999 *}
  if (hour>23) then dec(hour,24);       {* adjust for hour > 23 *}
  if (minute>59) then dec(minute,60);   {* adjust for minute > 59 *}

  if (hour<12) then ampm:='a' else ampm:='p';  {* determine AM/PM *}
  if (hour=0) then hour:=12;                   {* convert 24-hour to 12-hour *}
  if (hour>12) then dec(hour,12);

  if (out.usize=0) then ratio:=0 else   {* ratio is 0% for null-length file *}
    ratio:=100-((out.csize*100) div out.usize);
  if ratio>99 then ratio:=99;

  outp:=#3#4+mnr(out.usize,8)+' '+mnr(out.csize,8)+' '+mnr(ratio,2)+'% '+
        #3#9+mrn(method[typ],9)+' '+#3#7+mnr(month,2)+'-'+mnz(day,2)+'-'+
        mnz(year,2)+' '+mnr(hour,2)+':'+mnz(minute,2)+ampm+' '+#3#5;

  if (level>0) then outp:=outp+mrn('',level); {* spaces for dirs (ARC only)*}

  outp:=outp+out.filename;
  printacr(outp,abort,next);

  if (typ=0) then inc(level)    {* bump dir level (ARC only) *}
  else begin
    inc(accum_csize,out.csize);  {* adjust accumulators and counter *}
    inc(accum_usize,out.usize);
    inc(files);
  end;
end;

{*------------------------------------------------------------------------*}

procedure final(var abort,next:boolean);
var outp:string;
    ratio:longint;
begin
  {*  final - Display final totals and information.
   *}

  if accum_usize=0 then ratio:=0    {* ratio is 0% if null total length *}
  else
    ratio:=100-((accum_csize*100) div accum_usize);
  if ratio>99 then ratio:=99;

  outp:=#3#4+mnr(accum_usize,8)+' '+mnr(accum_csize,8)+' '+mnr(ratio,2)+
        '%                           '+#3#5+cstr(files)+' file';
  if files<>1 then outp:=outp+'s';
  printacr(#3#4+'-------- -------- ---                           ------------',abort,next);
  printacr(outp,abort,next);
end;

{*------------------------------------------------------------------------*}

function getbyte(var fp:file):char;
var buf:array[0..0] of char;
    numread:word;
    c:char;
    abort,next:boolean;
begin
  {*  getbyte - Obtains character from file pointed to by fp.
   *            Aborts to DOS on error.
   *}

  if (not aborted) then begin
    blockread(fp,c,1,numread);
    if numread=0 then begin
      close(fp);
      abend(abort,next,errmsg[1]);
    end;
    getbyte:=c;
  end;
end;

{*------------------------------------------------------------------------*}

procedure zip_proc(var fp:file; var abort,next:boolean);
var zip:zipfilerec;
    buf:array[0..25] of byte;
    signature:longint;
    numread:word;
    i,stat:integer;
    c:char;
begin
  {* zip_proc - Process entry in ZIP archive.
  *}

  while (not aborted) do begin {* set up infinite loop (exit is within loop) *}
    blockread(fp,signature,4,numread); if numread<>4 then abend(abort,next,errmsg[2]);
    if abort then exit;
    if (signature=C_SIG) or (signature=E_SIG) or (aborted) then
      exit;
    if signature<>L_SIG then
      abend(abort,next,errmsg[3]);
    if abort then exit;
    blockread(fp,zip,26,numread); if numread<>26 then abend(abort,next,errmsg[2]);
    if abort then exit;
    out.filename:='';
    for i:=1 to zip.f_length do    {* get filename *}
      out.filename[i]:=getbyte(fp);
    out.filename[0]:=chr(zip.f_length);
    if (zip.e_length>0) then         {* skip comment if present *}
      for i:=1 to zip.e_length do
        c:=getbyte(fp);
    out.date:=zip.mod_date;
    out.time:=zip.mod_time;
    out.csize:=zip.c_size;
    out.usize:=zip.u_size;
    case zip.method of
      0:out.typ:=2;    {* Stored *}
      1:out.typ:=9;    {* Shrunk *}
      2,3,4,5:
        out.typ:=zip.method+8;  {* Reduced *}
      6:out.typ:=15;   {* Imploded *}
    else
        out.typ:=1;    {* Unknown! *}
    end;
    details(abort,next); if abort then exit;
    {$I-} seek(fp,filepos(fp)+zip.c_size); {$I+}  {* seek to next entry *}
    if (ioresult<>0) then abend(abort,next,errmsg[4]);
    if (abort) then exit;
  end;
end;

{*------------------------------------------------------------------------*}

procedure lfi(fn:astr; var abort,next:boolean);
var fp:file;
    dirinfo1:searchrec;
    lzh:lzhfilerec;
    i1,i2,temp,infile,filename,showfn:astr;
    zoo_temp,zoo_tag:longint;
    numread:word;
    i,p,arctype,rcode:integer;
    c:char;
begin
  fn:=sqoutsp(fn);
  if (pos('*',fn)<>0) or (pos('?',fn)<>0) then begin
    findfirst(fn,anyfile-directory-volumeid,dirinfo1);
    if (doserror=0) then fn:=dirinfo1.name;
  end;
  if ((exist(fn)) and (not abort)) then begin
    arctype:=1;
    while (systat.filearcinfo[arctype].ext<>'') and
          (systat.filearcinfo[arctype].ext<>copy(fn,length(fn)-2,3)) and
          (arctype<7) do
      inc(arctype);
    if not ((systat.filearcinfo[arctype].ext='') or (arctype=7)) then begin
      temp:=systat.filearcinfo[arctype].listline;
      if (temp[1]='/') and (temp[2] in ['1'..'4']) and (length(temp)=2) then begin
        aborted:=FALSE;
        nl;
{        if (not fso) then showfn:=stripname(fn) else showfn:=fn;}
        showfn:=stripname(fn);
        printacr(#3#3+showfn+':',abort,next);
        nl;
        if (not abort) then begin
          infile:=fn;
          assign(fp,infile);
          reset(fp,1);

          c:=getbyte(fp);  {* determine type of archive *}
          case c of
            #$1a:filetype:=1;
            'P':begin
                  if getbyte(fp)<>'K' then abend(abort,next,errmsg[5]);
                  filetype:=2;
                end;
            'Z':begin
                  for i:=0 to 1 do
                    if getbyte(fp)<>'O' then abend(abort,next,errmsg[5]);
                  filetype:=3;
                end;
          else
                begin       {* assume LZH format *}
                  lzh.h_length:=ord(c);
                  c:=getbyte(fp);
                  for i:=1 to 5 do lzh.method[i]:=getbyte(fp);
                  if ((lzh.method[1]='-') and
                      (lzh.method[2]='l') and
                      (lzh.method[3]='h')) then
                    filetype:=4
                  else
                    abend(abort,next,errmsg[5]);
                end;
          end;

          reset(fp,1);                      {* back to start of file *}

          p:=0;                             {* drop drive and pathname *}
          for i:=1 to length(infile) do
            if infile[i] in [':','\'] then p:=i;
          filename:=copy(infile,p+1,length(infile)-p);

          accum_csize:=0; accum_usize:=0;   {* set accumulators to 0 *}
          level:=0; files:=0;               {* ditto with counters *}

          if filetype=3 then begin    {* process initial ZOO file header *}
            for i:=0 to 19 do      {* skip header text *}
              c:=getbyte(fp);
             {* get tag value *}
            blockread(fp,zoo_tag,4,numread);
            if numread<>4 then abend(abort,next,errmsg[2]);
            if zoo_tag<>Z_TAG then abend(abort,next,errmsg[5]);
             {* get data start *}
            blockread(fp,zoo_temp,4,numread); if numread<>4 then abend(abort,next,errmsg[2]);
            {$I-} seek(fp,zoo_temp); {$I+}
            if ioresult<>0 then abend(abort,next,errmsg[4]);
          end;

           {* print headings *}
          printacr(#3#3+' Length  Size Now  %   Method     Date    Time  Filename',abort,next);
          printacr(#3#4+'-------- -------- --- --------- -------- ------ ------------',abort,next);
          case filetype of
            1:arc_proc(fp,abort,next);  {* process ARC entry *}
            2:zip_proc(fp,abort,next);  {* process ZIP entry *}
            3:zoo_proc(fp,abort,next);  {* process ZOO entry *}
            4:lzh_proc(fp,abort,next);  {* process LZH entry *}
          end;
          final(abort,next);      {* clean things up *}
          close(fp);              {* close file *}
        end;
        nl;
      end else begin
        nl;
        sprompt(#3#3+'Archive '+fn+':  '+#3#4+'Please wait....');
        temp:=substall(systat.filearcinfo[arctype].listline,'@F',fn);
        shelldos(FALSE,temp+' >shell.$$$',rcode);
        for i:=1 to 15 do prompt(^H' '^H);
        nl;
        pfl('shell.$$$',abort,next,TRUE);
        assign(fp,'shell.$$$');
        {$I-} erase(fp); {$I+}
        if (ioresult<>0) then print('Unable to show contents via external viewer.');
      end;
    end;
  end;
end;

procedure lfin(rn:integer; var abort,next:boolean);
var f:ulfrec;
begin
  seek(ulff,rn); read(ulff,f);
  lfi(memuboard.dlpath+f.filename,abort,next);
end;

procedure lfii;
var f:ulfrec;
    fn:astr;
    pl,rn:integer;
    abort,next,lastarc,lastgif,isgif:boolean;
begin
  nl;
  sprint(fstring.viewline);
{  sprint(fstring.pninfo);}
  nl;
  gfn(fn); abort:=FALSE; next:=FALSE;
  nl;
  recno(fn,pl,rn);
  if (baddlpath) then exit;
  abort:=FALSE; next:=FALSE; lastarc:=fALSE; lastgif:=FALSE;
  while ((rn<>0) and (not abort)) do begin
    seek(ulff,rn); read(ulff,f);
    isgif:=isgifext(f.filename);
    if (isgif) then begin
      lastarc:=FALSE;
      if (not lastgif) then begin
        lastgif:=TRUE;
        nl; nl;
        printacr(#3#3+'Filename.Ext '+sepr2+' Resolution '+sepr2+
                 ' Num Colors '+sepr2+' Signat.',abort,next);
        printacr(#3#4+'=============:============:============:=========',abort,next);
      end;
      dogifspecs(sqoutsp(memuboard.dlpath+f.filename),abort,next);
    end else begin
      lastgif:=FALSE;
      if (not lastarc) then begin
        lastarc:=TRUE;
        nl;
(*        nl; nl;
        printacr(#3#5+'IFL v1.30 '+#3#1+'-'+#3#3+' By Martin Pollard '+
                 #3#1+'--',abort,next);*)
      end;
      lfin(rn,abort,next);
    end;
    nrecno(fn,pl,rn);
    if (next) then abort:=FALSE;
    next:=FALSE;
  end;
  close(ulff);
end;

end.