cursomecanet.com

En esta sección de Código fuente en Delphi vamos a mostrar cómo podemos borrar una carpeta con todos los archivos y subcarpetas que tenga dentro.

Para ello, he escrito esta pequeña app de ejemplo

Existen básicamente dos aproximaciones diferentes para realizar esta tarea:

• Una que es decirle a Windows que haga él todo el trabajo. Esta es la mejor opción si es que podemos usarla.
• Y otra que es hacer nosotros todo el trabajo, si no podemos usar el método anterior.

Para mostrar las dos formas de eliminar un árbol de carpetas he escrito las dos funciones "DelTreeShell" y "DelTree"

La función "DelTreeShell" es la mejor, por ser la más corta en términos de cantidad de código que tenemos que escribir, y para poder usarla tenemos que incluir en nuestra clausula "Uses" el archivo ShellApi

La función "DelTreeShell" hace uso de la funció "SHFileOperation" que es la navaja suiza de la ShellAPI para todas las operaciones que tengan que ver con archivos o carpetas (copiar, mover, borrar, renombrar...)

Para aquellos que no puedan o no quieran usar la ShellApi (por la versión de Windows, por la versión del compilador de Delphi o porque simplemente le guste hacer manualmente las cosas) tenenos la función "DelTree" que es válida para cualquier versión de Windows y de Delphi

La API de Windows nos ofrece la función "DeleteFile(s: string)" para borrar un archivo y la función "RemoveDir(s: string)" para borrar una carpeta que previamente debe estar vacía. Estas son las dos funciones que utiliza "DelTree" junto con un procedimiento para recorrer todos los archivos de una carpeta.

El procedimiento para recorrer todos los archivos de una determinada carpeta se consigue usando las funciones "FindFirst" "FindNext" y "FindClose" pero no basta con esto, para que este procedimiento también recorra todas las subcarpetas de la carpeta dada, éste deber ser "recursivo", es decir, se debe llamar a sí mismo para cada una de las subcarpetas de la carpeta original (las subcarpetas también son archivos con pero con el atributo faDirectory).

En cualquier caso, se debe tener MUCHO CUIDADO al usar cualquiera de estas dos funciones en nuestro código, puede ser como una bomba nuclear si se usa en la carpeta equivocada y sin el consentimiento del usuario. El conocimiento es el poder, y simpre se debe usar con fines constructivos, y NO destructivos.

En la siguiente imagen puedes ver un ejemplo de uso de esta app.

A continuación, puedes ver el código completo de la app, y si lo deseas puedes descargarlo todo (código y app) en un archivo "zip".

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, Outline, DirOutln, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    DirectoryOutline1: TDirectoryOutline;
    Button1: TButton;
    Label1: TLabel;
    DriveComboBox1: TDriveComboBox;
    procedure DirectoryOutline1Change(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


uses shellapi;


{

fFlags
Type: FILEOP_FLAGS

Flags that control the file operation.
This member can take a combination of the following flags.

FOF_ALLOWUNDO

Preserve undo information, if possible.


FOF_FILESONLY

Perform the operation only on files (not on folders)
if a wildcard file name (*.*) is specified.


FOF_NOCONFIRMATION

Respond with Yes to All for any dialog box that is displayed.


FOF_NOERRORUI

Do not display a dialog to the user if an error occurs.


FOF_NORECURSION

Only perform the operation in the local directory.
Do not operate recursively into subdirectories, which is the default behavior.

FOF_NO_UI

Windows Vista. Perform the operation silently, presenting no UI to the user.
TEquivalent to
    FOF_SILENT | FOF_NOCONFIRMATION | FOF_NOERRORUI | FOF_NOCONFIRMMKDIR.


FOF_SILENT

Do not display a progress dialog box.


FOF_SIMPLEPROGRESS

Display a progress dialog box
but do not show individual file names as they are operated on.


FOF_WANTNUKEWARNING

Send a warning if a file is being permanently destroyed
during a delete operation rather than recycled.
This flag partially overrides FOF_NOCONFIRMATION.

}

function DelTreeShell(Dir: string): boolean;
var
  ShOp: TSHFileOpStruct;
begin
  FillChar(ShOp, SizeOf(ShOp), 0);
  ShOp.Wnd := Form1.Handle;
  ShOp.wFunc := FO_DELETE;
  ShOp.pFrom := PChar(ExcludeTrailingPathDelimiter(Dir) + #0);
  ShOp.fFlags := FOF_ALLOWUNDO or FOF_SIMPLEPROGRESS;
  //ShOp.fFlags := FOF_NO_UI;
  result := SHFileOperation(ShOp) = 0;
end;


function DelTree(Dir: string): boolean;
var
  FileSearch: TSearchRec;
begin
  result := false;

  if Dir[length(Dir)] <> '\' then Dir := Dir + '\';

  if FindFirst(Dir + '*.*', faAnyFile, FileSearch) = 0 then
    repeat
      if ((FileSearch.Attr and fadirectory) = fadirectory) then
      begin
        if (FileSearch.Name <> '.') and (FileSearch.Name <> '..') then
          DelTree(Dir + FileSearch.Name);
      end
      else
      begin
        DeleteFile(Dir + FileSearch.name);
      end;
    until FindNext(FileSearch) <> 0;
  FindClose(FileSearch);

  sleep(100);
  result := RemoveDir(Dir);

end;


procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
  DirectoryOutline1.Drive := DriveComboBox1.Drive;
end;


procedure TForm1.DirectoryOutline1Change(Sender: TObject);
begin
  label1.Caption := DirectoryOutline1.Directory;
end;



procedure TForm1.Button1Click(Sender: TObject);
const
  PrimerAviso = '¿Está seguro que quiere borrar la carpeta seleccionada y todo su contenido?';
var
  carpeta, SegundoAviso: string;
begin
  carpeta := label1.Caption;
  SegundoAviso := 'REPITO!!!'#13#13'Se va a eliminar la carpeta:'#13'"' +
    carpeta +
    '"'#13' y todo lo que tenga dentro.'#13#13' ¿Está seguro?';



  if messagedlg(PrimerAviso, mtConfirmation, mbYesNo, 0) = mrYES then
    if messagedlg(SegundoAviso, mtConfirmation, mbYesNo, 0) = mrYES then
    begin
      DirectoryOutLine1.Items[DirectoryOutLine1.SelectedItem].Destroy;
      Application.ProcessMessages;
      if DelTreeShell(carpeta) then begin
        ShowMessage('Carpeta eliminada');
      end else
        ShowMessage('No se ha podido borrar por completo la carpeta');
    end;

end;


end.