home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Intermedia 1998 January
/
inter1_98.iso
/
www
/
rozi
/
ZIPVIEW.ZIP
/
ZIPVIEW.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1997-09-14
|
6KB
|
261 lines
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.