Power-Programmierung/CD1.mdf/pascal/library/dos/packer/zip/pkpas/pkdemo2.pas

Pascal/Delphi Source File | 1993-10-16 | 6.6 KB | 248 lines

Program PkDemo2;
{$D-,S-,R-,B-,I+}

 (***************************************************************

  Second demo of PKware unit, showing use of the FileStats record.

  Copyright Terry Sansom Oct, 1993

  ***************************************************************)

USES DOS,CRT, PKWareU;

CONST
     HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';

TYPE
     D2 = String[2];

VAR
    EntryCount: Byte;
    FileName  : String;
    FileOpen  : Boolean;        { Flag set if file is open }
    CFH       : CentralFileHeaderType;
    FS        : FileStats;
    Error     : Word;

{ ********* The folowing are used in formating output ************* }

      Function HexNum(L:LongInt):String;
      { Convert a longint type to HEX string }
      VAR T : String[8];
        BEGIN
          T[0] := #8;
          T[1] := HexDigits[L SHR 28];
          T[2] := HexDigits[(L SHR 24) AND $F];
          T[3] := HexDigits[(L SHR 20) AND $F];
          T[4] := HexDigits[(L SHR 16) AND $F];
          T[5] := HexDigits[(L SHR 12) AND $F];
          T[6] := HexDigits[(L SHR 8) AND $F];
          T[7] := HexDigits[(L SHR 4) AND $F];
          T[8] := HexDigits[L AND $F];
          HexNum := T;
      end;

         Function StrNum(I:Word):D2;
         { add leading 0 to number }
         var S:D2;
         begin
           Str(I,S);
           IF I < 10 then
              Insert('0',S,1);
           StrNum := S;
         end;

      Function PadStr(S:String;Size:Byte):String;
      { Pad a string to the right }
      VAR Temp:String;
          Len: Byte;
      begin
          Fillchar(Temp[1],Size,' ');
          Temp[0] := chr(Size);
          Len := length(S);
          If Len <= Size then
             Move(S[1],Temp[succ(Size - Len)],Len)
          else
             Move(S[1],Temp[1],size);
         PadStr := Temp;
      end;

      Function PadNum(I:LongInt; Size:Byte): String;
      { Pad a number to the Right }
      VAR ST:String;
      begin
        Str(I,ST);
        PadNum := PadStr(St,Size);
      end;


     Function AttrStr(Attr:LongInt):String;
     VAR S: String[4];
      begin
       S := '';
       IF (Attr = Archive) then
          S := 'w';
       IF (Attr = Hidden) then
          S := S+'h';
       IF (Attr = ReadOnly ) then
          S := S + 'r';
       IF (Attr = SysFile ) then
          S := S +'s';
       AttrStr := S;
      end;

      Function TimeStr(D:LongInt):String;
      VAR DT: DateTime;
      begin
       UNpackTime(D,DT);
       With DT do
       begin
        TimeStr :=  StrNum(Month)+'-'+StrNum(Day)+'-'+StrNum(Year-1900)+' '+
                    StrNum(Hour)+':'+StrNum(Min);
       end;
      end;

 { Shows reason for teminating }

   Procedure ShowError(I:Word);
   begin
     Writeln;
     Case I of
      0: Writeln('End of demo.. no errors');
      1:Writeln('Signature indicates there is an error.');
      2:Writeln('Block read error.');
      3:Writeln('Sorry file not found...');
      4: Writeln('User request: program termintaion..');
      Else Writeln('IO error.');
     end;
    IF FileOpen then
      Close(ZipFile);
    Halt(I);
   end;

    Procedure Anykey;
    VAR CH:Char;
    begin
     HighVideo;
     Writeln('Press any key to continue Esc to stop.');
     NormVideo;
     Ch := Readkey;
     IF Ch = #27 then ShowError(4);
    end;

Procedure Welcome;
begin
  Clrscr;
  Writeln('---------------------------------------------------------------');
  HighVideo;
  Writeln('             PKDemo Demo for PKWareU version 1.0 ');
  LowVideo;
  Writeln;
  Writeln(' A simple demonstration for reading PKzipped files for Turbo');
  Writeln(' Pascal version 5.x.  See README.TXT for details.');
  Writeln;
  Writeln(' 1:  Enter the Zipped file you wish to examine.');
  Writeln;
  Writeln(' 2:  If the file is found, a short summary of the Zip archive will');
  Writeln('     be displayed');
  Writeln;
  Writeln(' 3:  Each keystroke will show details of each file in the');
  Writeln('     archive.');
  Writeln;
  Writeln('---------------------------------------------------------------');
  AnyKey;
end;

  Procedure GetZipFile;
  VAR
      Error: Word;
   begin
     Filename := '';
     Write(' Enter the zipped file: ');
     Readln(Filename);
     If FileName = '' then
       ShowError(3);
     Assign(ZipFile, Filename);
     {$I-}
       Reset(ZipFile);
       Error := IOResult;
     {$I+}
     If Error <> 0 then
       ShowError(3);
     FileOpen:= True;
   end;

Procedure Header;
begin
  HighVideo;
   Writeln(' Filename    Method      Orig. Size Comp. Size  Date     Time   CRC-32     Attr');
   Writeln('------------ ----------- ---------- ----------  -------- -----  ---------  ----');
   NormVideo;
end;

Procedure ShowFileStat;
begin
 CFH_to_FileStat(CFH, FS);
 With FS do
 begin
   Write(Name);
   Gotoxy(14,WhereY);
   Write(CompMethod[Method]);
   Gotoxy(26,WhereY);
   Writeln(PadNum(OSize,10),' ',PadNum(CSize,10),' ',TimeStr(Date):15,' ',
           HexNum(Crc):10,' ',AttrStr(Attr):5);
 end;
end;

Procedure SHowZipStats;
begin
  Clrscr;
  With ZipStats Do
    begin
      Writeln;

      Writeln('    ---- Zip Stat`s before reading central directory ---');
      Write('             For file: ');
      HighVideo; Writeln(FileName); NormVideo;
      Writeln;
      Writeln('      End Signature           : ', HexNum(EndSig));
      Writeln('      Disk Number             : ', DiskNum);
      Writeln('      Disk num. with start    : ', DiskwStart);
      Writeln('      Number of entries       : ', NumEntries);
      Writeln('      Total number of entries : ', TNumEntries);
      Writeln('      Size of central dir.    : ', SizeCentral);
      Writeln('      Offset of central       : ', OffsetDirRelDiskNum);
      Writeln('      Size of comment         : ', CommentLen);
      Writeln;
   end;
   Writeln('    ---------------------------------------------------');
   Writeln;
end;

begin
  FileOpen := False;
  Welcome;
  GetZipFile;
  Error := GetZipStats;
  If Error = 0 then
   begin
     ShowZipStats;
     AnyKey;
     Clrscr;
     Header;
     For EntryCount := 1 to ZipStats.TNumEntries do
       begin
         Error := ReadFileHeader(Cfh);
         If Error = 0 then
           begin
             ShowFileStat;
          { AnyKey;}  { Remove comments if you want pauses between }
           end
         Else ShowError(Error);
       end; { for }
     Writeln('-------------------------------------------------------------------------------');
    end { if }
  Else ShowError(Error);
  ShowError(0); { close file and exit }
end.