Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Borrar archivos segun fecha y la carpeta si esta vacia (https://www.clubdelphi.com/foros/showthread.php?t=81339)

lbidi 05-11-2012 21:07:37

Borrar archivos segun fecha y la carpeta si esta vacia
 
Estimados foristas.

Deseo recorrer una carpeta y sus subcarpetas buscando archivos que sean menores a 30 dias a la fecha
y si es asi, borrarlos. A su vez, si la carpeta queda vacia, tambien borrarla.

He tomado el siguiente codigo de varios posts pero no he logrado el objetivo. En algun punto creo
que queda en loop infinito o no me borra ni los archivos ni las carpetas.

Código Delphi [-]
var
    sRuta : string;
    bIncluirSubdirectorios : Boolean;

//_________________________________________________
function GetFileDateTime(Nombre: string): TDateTime;
var
Hnd: integer;
begin
    Hnd := FileOpen(Nombre, 0);
    try
      Result:= FileDateToDateTime(FileGetDate(Hnd));
    finally
      FileClose(Hnd);
    end;
end;

//_____________________________________________________________
procedure RecorrerDirectorio( sRuta: String; bIncluirSubdirectorios: Boolean );
var
   cDir, Directorio : TSearchRec;
   iResultado : Integer;
   dt: TDateTime;

begin

    // Si la ruta no termina en contrabarra se la ponemos
    if sRuta[Length(sRuta)] <> '\' then
        sRuta := sRuta + '\';

    iResultado := FindFirst( sRuta + '*.*', FaAnyfile, Directorio );
    while iResultado = 0 do
    begin
        // ¿Es un directorio y hay que entrar en él?
        if ( Directorio.Attr and faDirectory = faDirectory ) and bIncluirSubdirectorios then
        begin
        if ( Directorio.Name <> '.' ) and ( Directorio.Name <> '..' ) then
            RecorrerDirectorio( sRuta + Directorio.Name, True );
        end
        else
        begin
          // ¿No es el nombre de una unidad ni un directorio?
            if ( Directorio.Attr and faVolumeId <> faVolumeID ) then
            begin
              dt := GetFileDateTime( sRuta + Directorio.Name);
              if DaysBetween(dt, Now) > 30 then
                  DeleteFile( sRuta + Directorio.Name );
              if FindFirst( Directorio.Name + '*.*', FaAnyfile, cDir ) = 0 then
                 RemoveDir( sRuta + Directorio.Name );
            end;
        end;

        iResultado := FindNext( Directorio );

    end;

    SysUtils.FindClose( Directorio );

end;

begin
    sRuta := 'T:\VIDEOS';
    bIncluirSubdirectorios := True;
    RecorrerDirectorio( sRuta, True );
end.

Agradezco mucho la ayuda prestada en resolver este "misterio" ( al menos para mi ;) ).

Saludos

Leonardo

nlsgarcia 06-11-2012 07:54:40

Leonardo,

Revisa este código el cual es una variante funcional del anterior:
Código Delphi [-]
unit Unit1;

interface

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

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

  procedure RecorrerDirectorio( sRuta: String; bIncluirSubdirectorios: Boolean );

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Borra recursivamente en una ruta los archivos mayores a 30 días y/o directorios vacíos.
procedure RecorrerDirectorio( sRuta: String; bIncluirSubdirectorios: Boolean);
var
   cDir, Directorio : TSearchRec; // Crea las estructuras de busqueda de directorio
   iResultado : Integer;
   dt: TDateTime;

begin

    // Adiciona un slash si es necesario al final de la ruta
    sRuta := IncludeTrailingPathDelimiter(sRuta);

    // Inicia la lectura de archivos y directorios de la ruta dada
    iResultado := FindFirst(sRuta + '*.*', FaAnyfile, Directorio);

    while iResultado = 0 do
    begin
       // Determina si es un directorio y si de debe procesar
       if (Directorio.Attr and faDirectory = faDirectory) and bIncluirSubdirectorios then
       begin
          // Determina si es un directorio válido para procesar
          if (Directorio.Name <> '.') and (Directorio.Name <> '..') then
          begin
             // Realiza una busqueda recursiva de directorios
             RecorrerDirectorio(sRuta + Directorio.Name, True);
             // Determina si el último directorio procesado es valido para ser borrado
             if FindFirst(sRuta + Directorio.Name + '\' + '*.*', FaArchive, cDir) <> 0 then
             begin
                // Borra el último directorio procesado si no tiene ningun subdirectorio o archivo válido
                RemoveDir(sRuta + Directorio.Name);
                // Finaliza la lectura del último directorio procesado
                FindClose(cDir);
             end
          end
          else
          begin
             // Lee el siguiente elemento del directorio en proceso
             iResultado := FindNext(Directorio);
             continue;
          end;
       end;

       // Determina si es un archivo válido para procesar
       if (Directorio.Attr and faArchive = faArchive) then
       begin
          // Determina la fecha del archivo
          dt := FileDateToDateTime(FileAge(sRuta + Directorio.Name));
          // Borra el archivo solo si su fecha es mayor a 30 dias
          if DaysBetween(dt, Now) > 30 then
             DeleteFile( sRuta + Directorio.Name );
       end;

       // Lee el siguiente elemento del directorio en proceso
       iResultado := FindNext(Directorio);
    end;

    // Finaliza la lectura del directorio en proceso
    FindClose( Directorio );

end;

procedure TForm1.Button1Click(Sender: TObject);
var
   sRuta : String;
begin
   // Asigna un directorio de pruebas de borrado
   sRuta := 'D:\xPrueba_De_Borrado';
   // Inicia rutina de borrado de archivos y directorios válidos
   RecorrerDirectorio(sRuta, True);
end;

end.
El código anterior fue probado en varios escenarios, con resultados favorables en todos los casos según el criterio establecido: Borrar los archivos mayores a 30 días y/o los directorios vacíos.

Nota: Por el código inicial asumí que lo correcto es el borrado de los archivos mayores a 30 días, no menores a 30 días como dice el enunciado del problema, en cualquier caso se puede cambiar si es necesario sin afectar el código.

Espero sea útil :)

Nelson.

lbidi 06-11-2012 13:11:21

Muchas gracias nlsgarcia.

Funciono perfecto.

y si.. la premisa eran archivos mayores a 30 dias.. :).


La franja horaria es GMT +2. Ahora son las 15:37:28.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi