Code:

Function EraseDir(Source: String): Integer;
Var
 StartDir     :String;
 DirCount     :Integer;

 Procedure ProcessDelDir(DName: String);
 Var
  NewPath     :String;
  FInfo       :TSearchRec;
  ErrCode     :Integer;
 Begin
  Inc(DirCount);
  ErrCode:=FindFirst(DName+'\*.*', FaAnyFile, FInfo);
  If (ErrCode <> 0) Then Exit;

  Application.ProcessMessages;

  While ErrCode = 0
   Do Begin
       Application.ProcessMessages;

       If ((FInfo.Attr And FaDirectory) = FaDirectory)
        Then Begin
              If (FInfo.Name <> '.')And(FInfo.Name <> '..')
               Then Begin
                     NewPath:=DName+'\'+FInfo.Name;
                     ProcessDelDir(NewPath);
                    End;
             End
        Else Begin
              If (FInfo.Attr And FaVolumeID) <> FaVolumeID
               Then Begin
                     NewPath:=DName+'\'+FInfo.Name;
                     FileSetAttr(NewPath, FaArchive); {$I-} DeleteFile(NewPAth); {$I+} IoResult;
                    End;
             End;

       ErrCode:=FIndNext(FInfo);
      End;
  FindClose(FInfo);

  {$I-} RemoveDir(DName); {$I+}

  IoResult;
 End;

Begin
 StartDir:=Source;
 If Source[Length(Source)] = '\'
  Then SetLength(Source, Length(Source)-1);

 DirCount:=0;
 ProcessDelDir(Source);
End;