Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 05-11-2012
Avatar de lbidi
lbidi lbidi is offline
Miembro
 
Registrado: oct 2003
Ubicación: Montevideo- URUGUAY
Posts: 417
Poder: 21
lbidi Va por buen camino
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
Responder Con Cita
  #2  
Antiguo 06-11-2012
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
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.

Última edición por nlsgarcia fecha: 06-11-2012 a las 08:03:54.
Responder Con Cita
  #3  
Antiguo 06-11-2012
Avatar de lbidi
lbidi lbidi is offline
Miembro
 
Registrado: oct 2003
Ubicación: Montevideo- URUGUAY
Posts: 417
Poder: 21
lbidi Va por buen camino
Muchas gracias nlsgarcia.

Funciono perfecto.

y si.. la premisa eran archivos mayores a 30 dias.. .
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
como borrar una carpeta con todos los archivos que contiene. danyfebrero Varios 2 25-08-2012 20:18:22
Como borrar los archivos de la carpeta Windows\Temp\ JoAnCa Varios 4 02-02-2011 16:44:55
Borrar archivos dentro de carpeta ØnLy Varios 1 23-11-2010 06:36:55
SelectedRows esta vacia Paulao Varios 2 12-03-2009 10:26:07
borrar archivos d un directorio\subdirectorios segun su extension. No me funciona :( images API de Windows 5 11-06-2007 23:14:30


La franja horaria es GMT +2. Ahora son las 14:56:19.


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
Copyright 1996-2007 Club Delphi