+ initial revisions

install/install.pas

@@ -0,0 +1,455 @@
+{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q+,R+,S+,T-,V-,X+,Y+}
+{$M 16384,0,16384}
+program install;
+
+  uses
+     app,dialogs,views,objects,menus,drivers,strings,msgbox,dos;
+
+  var
+     binpath,startpath : string;
+     successfull : boolean;
+
+  procedure uppervar(var s : string);
+
+    var
+       i : integer;
+
+    begin
+       for i:=1 to length(s) do
+         s[i]:=upcase(s[i]);
+    end;
+
+  function file_exists(const f : string;const path : string) : boolean;
+
+    begin
+       file_exists:=fsearch(f,path)<>'';
+    end;
+
+  procedure do_install(const s : string);
+
+    begin
+       if not(file_exists(s+'.ZIP',startpath)) then
+         begin
+            messagebox('File: '+s+' missed for the selected installation. '+
+                       'Installation doesn''t becomes complete',nil,mferror+mfokbutton);
+            halt(1);
+         end;
+       swapvectors;
+       exec(startpath+'\UNZIP.EXE','-qq -o '+startpath+'\'+s);
+       swapvectors;
+       if doserror<>0 then
+         begin
+            messagebox('Error when extracting. Disk full?',nil,mferror+mfokbutton);
+            halt(1);
+         end;
+    end;
+
+  function createdir(const s : string) : boolean;
+
+    var
+       result : longint;
+
+    begin
+       chdir(s);
+       if ioresult=0 then
+         begin
+{$ifdef german}
+            result:=messagebox('Das Installationsverzeichnis existiert schon. '+
+              'Soll ein neues Installationsverzeichnis angegeben werden?',nil,
+              mferror+mfyesbutton+mfnobutton);
+{$else}
+            result:=messagebox('The installation directory exists already. '+
+              'Do want to enter a new installation directory ?',nil,
+              mferror+mfyesbutton+mfnobutton);
+{$endif}
+            createdir:=result=cmyes;
+            exit;
+         end;
+       mkdir(s);
+       if ioresult<>0 then
+         begin
+{$ifdef german}
+            messagebox('Das Installationsverzeichnis konnte nicht angelegt werden',
+              @s,mferror+mfokbutton);
+{$else}
+            messagebox('The installation directory couldn''t be created',
+              @s,mferror+mfokbutton);
+{$endif}
+            createdir:=true;
+            exit;
+         end;
+       createdir:=false;
+    end;
+
+  procedure changedir(const s : string);
+
+    begin
+       chdir(s);
+       if ioresult<>0 then
+         begin
+{$ifdef german}
+            messagebox('Fehler beim Wechseln in das Installationsverzeichnis. '+
+              'Installationsprogramm wird beendet',@s,mferror+mfokbutton);
+{$else}
+            messagebox('Error when changing directory ',@s,mferror+mfokbutton);
+{$endif}
+            halt(1);
+         end;
+    end;
+
+  const
+     cmstart = 1000;
+
+  type
+     pinstalldialog = ^tinstalldialog;
+
+     tinstalldialog = object(tdialog)
+        constructor init;
+     end;
+
+     tapp = object(tapplication)
+         procedure initmenubar;virtual;
+         procedure handleevent(var event : tevent);virtual;
+     end;
+
+  function diskspace(const zipfile : string) : string;
+
+    var
+       clustersize : longint;
+       f : file;
+
+    begin
+       diskspace:='';
+    end;
+
+  var
+     mask_components : longint;
+
+  constructor tinstalldialog.init;
+
+    var
+       r : trect;
+       line : integer;
+       p,f : pview;
+       s : string;
+
+    const breite = 76;
+          hoehe = 20;
+          x1 = (80-breite) div 2;
+          y1 = (23-hoehe) div 2;
+          x2 = x1+breite;
+          y2 = y1+hoehe;
+
+    begin
+       r.assign(x1,y1,x2,y2);
+{$ifdef german}
+       inherited init(r,'Installieren');
+{$else}
+       inherited init(r,'Install');
+{$endif}
+       line:=2;
+       r.assign(3,line+1,28,line+2);
+       p:=new(pinputline,init(r,79));
+       f:=p;
+       s:='C:\PP';
+       p^.setdata(s);
+       insert(p);
+       r.assign(3,line,8,line+1);
+       insert(new(plabel,init(r,'~P~ath',p)));
+       insert(p);
+       inc(line,3);
+       r.assign(3,line+1,breite-3,line+11);
+       p:=new(pcheckboxes,init(r,
+         newsitem('~B~asic system (required)'+diskspace('BASEDOS.ZIP'),
+         newsitem('GNU ~L~inker and GNU Assembler (required)'+diskspace('GNUASLD.ZIP'),
+         newsitem('D~e~mos'+diskspace('DEMO.ZIP'),
+         newsitem('GNU ~D~ebugger'+diskspace('GDB.ZIP'),
+         newsitem('GNU ~U~tilities (required to recompile run time library)'+diskspace('GNUUTILS.ZIP'),
+         newsitem('Documentation (~H~TML)'+diskspace('DOCS.ZIP'),
+         newsitem('Documentation (~P~ostscript)'+diskspace('DOC100PS.ZIP'),
+         newsitem('~R~un time library sources'+diskspace('RL09900S.ZIP'),
+         newsitem('~C~ompiler sources'+diskspace('PP09900S.ZIP'),
+         newsitem('Documentation sources (La~T~eX)'+diskspace('DOC100S.ZIP'),
+         nil
+       ))))))))))));
+       pcluster(p)^.enablemask:=mask_components;
+       insert(p);
+
+       r.assign(3,line,14,line+1);
+       insert(new(plabel,init(r,'~C~omponents',p)));
+
+       inc(line,12);
+       { Free Vision
+       r.assign(3,line+1,breite-3,line+3);
+       p:=new(pcheckboxes,init(r,
+         newsitem('~B~asic system',
+         newsitem('~D~ocumentation',
+         newsitem('S~a~mples',
+         newsitem('~S~ources',
+         nil
+       ))))));
+       pcluster(p)^.enablemask:=mask_freevision;
+       insert(p);
+       r.assign(3,line,15,line+1);
+       insert(new(plabel,init(r,'~F~ree Vision',p)));
+       inc(line,4);
+       }
+       r.assign((breite div 2)-14,line,(breite div 2)-4,line+2);
+       insert(new(pbutton,init(r,'~O~k',cmok,bfdefault)));
+       r.assign((breite div 2)+4,line,(breite div 2)+14,line+2);
+       insert(new(pbutton,init(r,'~C~ancel',cmcancel,bfnormal)));
+       f^.select;
+    end;
+
+  procedure tapp.handleevent(var event : tevent);
+
+    var
+       p : pinstalldialog;
+       p2 : pdialog;
+       p3 : pstatictext;
+       r : trect;
+       c : word;
+       t : text;
+       installdata : record
+                       path : string[79];
+                       components : word;
+                     end;
+       f : file;
+
+    label
+       insertdisk1,insertdisk2,newpath;
+
+    begin
+       inherited handleevent(event);
+       if event.what=evcommand then
+         if event.command=cmstart then
+           begin
+              clearevent(event);
+              installdata.path:='C:\PP';
+              installdata.components:=0;
+
+              mask_components:=$0;
+
+              { searching files }
+              if file_exists('BASEDOS.ZIP',startpath) then
+                inc(mask_components,1);
+
+              if file_exists('GNUASLD.ZIP',startpath) then
+                inc(mask_components,2);
+
+              if file_exists('DEMO.ZIP',startpath) then
+                inc(mask_components,4);
+
+              if file_exists('GDB.ZIP',startpath) then
+                inc(mask_components,8);
+
+              if file_exists('GNUUTILS.ZIP',startpath) then
+                inc(mask_components,16);
+
+              if file_exists('DOCS.ZIP',startpath) then
+                inc(mask_components,32);
+
+              if file_exists('DOC100PS.ZIP',startpath) then
+                inc(mask_components,64);
+
+              if file_exists('RL09900S.ZIP',startpath) then
+                inc(mask_components,128);
+
+              if file_exists('PP09900S.ZIP',startpath) then
+                inc(mask_components,256);
+
+              if file_exists('DOC100S.ZIP',startpath) then
+                inc(mask_components,512);
+
+              while true do
+                begin
+              newpath:
+                   p:=new(pinstalldialog,init);
+                   { default settings }
+                   c:=executedialog(p,@installdata);
+                   if c=cmok then
+                     begin
+                        if installdata.path[length(installdata.path)]='\' then
+                          dec(byte(installdata.path[0]));
+                        uppervar(installdata.path);
+                        binpath:=installdata.path+'\BIN';
+                        if createdir(installdata.path) then
+                          goto newpath;
+                        changedir(installdata.path);
+{$ifdef unused_code}
+                        assign(t,'SET_PP.BAT');
+                        rewrite(t);
+                        if ioresult<>0 then
+{$ifdef german}
+                          messagebox('Datei SET_PP.BAT konnte nicht erstellt werden',nil,mfokbutton+mferror)
+{$else}
+                          messagebox('File SET_PP.BAT can''t be created',nil,mfokbutton+mferror)
+{$endif}
+                        else
+                          begin
+                             { never used:
+                             writeln(t,'SET LINUXUNITS='+installdata.path+'\LINUXUNITS');
+                             writeln(t,'SET PPBIN='+installdata.path+'\BIN');
+                             writeln(t,'SET PASLIB='+installdata.path+'\LIB');
+                             writeln(t,'SET OS2UNITS='+installdata.path+'\OS2UNITS');
+                             writeln(t,'SET DOSUNITS='+installdata.path+'\DOSUNITS;'+installdata.path+'\BIN');
+                             }
+                             writeln('REM This file may contain nothing else');
+                             write(t,'SET GO32=');
+{$ifdef german}
+                             if messagebox('Wollen Sie den Coprozessoremulator verwenden?',
+                               nil,mfyesbutton+mfnobutton)=cmyes then
+                               write(t,'emu '+installdata.path+'\DRIVERS\EMU387');
+{$else}
+                             if messagebox('Install math coprocessor emulation?',
+                               nil,mfyesbutton+mfnobutton)=cmyes then
+                               write(t,'emu '+installdata.path+'\DRIVERS\EMU387');
+{$endif}
+                             writeln(t);
+                             close(t);
+                          end;
+{$endif unused_code}
+                        if getenv('UNZIP')<>'' then
+                          begin
+{$ifdef german}
+                             messagebox('Die Umgebungsvariable UNZIP sollte'#13+
+                                         'nicht gesetzt sein',nil,mfokbutton+mfinformation)
+{$else}
+                             messagebox('The enviroment variable UNZIP shouldn''t be set',nil,
+                               mfokbutton+mfinformation)
+{$endif}
+                          end;
+                        r.assign(20,7,60,16);
+                        p2:=new(pdialog,init(r,'Information'));
+                        r.assign(6,4,38,5);
+{$ifdef german}
+                        p3:=new(pstatictext,init(r,'Dateien werden entpackt ...'));
+{$else}
+                        p3:=new(pstatictext,init(r,'Extracting files ...'));
+{$endif}
+                        p2^.insert(p3);
+                        desktop^.insert(p2);
+
+                        if (installdata.components and 1)<>0 then
+                           do_install('BASEDOS');
+
+                        if (installdata.components and 2)<>0 then
+                           do_install('GNUASLD');
+
+                        if (installdata.components and 4)<>0 then
+                           do_install('DEMO');
+
+                        if (installdata.components and 8)<>0 then
+                           do_install('GDB');
+
+                        if (installdata.components and 16)<>0 then
+                           do_install('GNUUTILS');
+
+                        if (installdata.components and 32)<>0 then
+                           do_install('DOCS');
+
+                        if (installdata.components and 64)<>0 then
+                           do_install('DOCS101PS');
+
+                        if (installdata.components and 128)<>0 then
+                           do_install('RL09905S');
+
+                        if (installdata.components and 256)<>0 then
+                           do_install('PP09905S');
+
+                        if (installdata.components and 512)<>0 then
+                           do_install('DOC101S');
+
+                        assign(t,'BIN\PPC386.CFG');
+                        rewrite(t);
+                        writeln(t,'-l');
+                        writeln(t,'#section GO32V1');
+                        writeln(t,'-Up',installdata.path+'\RTL\DOS\GO32V1');
+                        writeln(t,'#section GO32V2');
+                        writeln(t,'-Up',installdata.path+'\RTL\DOS\GO32V2');
+                        close(t);
+
+                        desktop^.delete(p2);
+                        dispose(p2,done);
+{$ifdef german}
+                        messagebox('Installation erfolgreich abgeschlossen',nil,mfinformation+mfokbutton);
+{$else}
+                        messagebox('Installation successfull',nil,mfinformation+mfokbutton);
+{$endif}
+                        event.what:=evcommand;
+                        event.command:=cmquit;
+                        successfull:=true;
+                        handleevent(event);
+                     end;
+                   break;
+                end;
+           end;
+    end;
+
+  procedure tapp.initmenubar;
+
+    var
+       r : trect;
+
+    begin
+       getextent(r);
+       r.b.y:=r.a.y+1;
+{$ifdef german}
+       menubar:=new(pmenubar,init(r,newmenu(
+          newsubmenu('~I~nstallation',hcnocontext,newmenu(
+            newitem('~S~tart','',kbnokey,cmstart,hcnocontext,
+            newline(
+            newitem('~B~eenden','Alt+X',kbaltx,cmquit,hcnocontext,
+            nil)))
+          ),
+       nil))));
+{$else}
+       menubar:=new(pmenubar,init(r,newmenu(
+          newsubmenu('~I~nstallation',hcnocontext,newmenu(
+            newitem('~S~tart','',kbnokey,cmstart,hcnocontext,
+            newline(
+            newitem('~E~xit','Alt+X',kbaltx,cmquit,hcnocontext,
+            nil)))
+          ),
+       nil))));
+{$endif}
+    end;
+
+  var
+     installapp : tapp;
+     oldexitproc : pointer;
+
+  procedure myexitproc;far;
+
+    begin
+       exitproc:=oldexitproc;
+    end;
+
+  var
+     b : byte;
+
+begin
+   getdir(0,startpath);
+   {
+   startpath:=paramstr(0);
+   for b:=length(startpath) downto 1 do
+     if startpath[b]='\' then
+       begin
+          startpath[0]:=chr(b-1);
+          break;
+       end;
+   }
+   oldexitproc:=exitproc;
+   exitproc:=@myexitproc;
+   successfull:=false;
+   installapp.init;
+   installapp.run;
+   installapp.done;
+   if successfull then
+     begin
+        writeln('Extend your PATH variable with');
+        writeln(binpath);
+        writeln;
+        writeln('To compile files enter PPC386 [file]');
+     end;
+end.

install/zipviewu.pas

@@ -0,0 +1,284 @@
+{------8<-------------Snip---------------8<------------Snip------------8<-------}
+{$I-}
+UNIT zipviewu;
+
+(*/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\\/\/\/\/\/\/\/\*)
+(* Unit : Zip View                    Date : March 23, 1994                  *)
+(* By   : John Shipley                Ver  : 1.0                             *)
+(*                                                                           *)
+(* Credits : Steve Wierenga - ZIPV.PAS found in SWAG - Got me started on the *)
+(*           zipviewu code since ZIPV.PAS was fairly easy to read unlike     *)
+(*           some other code I had seen.                                     *)
+(*                                                                           *)
+(*           Tom Guinther - ZIPPER.PAS found in ZIPPER.ZIP (1989) available  *)
+(*           on my BBS "The Brook Forest Inn 714-951-5282" This code helped  *)
+(*           clarify many things. The zipper code is probably better than    *)
+(*           this code and well documented.                                  *)
+(*                                                                           *)
+(*           PkWare's APPNOTE.TXT found in PKZ110.EXE                        *)
+(*                                                                           *)
+(* This unit is offered to the Public Domain so long as credit is given      *)
+(* where credit is due. I accept NO liablity for what this code does to your *)
+(* system or your friends or anyone elses. You have the code, so you can fix *)
+(* it. If this code formats your hard drive and you loose your lifes work,   *)
+(* then all I can say is "Why didn't you back it up?"                        *)
+(*                                                                           *)
+(* Purpose: To mimic "PKUNZIP -v <filename>" output. (v2.04g)                *)
+(*          The code is pretty close to the purpose, but not perfect.        *)
+(*                                                                           *)
+(* Demo :                                                                    *)
+(*                                                                           *)
+(* PROGRAM zip_viewit;                                                       *)
+(* USES DOS,CRT,zipviewu;                                                    *)
+(* BEGIN                                                                     *)
+(*   IF PARAMCOUNT<>0 THEN                                                   *)
+(*     BEGIN                                                                 *)
+(*       zipview(PARAMSTR(1));                                               *)
+(*     END;                                                                  *)
+(* END.                                                                      *)
+(*/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\\/\/\/\/\/\/\/\*)
+
+INTERFACE
+
+USES DOS,CRT;
+
+PROCEDURE zipview(zipfile: STRING);
+
+IMPLEMENTATION
+
+CONST hexdigit : ARRAY[0..15] OF CHAR = '0123456789abcdef';
+
+FUNCTION hexbyte(b: byte): STRING;                        (* Byte to Hexbyte *)
+  BEGIN
+    hexbyte := hexdigit[b SHR 4]+hexdigit[b AND $f];
+  END;
+
+FUNCTION hexlong(l: LONGINT): STRING;                  (* Longint to Hexlong *)
+  VAR n : ARRAY[1..4] OF BYTE ABSOLUTE l;
+  BEGIN
+    hexlong := hexbyte(n[4])+hexbyte(n[3])+hexbyte(n[2])+hexbyte(n[1]);
+  END;
+
+FUNCTION lenn(s: STRING): INTEGER;     (* Like LENGTH, but skips color codes *)
+  VAR i,len : INTEGER;
+  BEGIN
+    len := LENGTH(s);
+    i := 1;
+    WHILE (i<=LENGTH(s)) DO
+      BEGIN
+        IF (s[i] IN [#3,'^']) THEN
+          IF (i<LENGTH(s)) THEN
+            BEGIN
+              DEC(len,2);
+              INC(i);
+            END;
+        INC(i);
+      END;
+    lenn := len;
+  END;
+
+FUNCTION mln(s: STRING; l: INTEGER): STRING;                 (* Left Justify *)
+  BEGIN
+    WHILE (lenn(s)<l) DO s := s+' ';
+    IF (lenn(s)>l) THEN
+      REPEAT
+        s := COPY(s,1,LENGTH(s)-1)
+      UNTIL (lenn(s)=l) OR (LENGTH(s)=0);
+    mln := s;
+  END;
+
+FUNCTION mrn(s: STRING; l: INTEGER): STRING;                (* Right Justify *)
+  BEGIN
+    WHILE lenn(s)<l DO s := ' '+s;
+    IF lenn(s)>l THEN s := COPY(s,1,l);
+    mrn := s;
+  END;
+
+FUNCTION cstr(i: LONGINT): STRING;         (* convert integer type to string *)
+  VAR c : STRING[16];
+  BEGIN
+    STR(i,c);
+    cstr := c;
+  END;
+
+FUNCTION tch(s: STRING): STRING;                          (* Ensure 2 Digits *)
+  BEGIN
+    IF (LENGTH(s)>2) THEN s := COPY(s,LENGTH(s)-1,2)
+    ELSE IF (LENGTH(s)=1) THEN s := '0'+s;
+    tch := s;
+  END;
+
+FUNCTION b2attr(a,g: BYTE): STRING;                     (* Byte to Attribute *)
+  VAR attr : STRING[5];
+  BEGIN
+    attr := '--w- ';
+    IF (g AND 1)=1 THEN attr[5]:='*';                          (* Encrypted? *)
+    IF (a AND 1)=1 THEN attr[3]:='r';                          (* Read Only? *)
+    IF (a AND 2)=2 THEN attr[2]:='h';                             (* Hidden? *)
+    IF (a AND 4)=4 THEN attr[1]:='s';                             (* System? *)
+    IF (a AND 8)=8 THEN attr[4]:='?';                (* Unknown at this time *)
+    b2attr := attr;
+  END;
+
+FUNCTION w2date(d: WORD): STRING;                            (* Word to Date *)
+  VAR s : STRING;
+  BEGIN
+    s := tch(cstr((d SHR 5) AND 15 ))+'-'+                          (* Month *)
+         tch(cstr((d      ) AND 31 ))+'-'+                            (* Day *)
+         tch(cstr(((d SHR 9) AND 127)+80));                          (* Year *)
+    w2date := s;
+  END;
+
+FUNCTION w2time(t: WORD): STRING;                            (* Word to Time *)
+  VAR s : STRING;
+  BEGIN
+    s := tch(cstr((t SHR 11) AND 31))+':'+                           (* Hour *)
+         tch(cstr((t SHR  5) AND 63));                             (* Minute *)
+    w2time := s;
+  END;
+
+PROCEDURE zipview(zipfile: STRING);                     (* View the ZIP File *)
+  CONST lsig = $04034B50;                                 (* Local Signature *)
+        csig = $02014b50;                               (* Central Signature *)
+  TYPE lheader = RECORD                                      (* Local Header *)
+                   signature  : LONGINT;      (* local file header signature *)
+                   version,                                (* version mad by *)
+                   gpflag,                          (* general purpose flags *)
+                   compress,                           (* compression method *)
+                   time,date  : WORD;         (* last mod file time and date *)
+                   crc32,                                          (* crc-32 *)
+                   csize,                                 (* compressed size *)
+                   usize      : LONGINT;                (* uncompressed size *)
+                   fnamelen,                              (* filename length *)
+                   extrafield : WORD;                  (* extra field length *)
+                 END;
+       cheader = RECORD                                    (* Central Header *)
+                   signature  : LONGINT;    (* central file header signature *)
+                   version    : WORD;                     (* version made by *)
+                   vneeded    : WORD;           (* version needed to extract *)
+                   gpflag     : ARRAY[1..2] OF BYTE;(* general purpose flags *)
+                   compress   : WORD;                  (* compression method *)
+                   time       : WORD;                  (* last mod file time *)
+                   date       : WORD;                  (* last mod file date *)
+                   crc32      : LONGINT;                           (* crc-32 *)
+                   csize      : LONGINT;                  (* compressed size *)
+                   usize      : LONGINT;                (* uncompressed size *)
+                   fnamelen   : WORD;                     (* filename length *)
+                   extrafield : WORD;                  (* extra field length *)
+                   fcl        : WORD;                 (* file comment length *)
+                   dns        : WORD;                   (* disk number start *)
+                   ifa        : WORD;            (* internal file attributes *)
+                   efa        : ARRAY[1..4] OF BYTE;   (* external file attr *)
+                   roolh      : LONGINT;  (* relative offset of local header *)
+                 END;
+
+VAR z          : INTEGER;               (* Number of files processed counter *)
+    totalu,                              (* Total bytes that were compressed *)
+    totalc     : LONGINT;          (* result of total bytes being compressed *)
+    hdr        : ^cheader;            (* temporary cental header file record *)
+    f          : FILE;                                           (* file var *)
+    s          : STRING;                          (* archive filename string *)
+    percent    : BYTE;           (* Temporary var holding percent compressed *)
+    numfiles   : WORD;                         (* Number of files in archive *)
+
+CONST comptypes : ARRAY[0..8] OF STRING[7] =            (* Compression Types *)
+                  ('Stored ',                              (* Not Compressed *)
+                   'Shrunk ',                                      (* Shrunk *)
+                   'Reduce1',                                   (* Reduced 1 *)
+                   'Reduce2',                                   (* Reduced 2 *)
+                   'Reduce3',                                   (* Reduced 3 *)
+                   'Reduce4',                                   (* Reduced 4 *)
+                   'Implode',                                    (* Imploded *)
+                   'NotSure',                        (* Unknown at this time *)
+                   'DeflatN');                                   (* Deflated *)
+
+FUNCTION seekc(VAR f: FILE): BOOLEAN;
+  VAR curpos  : LONGINT;                           (* current file position *)
+      buf     : lheader;                   (* Temporary local header record *)
+      ioerror : INTEGER;                       (* Temporary IOResult holder *)
+      result  : WORD;                                   (* Blockread Result *)
+  BEGIN
+    seekc := FALSE;                                           (* init seekc *)
+    curpos := 0;                              (* init current file position *)
+    SEEK(f,0);                                        (* goto start of file *)
+    BLOCKREAD(f,buf,SIZEOF(lheader),result);     (* Grab first local header *)
+    ioerror := IORESULT;                                  (* Test for error *)
+    WHILE (ioerror = 0) AND (buf.signature=lsig) DO (* Test if OK..continue *)
+      BEGIN
+        INC(numfiles);                         (* Increment number of files *)
+        WITH buf DO                             (* Find end of local header *)
+          curpos := FILEPOS(f)+fnamelen+extrafield+csize;
+        SEEK(f,curpos);                         (* Goto end of local header *)
+        BLOCKREAD(f,buf,SIZEOF(lheader),result);  (* Grab next local header *)
+        ioerror := IORESULT;                              (* Test for error *)
+      END;
+      IF ioerror<>0 THEN EXIT;               (* If error then exit function *)
+      IF (buf.signature=csig) THEN (* Did we find the first central header? *)
+        BEGIN
+          seekc := TRUE;                      (* Found first central header *)
+          SEEK(f,curpos); (* Ensure we are at central headers file position *)
+        END;
+  END;
+
+  VAR curpos : LONGINT;
+
+  BEGIN
+    numfiles := 0;      (* Counter of Number of Files to Determine When Done *)
+    z        := 0;                   (* Counter of Number of Files Processed *)
+    totalu   := 0;                      (* Total Bytes of Uncompressed Files *)
+    totalc   := 0;                      (* Total Size after being Compressed *)
+    NEW(hdr);        (* Dynamically Allocate Memory for a Temp Header Record *)
+    ASSIGN(f,zipfile);                        (* Assign Filename to File Var *)
+    {$I-}
+    RESET(f,1);                                         (* Open Untyped File *)
+    {$I+}
+    IF IORESULT<>0 THEN                  (* If we get an error, exit program *)
+      BEGIN
+        WRITELN('Error - File not found.');
+        HALT(253);
+      END;
+    IF NOT seekc(f) THEN (* Skip Local Headers and goto first Central Header *)
+      BEGIN                       (* If we could not locate a Central Header *)
+        CLOSE(f);                                      (* Close Untyped File *)
+        WRITELN('Error - Corrupted or Not a ZIP File.');
+        HALT(254);                                           (* Exit Program *)
+      END;
+
+    WRITELN(' Length  Method   Size  Ratio   Date    Time    CRC-32 '+
+      ' Attr  Name');
+    WRITELN(' ------  ------   ----- -----   ----    ----   --------'+
+      ' ----  ----');
+    REPEAT
+      FILLCHAR(s,SIZEOF(s),#0);                         (* Clear Name String *)
+      BLOCKREAD(f,hdr^,SIZEOF(cheader));                 (* Read File Header *)
+      BLOCKREAD(f,MEM[SEG(s):OFS(s)+1],hdr^.fnamelen);  (* Read Archive Name *)
+      s[0] := CHR(hdr^.fnamelen);                 (* Get Archive Name Length *)
+      IF (hdr^.signature=csig) THEN                           (* Is a header *)
+        BEGIN
+          INC(z);                                  (* Increment File Counter *)
+          WRITE(mrn(cstr(hdr^.usize),7));       (* Display Uncompressed Size *)
+          WRITE(' '+mrn(comptypes[hdr^.compress],7));  (* Compression Method *)
+          WRITE(mrn(cstr(hdr^.csize),8));         (* Display Compressed Size *)
+          percent := ROUND(100.0-(hdr^.csize/hdr^.usize*100.0));
+          WRITE(mrn(cstr(percent),4)+'% ');   (* Display Compression Percent *)
+          WRITE(' '+w2date(hdr^.date)+' ');    (* Display Date Last Modified *)
+          WRITE(' '+w2time(hdr^.time)+' ');    (* Display Time Last Modified *)
+          WRITE(' '+hexlong(hdr^.crc32)+' ');       (* Display CRC-32 in Hex *)
+          WRITE(b2attr(hdr^.efa[1],hdr^.gpflag[1]));   (* Display Attributes *)
+          WRITELN(' '+mln(s,13));                (* Display Archive Filename *)
+          INC(totalu,hdr^.usize);             (* Increment size uncompressed *)
+          INC(totalc,hdr^.csize);               (* Increment size compressed *)
+        END;
+      SEEK(f,FILEPOS(f)+hdr^.extrafield+hdr^.fcl);
+    UNTIL (hdr^.signature<>csig) OR EOF(f) OR (z=numfiles); (* No more Files *)
+    WRITELN(' ------          ------  ---                                 '+
+      ' -------');
+    WRITE(mrn(cstr(totalu),7)+'         ');    (* Display Total Uncompressed *)
+    WRITE(mrn(cstr(totalc),7)+' ');              (* Display Total Compressed *)
+    WRITE((100-TotalC/TotalU*100):3:0,'%'+mrn(' ',34));   (* Display Percent *)
+    WRITELN(mrn(cstr(z),7));                      (* Display Number of Files *)
+    CLOSE(f);                                          (* Close Untyped File *)
+    DISPOSE(hdr);                            (* Deallocate Header Var Memory *)
+  END;
+
+END.