home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PAS_0493 / ZIPV.PAS < prev   
Pascal/Delphi Source File  |  1993-04-15  |  5KB  |  157 lines
  1. { ZipV.Pas : Unit to view contents of .ZIP files.  By Steve Wierenga. Released
  2.   to the Public Domain.                                                       }
  3. Unit ZipV;
  4. (**) INTERFACE (**)
  5. Uses Dos,Crt;
  6. Procedure ZipView(ZIPfile:string);
  7. Function GAN(ZIPFile : String) : String;
  8. (**) IMPLEMENTATION (**)
  9. Procedure Terminate;
  10. Begin
  11.   Write('ARCHPEEK could not find specified file.  Aborting...');
  12.   Halt;
  13. End;
  14.  
  15. Procedure ZipView(ZIPfile : string);  { View the ZIP file }
  16.   Const
  17.     SIG = $04034B50;                  { Signature }
  18.   Type
  19.     ZFHeader = Record                 { Zip File Header }
  20.              Signature : LongInt;
  21.              Version,GPBFlag,Compress,Date,Time : Word;
  22.              CRC32,CSize,USize : LongInt;
  23.              FNameLen,ExtraField : Word;
  24.       End;
  25.  
  26.   Var
  27.     z       : Integer;
  28.     x,
  29.     totalu,
  30.     totalc  : LongInt;
  31.     Hdr     : ^ZFHeader;
  32.     F       : File;
  33.     S,sss   : String;
  34.     own     : text;
  35.     dt1     : DateTime;
  36.     l       : String[80];
  37.     registered : boolean;  { Is registered? }
  38.   CONST
  39.     CompTypes : ARRAY[0..7] OF String[9] = ('Stored   ','Shrunk   ',
  40.                 'Reduced1','Reduced2','Reduced3','Reduced4',
  41.                 'Imploded ','Deflated');
  42.                 { Method used to compress }
  43.     r = #196;
  44.     q = #205;
  45. Begin
  46.     z := 0; totalu := 0; totalc := 0; { Init variables }
  47.     registered := false; { Unregistered }
  48.     if not registered then   { Is registered? }
  49.     begin
  50.       Writeln('ArchPeek 0.01Alpha [UNREGISTERED] Copyright 1993 Steve Wierenga');
  51.       Delay(200);
  52.     end;
  53.     New(Hdr);
  54.     Assign(F,ZIPFile);
  55.     {$I-}
  56.     Reset(F,1);                   { Open file }
  57.     {$I+}
  58.     If IOResult <> 0 then Terminate;  { Couldn't open Zip file }
  59.     sss := GAN(ZipFile);              { Get the Zip filename }
  60.     Writeln('Zip FileName: ',sss);
  61.     WriteLn( '   Name           Length      Size  Saved      Method');
  62.     WriteLn( '   ',r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,
  63.      r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r,r);
  64.     Repeat
  65.       FillChar(S,SizeOf(S), #0);  { Pad with nulls }
  66.       BlockRead(F,Hdr^,SizeOf(ZFHeader));
  67.       { Read File Header }
  68.       BlockRead(F,Mem[Seg(S) : Ofs(S) + 1], Hdr^.FNameLen);
  69.       s[0] := Chr(Hdr^.FNameLen);
  70.       Case Length(S) Of    { Straighten string }
  71.        0  : s := s + '            ';
  72.        1  : S := s + '           ';
  73.        2  : s := s + '          ';
  74.        3  : S := S + '         ';
  75.        4  : S := S + '        ';
  76.        5  : S := S + '       ';
  77.        6  : S := S + '      ';
  78.        7  : S := S + '     ';
  79.        8  : S := S + '    ';
  80.        9  : S := S + '   ';
  81.        10 : S := S + '  ';
  82.        11 : S := S + ' ';
  83.        12 : S := S;
  84.       End;
  85.       If (Hdr^.Signature = Sig) Then { Is a header }
  86.       Begin
  87.         z := z + 1;
  88.         WriteLn( '   ',S,Hdr^.USize:9,Hdr^.CSize:10,(100-Hdr^.CSize/Hdr^.USize*100):5:0,'%',
  89.                 CompTypes[Hdr^.Compress]:16);
  90.         Inc(TotalU,Hdr^.USize);  { Increment size uncompressed }
  91.         Inc(TotalC,Hdr^.CSize);  { Increment size compressed }
  92.       End;
  93.       Seek(F,FilePos(F) + Hdr^.CSize + Hdr^.ExtraField);
  94.       Until Hdr^.Signature <> SIG; { No more files }
  95.           GetFTime(F,x);
  96.         UnPackTime(x,DT1);
  97.     WriteLn( '   ',q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,
  98.      q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q,q);
  99.     Write( z:4,' Files  ',TotalU:12,TotalC:10,(100-TotalC/TotalU*100):5:0,
  100.             '%');
  101.     Case dt1.month of        { Get Zip file date and time }
  102.      1..9   : Write( '0':4,dt1.month);
  103.      10..12 : Write( dt1.month:4);
  104.     End;                                                    
  105.     Write( '/');
  106.     Case dt1.day of
  107.      1..9   : Write( '0',dt1.day);
  108.      10..31 : Write( dt1.day);
  109.     End;
  110.     Write( '/');
  111.     Case dt1.year of
  112.      1980 : Write( '80');
  113.      1981 : Write( '81');
  114.      1982 : Write( '82');
  115.      1983 : Write( '83');
  116.      1984 : Write( '84');
  117.      1985 : Write( '85');
  118.      1986 : Write( '86');
  119.      1987 : Write( '87');
  120.      1988 : Write( '88');
  121.      1989 : Write( '89');
  122.      1990 : Write( '90');
  123.      1991 : Write( '91');
  124.      1992 : Write( '92');
  125.      1993 : Write( '93');
  126.      1994 : Write( '94');
  127.      1995 : Write( '95');
  128.      1996 : Write( '96');
  129.     End;
  130.     Case dt1.hour of
  131.      0..9   : Write( '0':3,dt1.hour,':');
  132.      10..23 : Write( dt1.hour:3,':');
  133.     End;
  134.     Case dt1.min of
  135.      0..9   : Write( '0',dt1.min,':');
  136.      10..59 : Write( dt1.min,':');
  137.     End;
  138.     Case dt1.sec of
  139.      0..9   : Writeln( '0',dt1.sec);
  140.      10..59 : Writeln( dt1.sec);
  141.     End;
  142.     Close(F);
  143.     Dispose(Hdr);
  144. End;
  145.  
  146.  
  147. FUNCTION GAN(ZIPfile:String): string;
  148.   Var
  149.     Dir  : DirStr;
  150.     Name : NameStr;
  151.     Exts : ExtStr;
  152.   Begin
  153.     FSplit(ZIPFile,Dir,Name,Exts);
  154.     GAN := Name + Exts;
  155.   End;
  156.  
  157. End.