{*    IFL - Interior File Listing Utility
 *    Copyright 1989 by Martin Pollard.  Turbo Pascal version by Eric Oman.
 *
 *		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)
 *			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.11 03/01/89 Fixed a minor bug in which a non-archive file may
 *                  be mistaken for a ZIP archive when the first byte
 *                  is "P" (50h) but the second is not "K" (4Bh).
 *                  (This version was never released.)
 *		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.
 *
 *    1.21 03/17/89 Converted all C code into Turbo Pascal 5.0 code.
 *
 *}

uses
  dos;      {* turbo3 and crt units intentionally unused
               to allow redirection of I/O *}


{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
{$I ifl.inc}

const
  VERSION = '1.21';
  __DATE__ = 'Mar 17 1989';

var
  arc:arcfilerec;
  zip:zipfilerec;
  zoo:zoofilerec;
  out:outrec;

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

  {* Miscellaneous string/numeric manipulation routines.
  *}

function cstr(l:longint):string;
var s:string;
begin
  str(l,s);
  cstr:=s;
end;

function mrn(s:string; w:integer; c:char):string;
begin
  while length(s)<w do s:=c+s;
  mrn:=s;
end;

function mnz(l:longint; w:integer):string;
begin
  mnz:=mrn(cstr(l),w,'0');
end;

function mn(l:longint; w:integer):string;
begin
  mn:=mrn(cstr(l),w,' ');
end;

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

procedure abend(message:string);
begin
  {*  abend() - Display error message and abort to DOS.  Returns
	 *		ERRORLEVEL of 1.
   *}

  writeln;
  writeln('** '+message+' **');
  halt(1);
end;

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

procedure details;
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:=mn(out.usize,8)+' '+mn(out.csize,8)+' '+mn(ratio,2)+'% '+
        mrn(method[typ],9,' ')+' '+mn(month,2)+'-'+mnz(day,2)+'-'+
        mnz(year,2)+' '+mn(hour,2)+':'+mnz(minute,2)+ampm+' ';

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

  outp:=outp+out.filename;
  writeln(outp);

  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 ratio:longint;
    outp:string;
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:=mn(accum_usize,8)+' '+mn(accum_csize,8)+' '+mn(ratio,2)+
        '%                           '+cstr(files)+' file';
  if files<>1 then outp:=outp+'s';
  writeln(FOOTER_1);
  writeln(outp);
end;

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

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

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

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

procedure arc_proc(var fp:file);
var i,typ,stat:integer;
    c:char;
    numread:word;
begin
  {*  arc_proc - Process entry in ARC archive.
  *}

  repeat
    c:=getbyte(fp);
    typ:=ord(getbyte(fp));   {* get storage method *}
    case typ of
      0:exit;                {* end of archive file *}
      1,2:out.typ:=2;        {* Stored *}
      3,4:out.typ:=typ;      {* Packed & Squeezed *}
      5,6,7:out.typ:=typ;    {* crunched *}
      8,9,10:out.typ:=typ-2; {* Crunched, Squashed & Crushed *}
      30:out.typ:=0;         {* Directory *}
      31:dec(level);         {* end of dir (not displayed) *}
    else
         out.typ:=1;         {* Unknown! *}
    end;
    if typ<>31 then begin    {* get data from header *}
      blockread(fp,arc,23,numread); if numread<>23 then abend(errmsg[2]);
      if typ=1 then          {* type 1 didn't have c_size field *}
        arc.u_size:=arc.c_size
      else begin
        blockread(fp,arc.u_size,4,numread);
        if numread<>4 then abend(errmsg[2]);
      end;
      i:=0;
      repeat
        inc(i);
        out.filename[i]:=arc.filename[i-1];
      until (arc.filename[i]=#0) or (i=13);
      out.filename[0]:=chr(i);
      out.date:=arc.mod_date;
      out.time:=arc.mod_time;
      if typ=30 then begin
        arc.c_size:=0;            {* set file size entries *}
        arc.u_size:=0;            {* to 0 for directories *}
      end;
      out.csize:=arc.c_size;   {* set file size entries *}
      out.usize:=arc.u_size;   {* for normal files *}
      details;
      if typ<>30 then begin
        {$I-} seek(fp,filepos(fp)+arc.c_size); {$I+} {* seek to next entry *}
        if ioresult<>0 then abend(errmsg[4]);
      end;
    end;
  until c<>#$1a;
  abend(errmsg[3]);
end;

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

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

  while TRUE do begin   {* set up infinite loop (exit is within loop) *}
    blockread(fp,signature,4,numread); if numread<>4 then abend(errmsg[2]);
    if (signature=C_SIG) or (signature=E_SIG) then
      exit;
    if signature<>L_SIG then
      abend(errmsg[3]);
    blockread(fp,zip,26,numread); if numread<>26 then abend(errmsg[2]);
    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 *}
    else
        out.typ:=1;    {* Unknown! *}
    end;
    details;
    {$I-} seek(fp,filepos(fp)+zip.c_size); {$I+}  {* seek to next entry *}
    if ioresult<>0 then abend(errmsg[4]);
  end;
end;

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

procedure zoo_proc(var fp:file);
var i,method:integer;
    zoo_longname,zoo_dirname:string[255];
    numread:word;
    namlen,dirlen:byte;
begin
  {*  zoo_proc - Process entry in ZOO archive.
   *}

  while TRUE do begin   {* set up infinite loop (exit is within loop) *}
    blockread(fp,zoo,56,numread); if numread<>56 then abend(errmsg[2]);
    if zoo.tag<>Z_TAG then abend(errmsg[3]);   {* abort if invalid tag *}
    if zoo.next=0 then exit;

    namlen:=ord(getbyte(fp)); dirlen:=ord(getbyte(fp));
    zoo_longname:=''; zoo_dirname:='';
    if namlen>0 then
      for i:=1 to namlen do   {* get long filename *}
        zoo_longname:=zoo_longname+getbyte(fp);
    if dirlen>0 then begin
      for i:=1 to dirlen do   {* get directory name *}
        zoo_dirname:=zoo_dirname+getbyte(fp);
      if copy(zoo_dirname,length(zoo_dirname),1)<>'/' then
        zoo_dirname:=zoo_dirname+'/';
    end;
    if zoo_longname<>'' then out.filename:=zoo_longname
    else begin
      i:=0;
      repeat
        inc(i);
        out.filename[i]:=zoo.fname[i-1];
      until (zoo.fname[i]=#0) or (i=13);
      out.filename[0]:=chr(i);
      out.filename:=zoo_dirname+out.filename;
    end;
    out.date:=zoo.mod_date;  {* set up fields *}
    out.time:=zoo.mod_time;
    out.csize:=zoo.c_size;
    out.usize:=zoo.u_size;
    method:=zoo.method;
    case method of
      0:out.typ:=2;      {* Stored *}
      1:out.typ:=6;      {* Crunched *}
    else
        out.typ:=1;      {* Unknown! *}
    end;
    if not (zoo.deleted=1) then details;

    {$I-} seek(fp,zoo.next); {$I+}  {* seek to next entry *}
    if ioresult<>0 then abend(errmsg[4]);
  end;
end;

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

procedure usage;
begin
  {*  usage - Displays help screen for people who can't comprehend how to
   *          use a simple program like this!  Returns ERRORLEVEL of 2.
   *}

  writeln;
  writeln('IFL v'+VERSION+' - '+__DATE__+' - Interior File Listing Utility');
  writeln('Copyright 1989 by Martin Pollard.  Turbo Pascal version by Eric Oman');
  writeln;
  writeln('Syntax is:   "IFL filename"');
  writeln;
  writeln('IFL produces a listing of files contained in an archive file.');
  writeln('Archive formats currently supported include:');
  writeln;
  writeln('   ARC - Developed by System Enhancement Associates');
  writeln('            and enhanced by PKware (PKARC & PKPAK)');
  writeln('            and NoGate Consulting (PAK)');
  writeln('   ZIP - Developed by PKware');
  writeln('   ZOO - Developed by Rahul Dhesi');
  writeln;
  writeln('Support for other formats may be included in the future.');
  halt(2);
end;

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

function exist(fn:string):boolean;
var fp:file;
begin
  assign(fp,fn);
  {$I-} reset(fp); {$I+}
  if ioresult=0 then begin
    close(fp);
    exist:=TRUE;
  end
  else
    exist:=FALSE;
end;

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

var temp,infile,filename:string;
    fp:file;
    i,p:integer;
    c:char;
    zoo_temp,zoo_tag:longint;
    numread:word;
begin
  {*   The start of the program.  Everything in the program
   *   executes from here.  Returns to DOS with ERRORLEVEL of 0 on
   *   successful completion.
   *}

  if paramcount=0 then usage;  {* check if no arguments entered *}

  temp:=paramstr(1);
  for i:=1 to length(temp) do
    case temp[i] of
      '/':temp[i]:='\';
    else
          temp[i]:=upcase(temp[i]);
    end;
  infile:='';
  if pos(':',temp)=0 then begin  {* add drive to filename if not there *}
    getdir(0,infile);
    infile[0]:=#2;
  end;
  infile:=infile+temp;

  if not exist(infile) then begin
    temp:=infile;
    i:=0;
    repeat
      infile:=temp+filext[i];
      inc(i);
    until (exist(infile)) or (i=EXTS);
    if i=EXTS then abend(errmsg[0]);
  end;

  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(errmsg[5]);
          filetype:=2;
        end;
    'Z':begin
          for i:=0 to 1 do
            if getbyte(fp)<>'O' then abend(errmsg[5]);
          filetype:=3;
        end;
  else
        abend(errmsg[5]);
  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);

  writeln;
  writeln('Archive '+infile+': (IFL TP 5.0 version by Eric Oman)');
  writeln;

  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(errmsg[2]);
    if zoo_tag<>Z_TAG then abend(errmsg[5]);
     {* get data start *}
    blockread(fp,zoo_temp,4,numread); if numread<>4 then abend(errmsg[2]);
    {$I-} seek(fp,zoo_temp); {$I+}
    if ioresult<>0 then abend(errmsg[4]);
  end;

  writeln(HEADER_1);      {* print headings *}
  writeln(HEADER_2);
  case filetype of
    1:arc_proc(fp);       {* process ARC entry *}
    2:zip_proc(fp);       {* process ZIP entry *}
    3:zoo_proc(fp);       {* process ZOO entry *}
  end;
  final;                  {* clean things up *}
  close(fp);              {* close file *}
  halt(0);
end.