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

Pascal/Delphi Source File | 1994-11-10 | 8KB | 308 lines

Unit OFDirTab;
{ Tableau contenant les fichiers d'un répertoire. }
{ Il s'agit d'un objet dérivé de l'objet TTabPtr défini dans l'unité
  OTabPtr.Pas. On a donc un tableau de pointeurs, chacun d'entre eux
  pointant sur un enregistrement de type SearchRec défini dans l'unité
  DOS.}

{ K.B. avril-novembre 1994 }

{$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}

INTERFACE

Uses Dos,OTableau;

Const
 erDir=5;

Type
 { nom de fichier }
 TStr12=String[12];
 { informations fichier }
 PSearchFileRec=^TSearchFileRec;
 TSearchFileRec = record
     Attr: Byte;
     Time: Longint;
     Size: Longint;
     Name: TStr12;
     end;

 { objet TFileTab; tableau des fichiers d'un répertoire }
 PFileTab=^TFileTab;
 TFileTab=object(TTabPtr)
  Constructor Init(CheminMasque:PathStr);
  { Le constructeur attend le nom du répertoire avec un éventuel
    masque de sélection }
  Function GetErrorMsg:String;virtual;
  Procedure ReadDir;virtual;
  { Lecture du contenu du répertoire }
  Procedure ChangeDir(Chemin:PathStr);
  { Changement de répertoire }
  Function DonneRepertoire:PathStr;
  { Renvoie le nom du répertoire }
  Function DonneMasque:TStr12;
  { Renvoie le masque de sélection }
  Function Compare(i1,i2:Integer):Integer;virtual;
  { Comparaison pour classement :
    1) d'abord les sous répertoires dans l'ordre alphabétique
    2) ensuite les fichiers dans l'ordre alphabétique }
  Procedure Effacer(p:Pointer);virtual;
  { Libération de la mémoire allouée à un pointeur sur enregistrement
    de type SearchRec }
  Function TailleTotale:LongInt;
  { Taille totale des fichiers lus }
  Private
    Masque:TStr12;      { masque de sélection }
    Repertoire:DirStr; { répertoire étudié }
  End;

 { exemple d'objet dérivé qui ne lit que les sous répertoires }
 PDirTab=^TDirTab;
 TDirTab=object(TFileTab)
  Constructor Init;
  Procedure ReadDir;virtual;
  End;

 { utilitaires pour obtenir le contenu d'un enregistrement de type
   SearchRec }
 Function NomFichier(P:PSearchFileRec):TStr12;
 Function TailleFichier(P:PSearchFileRec):LongInt;
 Function AttributFichier(P:PSearchFileRec):Word;

IMPLEMENTATION

Function NomFichier(P:PSearchFileRec):TStr12;
Begin
 NomFichier:=P^.Name;
End;

Function TailleFichier(P:PSearchFileRec):LongInt;
Begin
 TailleFichier:=P^.Size;
End;

Function AttributFichier(P:PSearchFileRec):Word;
Begin
 AttributFichier:=P^.Attr;
End;

{ objet TFileTab }

Constructor TFileTab.Init(CheminMasque:PathStr);
Var Attr:Word;
    Nom: NameStr;
    Rep: DirStr;
    E: ExtStr;
    f: File;
    FStr:PathStr;
Begin
 { constructeur hérité }
 TTabPtr.Init(50,50);
 { étude du paramètre }
 FStr:=FExpand(CheminMasque);
 if FStr[Length(FStr)]<>'\'
 { ajouter le symbole / s'il s'agit d'un répertoire }
    then begin
          Assign(f,FStr);
          GetFAttr(f,Attr);
          if (DosError=0) and (Attr and Directory <> 0)
             then FStr:=FStr + '\';
         end;
 FSplit(FStr,Rep,Nom,E);
 { choix par défaut }
 if Nom = '' then Nom := '*';
 if E = '' then E := '.*';
 { masque de sélection }
 Masque:=Nom+E;
 { répertoire de sélection }
 Repertoire:=Rep;
 { lecture du contenu }
 ReadDir;
End;

Procedure TFileTab.ReadDir;
Var F: SearchRec;
    P:PSearchFileRec;
Begin
 { effacer ce qui existe déjà }
 if NombreItems<>0
    then Vider;
 { recherche des répertoires }
 FindFirst(Repertoire+'*.*',Directory,F);
 if (DosError=0) and (F.Name='.')
    then FindNext(F);
 While (DosError=0) and IsValid do
  begin
   if F.Attr and Directory <> 0
      then begin
            Getmem(P,SizeOf(TSearchFileRec));
            if P<>nil
               then begin
                     move(F.Attr,P^,SizeOf(TSearchFileRec));
                     Ajouter(P);
                    end;
           end;
   FindNext(F);
  end;
 { recherche des fichiers }
 FindFirst(Repertoire+Masque,AnyFile,F);
 While (DosError=0) and IsValid do
  begin
   if F.Attr and Directory = 0
      then begin
            Getmem(P,SizeOf(TSearchFileRec));
            if P<>nil
               then begin
                     move(F.Attr,P^,SizeOf(TSearchFileRec));
                     Ajouter(P);
                    end;
           end;
   FindNext(F);
  end;
 { classement }
 Trier(true);
End;

Procedure TFileTab.ChangeDir(Chemin:PathStr);
Var FStr:PathStr;
    Attr:Word;
    f:File;
Begin
 FStr:=FExpand(Chemin);
 { supprimer le symbole \ }
 if FStr[length(FStr)]='\'
    then dec(FStr[0]);
 { vérifier qu'on a bien un répertoire }
 if length(FStr)>2
    then begin
          Assign(f,FStr);
          GetFAttr(f,Attr);
          if (DosError=0) and (Attr and Directory <> 0)
             then Repertoire:=FStr + '\'   { tout va bien }
             else begin
                   ErrorFlag:=erDir;
                   exit;
                  end;
         end
    else Repertoire:=FStr+'\';
 { lecture du contenu du répertoire }
 ReadDir;
End;

Function TFileTab.GetErrorMsg:String;
Begin
 case ErrorFlag of
  erDir : GetErrorMsg:= 'Répertoire non valide.';
  else GetErrorMsg:=TTableau.GetErrorMsg;
  end;
End;

Function TFileTab.DonneRepertoire:PathStr;
Begin
 DonneRepertoire:=Repertoire;
End;

Function TFileTab.DonneMasque:TStr12;
Begin
 DonneMasque:=Masque;
End;

Function TFileTab.Compare(i1,i2:Integer):Integer;
Var nd1,nd2:TStr12;
    attr1,attr2:Word;
    p1,p2:PSearchFileRec;
Begin
 Lire(p1,i1);
 Lire(p2,i2);
 { classer les répertoires avant les fichiers }
 attr1:=AttributFichier(P1);
 attr2:=AttributFichier(P2);
 if attr1 and Directory <> 0
    then begin
          if attr2 and Directory = 0
             then begin
                   compare:=-1;
                   exit;
                  end;
         end
    else begin
          if attr2 and Directory <> 0
             then begin
                   compare:=1;
                   exit;
                  end;
         end;
 { classer par ordre alphabétique }
 nd1:=NomFichier(P1);
 nd2:=NomFichier(P2);
 if nd1<nd2
    then compare:=-1
    else compare:=1;
End;

Procedure TFileTab.Effacer(p:Pointer);
Begin
 { libérer la mémoire allouée à un pointeur sur un enregistrement
   du type TSearchFileRec }
 if p<>nil
    then FreeMem(P,SizeOf(TSearchFileRec));
End;

Function TFileTab.TailleTotale:LongInt;
Var r:LongInt;
    n:Integer;
    p:PSearchFileRec;
Begin
 r:=0;
 if NombreItems>0
    then For n:=1 to NombreItems do
          begin
           Lire(p,n);
           r:=r+TailleFichier(p);
          end;
 TailleTotale:=r;
End;

{ objet TDirTab }
{ ne lit que les sous répertoires }
Constructor TDirTab.Init;
Begin
 TFileTab.Init('*.*');
End;

Procedure TDirTab.ReadDir;
{ procédure virtuelle redéfinie pour ne lire que les sous répertoires }
Var F: SearchRec;
    P:PSearchFileRec;
Begin
 if NombreItems<>0
    then Vider;
 {recherche des sous répertoires}
 FindFirst(Repertoire+'*.*',Directory,F);
 if (DosError=0) and (F.Name='.')
    then FindNext(F);
 While (DosError=0) and IsValid do
  begin
   if F.Attr and directory <>0
      then begin
            Getmem(P,SizeOf(TSearchFileRec));
            if P<>nil
               then begin
                     move(F.Attr,P^,SizeOf(TSearchFileRec));
                     Ajouter(P);
                    end;
           end;
   FindNext(F);
  end;
 Trier(true);
End;

END.

{                         Fin du fichier OFDirTab.Pas                       }