(*$M 16384, 0, 32768 *)

Program SE_DIRT;
Uses 
  CRT, DOS;

(*
 *  19.02.1995: Creation TL
 *  19.02.2003: 
 *
 *  1) Essayer le programme tel quel
 *  
 *  2) Faire un tri par DATE ou par TAILLE
 *     et obtenir un Stack Overflow :
 *     soit en changeant la taille de la pile systeme en $M 8192
 *     soit en ajoutant une variable type STRING dans la proc FicECRIT
 *
 *     ( Executer dans \WINDOWS ou dans un dossier avec beaucoup
 *       de fichiers)
 *)

Type
  PFichier = ^Fichier;
  Fichier = Record
    Nom : String[ 8];
    Sfx : String[ 4];
    Siz : LongInt;
    Dat : String[ 8];
    Tim : String[ 8];
    Gch : PFichier;
    Drt : PFichier;
  End;

Var NbFil: Integer; PFicZero : PFichier; 

(*-----*)

Function FicAVANT(PF1, PF2 :PFichier) :Boolean;
Begin
  If PF1^.Nom < PF2^.Nom Then
     FicAvant:=True
  Else If PF1^.Nom = PF2^.Nom Then Begin
     FicAvant:=(PF1^.Sfx < PF2^.Sfx);
  End Else Begin
    FicAvant:=False;
  End;
End;   (* FicAVANT *)

(*-----*)

Procedure FicINSERE(Var PFic, PFicZ :PFichier);
Begin
  If PFicZ = Nil Then Begin PFicZ:=Pfic; Exit; End;
  If FicAVANT(PFic, PFicZ) Then FicINSERE(PFic, PFicZ^.Gch)
                           Else FicINSERE(PFic, PFicZ^.Drt);
End;   (* FicINSERE *)

(*-----*)

Procedure FicAJOUTE(DirINFO :SearchRec);
  Var PFic :PFichier; UDT : DateTime; KK, Lgr :Integer;

  Function TxCH2(KK :Integer) :String;
    Var SS :String;
  Begin
    Str(100+KK, SS); TxCH2:=Copy(SS, 2, 2);
  End;

Begin
  New(PFic); KK:=Pos('.', DirINFO.Name);

  If KK = 0 Then Begin
    PFic^.Nom:=DirINFO.name;
    Pfic^.Sfx:='';
  End Else Begin
    Lgr:=Length(DirINFO.Name);
    PFic^.Nom:=Copy(DirINFO.Name, 1, KK-1);
    PFic^.Sfx:=Copy(DirINFO.Name, KK, Lgr+1-KK);
  End;

  PFic^.Siz:=DirINFO.Size;
  
  UnPackTime(DirINFO.Time, UDT);
  PFic^.Dat:=TxCH2(UDT.Year) +'.'+ TxCH2(UDT.Month) +'.'+ TxCH2(UDT.Day);
  PFic^.Tim:=TxCH2(UDT.Hour) +':'+ TxCH2(UDT.Min  ) +':'+ TxCH2(UDT.Sec);

  PFic^.Gch:=Nil; PFic^.Drt:=Nil; FicINSERE(PFic, PFicZero);
End;   (* FicAJOUTE *)

(*-----*)

Procedure FicLISTE;
  Procedure FicECRIT(PFic :PFichier);
  Begin
    If PFic <> Nil Then Begin
      FicECRIT(PFic^.Gch);
      With PFic^ Do Begin
        Write  (' ', Nom, ' ':9-Length(Nom));
        Write  (Sfx, ' ':5-Length(Sfx));
        WriteLN(Siz:9, '   ', Dat, '  ', Tim);
      End;
      FicECRIT(PFic^.Drt);
    End;
  End;   (* FicECRIT *)
Begin
  FicECRIT(PFicZero);
End;   (* FicLISTE *)

(*-----*)

Var NP :Integer; DirINFO :SearchRec;

Begin  (* Debut *)
  Assign(Output, ''); ReWrite(Output); (* permet SE_DIRT | MORE *)

  NbFil:=0; PFicZero:=Nil; FindFIRST('*.*', Anyfile, DirINFO);

  While DosError = 0 Do Begin
    If (DirINFO.Attr And Directory) = 0 Then Begin
      If (DirINFO.Attr And VolumeID) = 0 Then Begin
        Inc(NbFil); FicAJOUTE(DirINFO);
      End;
    End;
    FindNEXT(DirINFO);
  End;
  FicLISTE; 
End.   (* SE_DIRT *)