Função para Deletar um diretório inteiro

Autor: Anderson Souza www.souza.orgfree.com
Data: 22/05/2006

A função abaixo deleta um diretório inteiro e seus sub-arquivos e sub-diretórios. O Delphi normalmente só deleta um diretório vazio. Se ocorrer algum problema ao tentar deletar o diretório a função retornará False.


Function DeleteTree(Caminho : String) : Boolean;
var
  ListaDir : TSearchRec;
  I : Integer;
  Vcaminho : String;
  Attributes,
  NewAttributes : Word;
begin
  {$I-}
  I := FindFirst((caminho+ '*.*'), faAnyFile, ListaDir);
  While I = 0 do
  Begin
    If (ListaDir.Name[1]<> '.') and (Trim(ListaDir.Name) <> '') Then
    Begin
      Vcaminho := (caminho + ListaDir.Name);
      If FileExists(Vcaminho) Then
      Begin
        If not DeleteFile(PChar(Vcaminho)) Then
        Begin
          Attributes := FileGetAttr(Vcaminho);
          { read file attributes }
          If (Attributes and faReadOnly) = faReadOnly Then
            NewAttributes := (NewAttributes and not faReadOnly);{if}
            If (Attributes and faSysFile) = faSysFile Then
              NewAttributes := (NewAttributes and not faSysFile);{if}
              If (Attributes and faHidden) = faHidden Then
                NewAttributes := (NewAttributes and not faHidden);{if}
              FileSetAttr(Vcaminho, NewAttributes);
              DeleteFile(PChar(Vcaminho));
        End;{if}
      End Else
      If DirectoryExists(Vcaminho) Then
      Begin
        If not RemoveDir(Vcaminho) Then
        Begin
          Attributes := FileGetAttr(Vcaminho);
          { read file attributes }
          If (Attributes and faReadOnly) = faReadOnly Then
            NewAttributes := (NewAttributes and not faReadOnly);{if}
          If (Attributes and faSysFile) = faSysFile Then
            NewAttributes := (NewAttributes and not faSysFile);{if}
          If (Attributes and faHidden) = faHidden Then
            NewAttributes := (NewAttributes and not faHidden);{if}
          FileSetAttr(Vcaminho, NewAttributes);
          If not RemoveDir(Vcaminho) Then
            DeleteTree((Vcaminho+'\'));{if}
{ depois de processar novamente a funcão ela tenta remover a pasta, agora supostamente vazia. }
          RMDir(Vcaminho);
        End;{if}
      End;{if}
    End;{if}
    I := FindNext(ListaDir);
  End;{do}
  Result := RemoveDir(caminho);
  {$I+}
end;{function}