DP Tool Club 19/CD_ASCQ_19_010295.iso/dos/prg/pas/ktools/source/zipview.pas

Pascal/Delphi Source File | 1994-11-17 | 4KB | 193 lines

Program ZipView;
{ Visualisation de fichiers ZIP }
{ K.B. juin 1994 }

{.$DEFINE debug}

{$IFDEF debug}
 {$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
{$ELSE}
 {$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
{$ENDIF}

Uses Dos,
     UMem,UDrivers,UTextScr,
     OFZip,
     OGenView,OTxtView,ODialWin;

Const
 cmInit=$300;
 cmOpen=$301;

Type
 PZipWin=^TZipWin;
 TZipWin=object(TSelWin)
  Table:TZipTab;
  Constructor Init(NomDeFichier:PathStr);
  Destructor Done;virtual;
  Procedure Draw;virtual;
  Function Ligne(n:Integer):String;virtual;
  Function NombreItems:Integer;virtual;
  Function GetErrorMsg:String;virtual;
  End;

 PZipApp=^TZipApp;
 TZipApp=object(TTextApp)
  Constructor Init;
  Procedure HandleEvent(var Event:TEvent); virtual;
  Procedure InitStatusLine; virtual;
  Procedure MakeZipWin(S:PathStr);
  End;

{ objet TZipWin }

Constructor TZipWin.Init(NomDeFichier:PathStr);
Var D:DirStr;
    N:NameStr;
    E:ExtStr;
Begin
 FSplit(NomDeFichier,D,N,E);
 TSelWin.Init(1,2,53,20,N+E);
 Ident:='ZIPWIN';
 Table.Init(NomDeFichier);
 if not Table.IsValid
    then begin
          ErrorFlag:=2;
          exit;
         end;
End;

Destructor TZipWin.Done;
Begin
 Table.Done;
 TSelWin.Done;
End;

Procedure TZipWin.Draw;
Var S,T:String;
Begin
 if not IsValid
    then exit;
 TSelWin.Draw;
 Str(Table.NombreItems,T);
 S:='[Fichiers: '+T+' ';
 Str(Table.TailleDecomp:1:0,T);
 S:=S+'Taille: '+T+' octets]';
 Ecrire(S,(largeur-length(S)) div 2,hauteur+1,0);
End;

Function TZipWin.Ligne(n:Integer):String;
Var S:String;
    P:PFileZipDatas;
Begin
 if (n<1) or (n>NombreItems)
    then S:=''
    else begin
          Table.Lire(p,n);
          S:=ZNom(P^)+' '+Longueur(P^)+' '+Taille(P^)+' '+
             Ratio(P^)+'  '+ZDate(P^);
         end;
 Ligne:=S;
End;

Function TZipWin.NombreItems:Integer;
Begin
 NombreItems:=Table.NombreItems;
End;

Function TZipWin.GetErrorMsg:String;
Begin
 case ErrorFlag of
  0: GetErrorMsg:='';
  1: GetErrorMsg:=TSelWin.GetErrorMsg;
  else GetErrorMsg:=Table.GetErrorMsg;
  end;
End;

{ objet TZipApp }

Constructor TZipApp.Init;
Begin
 TTextApp.Init;
 Titre:='Contenu d''un fichier ZIP';
 if ParamCount>0
    then SetCommand(cmInit)
    else SetCommand(cmOpen);
End;

Procedure TZipApp.InitStatusLine;
Begin
 StatusLine:=New(PStatusLine,Init);
 with StatusLine^ do
  begin
   AjouterItem('AltX Quitter',AltX);
   AjouterItem('F2 Fichiers', F2);
  end;
End;

Procedure TZipApp.HandleEvent(Var Event:TEvent);
Var S : String;
Begin
 TTextApp.HandleEvent(Event);
 case Event.What of
  evCommand:
   case Event.Command of
    cmInit:
      begin
       S:=ParamStr(1);
       MakeZipWin(S);
      end;
    cmOpen:
      begin
       S:=GetFile('*.ZIP');
       if S<>''
          then begin
                ClearDeskTop;
                MakeZipWin(S);
               end;
      end;
    else exit;
    end;
  evKeyDown:
   case Event.KeyCode of
    F2 : SetCommand(cmOpen);
    else exit;
    end;
  else exit;
  end;
 Event.What:=evNothing;
End;

Procedure TZipApp.MakeZipWin(S:PathStr);
Var ZipWin:PZipWin;
Begin
 if S=''
    then exit;
 ZipWin:=New(PZipWin,Init(S));
 if ZipWin^.IsValid
    then begin
          Insert(ZipWin);
          ZipWin^.Show;
         end
    else begin
          Message(ZipWin^.GetErrorMsg);
          dispose(ZipWin,Done);
         end;
End;

Var ZipApp : TZipApp;

Begin
 {$ifdef debug}
 initmem;
 {$endif}
 ZipApp.Init;
 if ZipApp.IsValid
    then ZipApp.Exec
    else writeln(ZipApp.GetErrorMsg);
 ZipApp.Done;
 {$ifdef debug}
 diagmem;
 {$endif}
End.