{* 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 *}

{$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.