[Back to ARCHIVES SWAG index]  [Back to Main SWAG index]  [Original]

unit ZipView;

interface
uses dos;

type
 barray= array[1..8192] of byte;
 ZipPtr=^ZipRec;
 ZipRec= Record
          version_made: word;
          version_extr: word;
          flags: word;
          comp_method: word;
          last_mod_time: word;
          last_mod_date: word;
          crc_32: longint;
          compressed_size: longint;
          uncompressed_size: longint;
          fname_length: word;
          extra_length: word;
          comment_length: word;
          disk_num_start: word;
          internal_attr: word;
          external_attr: longint;
          rel_ofs: longint;
          name: string[12];
          Next: ZipPtr;
         end;
 bptr = ^barray;
const
 ZipMethod: array[0..9] of string[15] =
           ('stored   ',          'shrunk   ',       'reduced-1',
            'reduced-2',          'reduced-3',       'reduced-4',
            'imploded ',          'unknown  ',       'unknown  ',
            'unknown  ');

var
 totallength,totalsize,numfiles: longint;
 firstzip: zipptr;
 lineout: string;
 outPtr: pointer;

procedure LoadZip(filename: string);
procedure DisplayZip;
procedure DisposeZip;

implementation

var
 f: file of barray;
 buffer: barray;
 addr: longint;
 bufptr: word;

{$F+}
Procedure CallProc;
inline($FF/$1E/OutPtr);
{$F-}

Function NextByte: byte;
var i: integer;
begin;
 inc(addr);
 inc(bufptr);
 if bufptr=8193 then begin;
  {$I-}
  read(f,buffer);
  {$I+}
  i:=ioresult;
  bufptr:=1;
 end;
 nextbyte:=buffer[bufptr];
end;

procedure LoadZip(filename: string);
var
 b: byte;
 f2: file of byte;
 fs: longint;
 LastZip,Zip: ZipPtr;
 Bytes: Bptr absolute zip;
 a: integer;
 sr: searchrec;
begin;
 firstzip:=nil;
{ assign(f2,filename);
 reset(F2);
 fs:=filesize(f2);
 close(f2);}
 findfirst(filename,anyfile,sr);
 fs:=sr.size;
 assign(f,filename);
 reset(f);
 addr:=0;
 if fs>65535 then begin;
  seek(f,(fs div 8192)-4);
  addr:=addr+((fs div 8192)-4)*8192;
 end;
 {$I-}
 read(f,buffer);
 {$I+}
 a:=ioresult;
 bufptr:=0;
 b:=nextbyte;
 repeat;
  if b=$50 then begin;
   b:=nextbyte;
   if b=$4b then begin;
    b:=nextbyte;
    if b=$01 then begin;
     b:=nextbyte;
     if b=$02 then begin;
      new(zip);
      zip^.next:=nil;
      if firstzip=nil then firstzip:=zip else lastzip^.next:=zip;
      lastzip:=zip;
      for a:=1 to 42 do bytes^[a]:=nextbyte;
      zip^.name:='';
      for a:=1 to zip^.fname_length do zip^.name:=zip^.name+chr(nextbyte);
      b:=nextbyte;
     end;
    end;
   end;
  end else b:=nextbyte;
 until addr>=fs;
end;

procedure OutLine(s: string);
begin;
 lineout:=s;
 if OutPtr=NIL then writeln(s) else CallProc;
end;

function format_date(date: word): string;
var
 s,s2: string;
 y,m,d: word;
begin
 m:=(date shr 5) and 15;
 d:=( (date      ) and 31);
 y:=(((date shr 9) and 127)+80);
 str(m,s);
 while length(s)<2 do s:='0'+s;
 s:=s+'-';
 str(d,s2);
 while length(s2)<2 do s2:='0'+s2;
 s:=s+s2+'-';
 str(y,s2);
 while length(s2)<2 do s2:='0'+s2;
 s:=s+s2;
 format_date:=s;
end;

function format_time(time: word): string;
var
 s,s2: string;
 h,m,se: word;
begin
 h:=(time shr 11) and 31;
 m:=(time shr  5) and 63;
 se:=(time shl  1) and 63;
 str(h,s);
 while length(S)<2 do s:='0'+s;
 s:=s+':';
 str(m,s2);
 while length(s2)<2 do s2:='0'+s2;
 s:=s+s2;
 format_time:=s;
end;

procedure DisplayHeader;
begin;
 OutLine('Filename      Length   Size     Method     Date      Time   Ratio');
 OutLine('------------  -------  -------  ---------  --------  -----  -----');
end;

procedure DisplayFooter;
var
 s,s2: string;
 average: real;
begin;
 OutLine('------------  -------  -------                              -----');
 average:=100-totalsize/totallength*100;
 str(numfiles:12,s);
 str(totallength:7,s2);
 s:=s+'  '+s2+'  ';
 str(totalsize:7,s2);
 s:=s+s2+'                              ';
 str(average:4:0,s2);
 s:=s+s2+'%';
 outline(s);
end;

procedure DisplayZip;
var
 curzip: zipptr;
 s,s2: string;
begin;
 numfiles:=0;
 totallength:=0;
 totalsize:=0;
 DisplayHeader;
 curzip:=firstzip;
 while curzip<>nil do begin;
  s:=curzip^.name;
  while length(s)<14 do s:=s+' ';
  str(curzip^.uncompressed_size,s2);
  while length(s2)<7 do s2:=' '+s2;
  s:=s+s2+'  ';
  str(curzip^.compressed_size,s2);
  while length(s2)<7 do s2:=' '+s2;
  s:=s+s2+'  ';
  s:=s+ZipMethod[curzip^.comp_method]+'  ';
  s:=s+format_date(curzip^.last_mod_date)+'  '+format_time(curzip^.last_mod_time)+'  ';
  str(100-curzip^.compressed_size/curzip^.uncompressed_size*100:1:1,s2);
  s2:=s2+'%';
  while length(s2)<5 do s2:=' '+s2;
  s:=s+s2;
  Outline(s);
  totallength:=totallength+curzip^.uncompressed_size;
  totalsize:=totalsize+curzip^.compressed_size;
  inc(numfiles);
  curzip:=curzip^.next;
 end;
 if (numfiles=0) or (totallength=0) or (totalsize=0) then begin;
  outline('No valid file entries detected.');
 end else begin;
  displayfooter;
 end;
end;

procedure DisposeZip;
var
 curzip,savezip: zipptr;
begin;
 curzip:=firstzip;
 while curzip<>nil do begin;
  savezip:=curzip^.next;
  dispose(curzip);
  curzip:=savezip;
 end;
end;

begin;
 OutPtr:=Nil;
end.

{ --------------------------   CUT HERE -----------------------------}
{ TEST PROGRAM }

uses zipview;

var
 s: string;
begin;
 write('File to Zip-View ? ');
 readln(s);
 LoadZip(s);
 DisplayZip;
 DisposeZip;
end.

[Back to ARCHIVES SWAG index]  [Back to Main SWAG index]  [Original]