Como deletar uma pasta com arquivos e subpastas dentro

procedure DeletaDir(const RootDir:string);
var
SearchRec: tSearchREC;
Erc:Integer;
Begin
try
{$I-}
ChDir(rootdir);
if IOResult <> 0 then
Exit;
FindFirst('*.*', faAnyFile, SearchRec);
Erc:=0;
while Erc=0 do
begin
if ((searchRec.Name <> '.') and (searchrec.Name<>'..')) then
if (SearchRec.Attr and faDirectory>0) then
DeletaDir(SearchRec.Name)
Else DeleteFile(Searchrec.Name);
Erc:=FindNext ( SearchRec);
Application.ProcessMessages;
end;
finally
If Length (RootDir)>3 then
Chdir('..');
end;
RmDir(rootDir);
{$I+}
End;