{$IFNDEF OS2}
{$F+,O+}
{$ENDIF}
{$I-}

Unit XDel;

Interface

Procedure DelWithSubDirs (Directory: String);

  {=======================================================}
  {===== Процедура удаления директории с подвложениями ===}
  {             (c) Alex Y. Radzishevskiy (1996)          }
  {=======================================================}

Implementation

Uses
{$IFNDEF WIN32}
  DOS,
{$ELSE}
  Classes,
  OpCrt,
  SysUtils,
{$ENDIF}
  Objects,
  TGlob;

Var
  DelDirs          : PNotSortedCollection;
  Name             : NameStr;
  Dir              : DirStr;
  Ext              : ExtStr;
  TempStr          : PathStr;

Function LastDir (SRec : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF}) : Boolean;
Var
  ErrorDos : Integer;
  LDir     : Boolean;

Begin
  ErrorDos := DosError;
  LDir := True;
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindNext (SRec);
  While (DosError = 0) And LDir Do
  Begin
    LDir := (SRec. Attr And Directory = 0);
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (SRec);
  End;
  DosError := ErrorDos;
  LastDir := LDir;
End;

Procedure Tree (Dir : PathStr);

Procedure SearchDir (Dir, GrDir : PathStr);
Var
 SRec : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};

Begin
  If Dir [Length (Dir) ] <> '\' Then Dir := Dir + '\';
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Dir + '*.*', Directory + Hidden, SRec);
  While DosError = 0 Do
  Begin
    With SRec Do
    If (Attr And Directory <> 0) And (Name [1] <> '.') Then
    If LastDir (SRec) Then
    Begin
      DelDirs^. Insert (NewStr (Dir + Name));
      SearchDir (Dir + Name, GrDir + '   ');
    End Else
    Begin
      DelDirs^. Insert (NewStr (Dir + Name) );
      SearchDir (Dir + Name, GrDir + '│  ');
    End;
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (SRec);
  End;

{$IFDEF OS2}
  FindClose (SRec);
{$ENDIF}
End;

Begin
  DelDirs^. Insert (NewStr (Dir));
  SearchDir (Dir, ' ');
End;

Procedure ScanDirs;
Begin
  FSplit ( {$IFNDEF WIN32} FExpand {$ELSE} ExpandFileName {$ENDIF} (''), Dir, Name, Ext);
  Tree (Dir);
End;

Procedure DeleteFiles (Files: String);
Var
  SrD : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};
  F   : File;

Begin;
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Files, AnyFile, SrD);

  While DosError = 0 Do
  Begin
    Assign (F, Srd. Name);
    Erase (f);
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (SrD);
  End;

  {$IFDEF OS2}
  FindClose (SrD);
  {$ENDIF}
End;

Procedure DelWithSubDirs (Directory: String);
Var
  i  : Word;

Begin
  ChDir (Directory);
  DelDirs := New (PNotSortedCollection, Init (10, 1));
  ScanDirs;

  For i := DelDirs^. Count - 1 Downto 0 Do
  Begin
    TempStr := PString (DelDirs^. At (i))^;
    If TempStr [Length (TempStr) ] = '\' Then TempStr := Copy (TempStr, 1, Length (TempStr) - 1);
    ChDir (TempStr);
    DeleteFiles ('*.*');

    ChDir ('..');
    RmDir (TempStr);
  End;
  Dispose (DelDirs, Done);
End;

End.