home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / A / ARC20.ARC / ARCLST.INC < prev    next >
Text File  |  1989-11-10  |  3KB  |  91 lines
  1. (* ARCLST.INC TR 101189 *)
  2.  
  3. (* Ausgabe aller enthaltenen Dateien *)
  4.  
  5. procedure lstarc;
  6. var  n           : byte;
  7.      dsksiz,tdsk,
  8.      tnum,crcsum : integer;
  9.      tlen,tsize  : longword;
  10.      rlen,rsiz   : real;
  11.  
  12.   (* Angaben zu einzelnem Eintrag in UNARC-Format ausgeben *)
  13.  
  14.   procedure lstfile(var hdr:headtype);
  15.   const mon : array[1..12,1..3] of char
  16.             = ('Jan','Feb','Mar','Apr','May','Jun',
  17.                'Jul','Aug','Sep','Oct','Nov','Dec');
  18.   var   yr,mo,dy,hh,mm,ss,sav : byte;
  19.         nam                   : filenam;
  20.   begin
  21.     with hdr do begin
  22.       nam:=name; nam[0]:=chr(pred(pos(#0,nam)));
  23.       ss:=pos('.',nam);
  24.       if ss>0 then for mm:=ss to 8 do insert(' ',nam,mm);
  25.       nam:=copy(nam+'           ',1,12);
  26.       yr:=lo((date shr 9) and $7f);
  27.       mo:=lo((date shr 5) and $0f);
  28.       dy:=lo(date and $1f);
  29.       hh:=lo((time shr 11) and $1f);
  30.       mm:=lo((time shr 5) and $3f);
  31.       ss:=lo((time and $1f) shl 1);
  32.       rlen:=long_to_real(length);
  33.       rsiz:=long_to_real(size);
  34.       if rlen=0.0 then dsksiz:=0
  35.         else dsksiz:=succ(trunc((rlen-1.0)/2048.0)) shl 1;
  36.       write(nam,rlen:9:0,dsksiz:5,'k  ');
  37.       case vers of
  38.         1       : write('   --   ');
  39.         2       : write(' Stored ');
  40.         3       : write(' Packed ');
  41.         4       : write('Squeezed');
  42.         5,6,7,8 : write('Crunched');
  43.         9       : write('Squashed');
  44.         else      write(' Unknown');
  45.         end;
  46.       if rlen=0.0 then sav:=0 else sav:=100-round(100.0*rsiz/rlen);
  47.       write(vers:3,rsiz:9:0,sav:4,'%');
  48.       if date=0 then write('':11) else write(dy:4,' ',mon[mo],yr+80:3);
  49.       if time=0 then write('':8) else write(hh:3,':',mm div 10,mm mod 10,'  ');
  50.       writehex(crc); writeln;
  51.       tnum:=succ(tnum); add_long(tlen,length);
  52.       tdsk:=tdsk+dsksiz; add_long(tsize,size); crcsum:=crcsum+crc;
  53.       end;
  54.     end;
  55.  
  56. begin  { lstarc }
  57.   if openarc(false) then begin
  58.     tlen:=long_null; tsize:=long_null; tnum:=0; crcsum:=0; tdsk:=0;
  59.     for n:=1 to pcount do did[n]:=false;
  60.     writeln(^M^J'Name           Length  Disk   Method  Ver  Stored Saved',
  61.             '    Date    Time  CRC'^M^J'============  =======  ====  ========',
  62.             ' === ======= ===== ========= =====  ====');
  63.     if pcount=0 then while readhdr(header,oldarc) do begin
  64.       lstfile(header);
  65.       fskip(oldarc,header.size);
  66.       end
  67.     else while readhdr(header,oldarc) do begin
  68.       found:=false; n:=1;
  69.       repeat
  70.         if match(pstring(header.name),arg[n]) then begin
  71.           found:=true; did[n]:=true; end;
  72.         n:=succ(n);
  73.       until found or (n>pcount);
  74.       if found then lstfile(header);
  75.       fskip(oldarc,header.size);
  76.       end;
  77.     if tnum>0 then begin
  78.       rlen:=long_to_real(tlen);
  79.       rsiz:=long_to_real(tsize);
  80.       write('        ====  =======  ====               =======  ===',
  81.             '                   ====',^M^J,
  82.             'Total',tnum:7,rlen:9:0,tdsk:5,'k',rsiz:22:0,
  83.             100-round(100.0*rsiz/rlen):4,'%','':19);
  84.       writehex(crcsum); writeln;
  85.       end;
  86.     note_notfound;
  87.     closearc;
  88.     end
  89.   else writeln(empty);
  90.   end;
  91.