Ver Mensaje Individual
  #6  
Antiguo 06-04-2015
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
jbecerra,

Cita:
Empezado por jbecerra
...¿Existe alguna función que permita eliminar una carpeta y todo su contenido?...Ya lo solucione...


Revisa este código:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function DeleteDirectory(const DirectoryName: String) : Boolean;
var
   SR: TSearchRec;
begin
   try
      if FindFirst(DirectoryName + '\*.*', faAnyFile, SR) = 0 then
      repeat
         if (SR.Attr and faDirectory = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then
            DeleteDirectory(IncludeTrailingPathDelimiter(DirectoryName) + SR.Name);

         if (SR.Attr and faArchive = faArchive) then
            DeleteFile(DirectoryName + '\' + SR.Name);
      until FindNext(SR) <> 0;
      RemoveDir(DirectoryName);
      Result := False;
   finally
      FindClose(SR);
      Result := True;
   end;
end;

function RemoveFolder(const FolderName : String) : Boolean;
var
   SI: TSHFileOpStructA;
begin
   with SI do
   begin
      Wnd := HInstance;
      wFunc := FO_DELETE;
      pFrom := PChar(FolderName + #0);
      pTo := nil;
      fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
   end;
   SHFileOperation(SI);
   if not SI.fAnyOperationsAborted then
      Result := True
   else
      Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if DeleteDirectory('C:\TestRemoveFolder1') then
      MessageDlg('Directorio Removido Satisfactoriamente',mtInformation,[mbok],0)
   else
      MessageDlg('Error en Delete de Directorio',mtError,[mbok],0)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   if RemoveFolder('C:\TestRemoveFolder2') then
      MessageDlg('Directorio Removido Satisfactoriamente',mtInformation,[mbok],0)
   else
      MessageDlg('Error en Delete de Directorio',mtError,[mbok],0)
end;

end.
El código anterior en Delphi 7 sobre Windows 7 Professional x32, Permite remover de forma recursiva un directorio del sistema de archivos de Windows por medio de dos funciones distintas pero equivalentes a nivel funcional.

Revisa este código:
Código Delphi [-]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
   DirectoryName : String;

begin

  DirectoryName := 'C:\TestRemoveFolder';

  if DirectoryExists(DirectoryName) then
  begin
     DeleteDirectory(DirectoryName,True);
     RemoveDir(DirectoryName);
     MessageDlg('Directorio Removido',mtInformation,[mbok],0)
  end
  else
     MessageDlg('Directorio No Existe',mtError,[mbok],0)

end;

end.
El código anterior en Lazarus Versión 1.2.6 FPC Version 2.6.4 bajo Windows 7 Professional x32, Permite remover de forma recursiva un directorio del sistema de archivos de Windows.

Te sugiero revisar nuevamente la Guía de estilo de los foros.

¡Gracias por tu cooperación!

Saludos,

Nelson.

Última edición por nlsgarcia fecha: 07-04-2015 a las 16:18:59.
Responder Con Cita