Busqueda de archivos especificos

[[nlsgarcia]]

gdlrinfo,

Empezado por gdlrinfo

...quiero copiar de un árbol de directorios (Osea muchas carpetas) unos archivos *RTF...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

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

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

  TCopyFiles = class(TThread)
  private
    DirSource, DirTarget, FileMask : String;
    FrmCopy : TForm;
    MsgApp : String;
    IFile,FFile : LongWord;
  protected
    procedure Execute; override;
    procedure CopyFiles(DirSource, DirTarget, FileMask : String);
    procedure MsgCopy;
    procedure MsgEnd;
  end;

var
  Form1: TForm1;
  CopyFiles : TCopyFiles;
  CopyFilesThread : THandle = 0;

implementation

{$R *.dfm}

// Ejecuta hilo de copia de archivos
procedure TCopyFiles.Execute;
begin
   FreeOnTerminate := True;
   CopyFiles(DirSource, DirTarget, FileMask);
   Synchronize(MsgEnd);
end;

// Copia archivos de directorio fuente a destino de forma recursiva
procedure TCopyFiles.CopyFiles(DirSource, DirTarget, FileMask : String);
var
   SR : TSearchRec;
   FileList : TFileListBox;
   i, CountFile : Integer;
   FromFileName, ToFileName : String;
   AuxFileName, AuxFileExt : String;

begin

   DirSource := IncludeTrailingPathDelimiter(DirSource);
   DirTarget := IncludeTrailingPathDelimiter(DirTarget);

   if (not DirectoryExists(DirSource)) or (not DirectoryExists(DirTarget)) then
      Exit;

   FileList := TFileListBox.Create(nil);
   FileList.Visible := False;
   FileList.Parent := FrmCopy;
   FileList.Mask := FileMask;
   FileList.Directory := DirSource;

   for i := 0 to FileList.Count - 1 do
   begin

      FromFileName := DirSource + FileList.Items.Strings[i];
      ToFileName := DirTarget + FileList.Items.Strings[i];

      CountFile := 0;

      while True do
      begin
         if FileExists(ToFileName) then
         begin
            Inc(CountFile);
            AuxFileName := ExtractFileName(ChangeFileExt(FromFileName,''));
            AuxFileExt := ExtractFileExt(FromFileName);
            ToFileName := ExtractFilePath(ToFileName)
                          + AuxFileName
                          + '_' + IntToStr(CountFile)
                          + AuxFileExt;
         end
         else
            Break;
      end;

      IFile := i + 1;
      FFile := FileList.Count;
      Synchronize(MsgCopy);
      Copyfile(PChar(FromFileName),PChar(ToFileName),False);

   end;

   FileList.Free;

   if FindFirst(DirSource + '*.*', faAnyFile, SR) = 0 then
   repeat
      if ((SR.Attr and fadirectory) = fadirectory) then
      begin
         if(SR.Name <> '.') and (SR.Name <> '..') then
            CopyFiles(DirSource + SR.Name, DirTarget, FileMask);
      end
   until FindNext(SR) <> 0;

   FindClose(SR);

end;

// Muestra mensaje de progreso de copia de archivos
procedure TCopyFiles.MsgCopy;
begin
   Form1.Caption := Format('Copiando %d de %d',[IFile, FFile]);
end;

// Muestra mensaje de finalización de copia de archivos
procedure TCopyFiles.MsgEnd;
begin
   Form1.Caption := 'CopyFiles';
   MsgApp := Format('Copia de Archivos %s del Folder %s al Folder %s Completada',
                    [FileMask, DirSource,DirTarget]);
   Beep;
   MessageDlg(MsgApp, mtInformation, [mbOK], 0);
   CopyFilesThread := 0;
end;

// Inicia un proceso de copia recursiva de archivos desde el directorio fuente al destino
procedure TForm1.Button1Click(Sender: TObject);
var
   MsgApp : String;
   DirSource, DirTarget : String;

begin

   DirSource := 'C:\FolderSource';
   DirTarget := 'C:\FolderTarget';

   if (CopyFilesThread = 0) then
   begin

      if (not DirectoryExists(DirSource)) or (not DirectoryExists(DirTarget)) then
      begin
         MsgApp := 'Error de I/O en Directorio Fuente o Destino';
         Beep;
         MessageDlg(MsgApp,mtInformation,[mbOK],0);
         Exit;
      end;

      CopyFiles := TCopyFiles.Create(True);
      CopyFiles.DirSource := DirSource;
      CopyFiles.DirTarget := DirTarget;
      CopyFiles.FileMask := '*.rtf';
      CopyFiles.FrmCopy := Self;
      CopyFiles.Resume;
      CopyFilesThread := CopyFiles.Handle;

   end;

end;

end.

El código anterior en Delphi 7 bajo Windows 7 Professional x32, copia de forma recursiva todos los archivos de un directorio y subdirectorios fuente a un directorio destino en función de una mascara de archivo.

Nota:

1- La copia de archivos se hace por medio de un hilo, lo cual permite que la aplicación no se bloque durante el proceso.

2- En el caso de haber archivos en el directorio y subdirectorios fuente con el mismo nombre, estos se copiaran al directorio destino con el mismo nombre más un prefijo (_Número), que indica la cantidad de veces que el archivo se repite, ejemplo: File.txt, File_1.txt, File_2, ... , File_N.txt

3- En el ejemplo, solo puede estar un hilo de copia activo a la vez, esto se puede modificar fácilmente para tener varios procesos de copia activos según se requiera.

4- Por simplicidad de código, solo se incluyo como referencia visual un contador del archivo que esta siendo copiado de un directorio fuente en un momento determinado.

Espero sea útil

Nelson.