Busqueda de archivos especificos

[gdlrinfo]

Hola amigos:

Tengo un problema al copiar unos archivos yo simplemente quiero copiar de un árbol de directorios (Osea muchas carpetas) unos archivos *RTF que se almacenan ahí, pero no quiero que me copie los directorios en buscado muchos procedimiento en los foros pero no consigo ninguno que lo pueda hacer si alguien me puede dar una mano estaría agradecido desde ya muchas gracias !!!!

[ecfisa]

Hola gdlrinfo.

Fijate si te sirve de este modo:

...

uses ShellApi;

(* Obtiene archivos de determinada extensión en carpeta y subcarpetas *)
procedure FindFilesByExt(Folder, Ext:AnsiString; Files: TStrings);
var
SR: TSearchRec;
Found: Boolean;
begin
// buscar primero
if FindFirst(Folder + '*.*', $FF, SR) = 0 then
repeat
// Found = verdadero si coincide la extensión
Found:= Pos(UpperCase(Ext), UpperCase(SR.Name)) <> 0;
if ((SR.Attr and fadirectory) = fadirectory) then // attr = carpeta ?
begin
if(SR.Name <> '.') and (SR.Name <> '..') then // ¿ es . ó .. ?
FindFilesByExt(Folder + SR.Name, Ext, Files) // recursar
end
else if Found then // es un archivo, ¿ coincide la extension ?
Files.Add(Folder + SR.Name); // si, agregarlo
until FindNext(SR) <> 0;
FindClose(SR);
end;

(* Copia todos los archivos de determinada extension *)
procedure CopyFilesWithoutDir(Source, Target, Ext: AnsiString);
const
INVALID_FILE_ATTRIBUTES = Cardinal($FFFFFFFF);
var
TS : TStrings;
i : Integer;
SHFOS: SHFILEOPSTRUCT;
begin
// asegurar que las carpetas terminen en delim '\'
Source:= IncludeTrailingPathDelimiter(Source);
Target:= IncludeTrailingPathDelimiter(Target);
// verificar existencia carpeta orígen
if (GetFileAttributesA(PChar(Source)) = INVALID_FILE_ATTRIBUTES) then
raise Exception.Create('Carpeta origen inválida');
// verificar existencia carpeta destino
if (GetFileAttributesA(PChar(Target)) = INVALID_FILE_ATTRIBUTES) then
raise Exception.Create('Carpeta destino inválida');
// comenzar la copia
TS:= TStringList.Create;
try
// obtener archivos a copiar
FindFilesByExt(Source, Ext, TS);
// si se encontraron archivos, comenzar copia
if TS.Count > 1 then
for i:= 0 to TS.Count-1 do
begin
ZeroMemory(@SHFOS, SizeOf(SHFOS));
SHFOS.Wnd:= Application.Handle;
SHFOS.wFunc:= FO_COPY;
SHFOS.hNameMappings:= nil;
SHFOS.pFrom:= PChar(TS[i]+#0+#0);
SHFOS.pTo:= PChar(Target+#0+#0);
SHFileOperation(SHFOS);
end;
finally
TS.Free;
end;
end;


Llamada de ejemplo:

procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor:= crHourGlass;// Cursor de espera
try
CopyFilesWithoutDir('C:\Users\usr\Documents', 'C:\temp\', '.odt');
finally
Screen.Cursor:= crDefault; // cursor normal
MessageBox(0, 'Copia finalizada', '', MB_ICONINFORMATION);
end;
end;


Saludos :)

[nlsgarcia]

gdlrinfo,


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

:rolleyes:

Revisa este código:

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;
ToFileName := DirTarget + FileList.Items.Strings;

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, [I]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, [I]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.

[gdlrinfo]

Hola muchísimas gracias por responder en primer lugar te cuento ecfisa que el código que me pasaste me da error de compatibilidad de tipos en las líneas que contienen if (GetFileAttributesA(PChar(Source)) = INVALID_FILE_ATTRIBUTES) then
el error es [dcc32 Error] Pagos.pas(85): E2010 Incompatible types: 'PAnsiChar' and 'PWideChar' ////
Eso por una parte por la otra nlsgarcia la verdad me funciona lo que me pasaste pero si tocas la pantalla o haces algo mientras copia se tilda la verdad tendría que mirar a ver que pasa pero la copia lo hace bien una pregunta!!! Es posible que mientras copia al directorio de destino le cambie la extencion *.rtf por *.doc desde ya muchas gracias por todo !!!!

[nlsgarcia]

gdlrinfo,


...si tocas la pantalla o haces algo mientras copia se tilda...

Pregunto : ¿Que significa se tilda? :confused:

Nelson.

[gdlrinfo]

Significa que se congela deja de tabajar no funciona mas jajajaj y da un error ---> list index out of bounds (4) y no sigue procesando gracias

[nlsgarcia]

gdlrinfo,


...Significa que se congela...y da un error ---> list index out of bounds (4)....

:confused:

Te comento que en las pruebas realizadas, el código del Msg #3 funciono según lo esperado, sin importar si se mueve o pulsa el formulario :rolleyes:

Voy a hacer unas modificaciones al código, que incluyan el cambio de extensión a los archivos copiados y en lo que este disponible lo publico.

Espero sea útil :)

Nelson.

[gdlrinfo]

Te agradezco muchísimo tu ayudaaaaa espero entonces tu modificación y desde ya sinceramente muchísimas gracias !!!!! Saludos !!!!!

[ecfisa]

Hola muchísimas gracias por responder en primer lugar te cuento ecfisa que el código que me pasaste me da error de compatibilidad de tipos en las líneas que contienen if (GetFileAttributesA(PChar(Source)) = INVALID_FILE_ATTRIBUTES) then
el error es [dcc32 Error] Pagos.pas(85): E2010 Incompatible types: 'PAnsiChar' and 'PWideChar' ////

Hola gdIrinfo.

No puedo afirmarlo por que veo que usas una versión de Delphi mas avanzada que la mía, pero intenta de este modo:

if GetFileAttributesA(PAnsiChar(Source)) = INVALID_FILE_ATTRIBUTES then
//...
if GetFileAttributesA(PAnsiChar(Target)) = INVALID_FILE_ATTRIBUTES then


Saludos :)

[nlsgarcia]

gdlrinfo,


...si tocas la pantalla o haces algo mientras copia se tilda (Bloquea)...


...Es posible que mientras copia al directorio de destino le cambie la extensión *.rtf por *.doc...


...Voy a hacer unas modificaciones al código, que incluyan el cambio de extensión a los archivos copiados y en lo que este disponible lo publico...

:rolleyes:

Revisa este código:

unit Unit1;

interface

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

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

TCopyFiles = class(TThread)
private
DirSource, DirTarget, FileExt, FileExtNew : String;
MsgApp : String;
IFile,FFile : LongWord;
protected
procedure SearchFiles(DirSource, DirTarget, FileExt : String; var FileList : TStringList);
procedure Execute; override;
procedure MsgCopy;
procedure MsgEnd;
end;

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

implementation

{$R *.dfm}

// Selecciona los archivos a ser copiados del directorio fuente al destino de forma recursiva
procedure TCopyFiles.SearchFiles(DirSource, DirTarget, FileExt : String; var FileList : TStringList);
var
SR : TSearchRec;

begin

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

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

if FindFirst(DirSource + '*.*', faAnyFile, SR) = 0 then
repeat
if ((SR.Attr and fadirectory) = fadirectory) then
begin
if(SR.Name <> '.') and (SR.Name <> '..') then
SearchFiles(DirSource + SR.Name, DirTarget, FileExt, FileList);
end
else
begin
if FileExt = EmptyStr then
FileList.Add(DirSource + SR.Name)
else
if LowerCase(ExtractFileExt(SR.Name)) = LowerCase(FileExt) then
FileList.Add(DirSource + SR.Name);
end;
until FindNext(SR) <> 0;

FindClose(SR);

end;

// Ejecuta el hilo de copia de archivos
procedure TCopyFiles.Execute;
var
FileList : TStringList;
i : Integer;
FromFileName, ToFileName : String;
AuxFileName, AuxFileExt : String;
CountFile : Integer;

begin

FreeOnTerminate := True;

FileList := TStringList.Create;

SearchFiles(DirSource, DirTarget, FileExt, FileList);

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

FromFileName := FileList.Strings;

if FileExtNew <> EmptyStr then
ToFileName := IncludeTrailingPathDelimiter(DirTarget)
+ ChangeFileExt(ExtractFileName(FileList.Strings),FileExtNew)
else
ToFileName := IncludeTrailingPathDelimiter(DirTarget) + ExtractFileName(FileList.Strings);

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;

Synchronize(MsgEnd);

end;

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

// Muestra un mensaje de finalización de copia de archivos
procedure TCopyFiles.MsgEnd;
begin
Form1.Caption := 'CopyFiles';
MsgApp := Format('Copia Recursiva de Archivos *%s del Folder %s al Folder %s Completada',
[FileExt, 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, FileExt, FileExtNew : String;

begin

DirSource := 'D:\HostDownload';
DirTarget := 'D:\TestNelson';
FileExt := '.rtf';
FileExtNew := '.doc';

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.FileExt := FileExt; // CopyFiles.FileExt := '' copia todos los archivos
CopyFiles.FileExtNew := FileExtNew; // CopyFiles.FileExtNew := '' no cambia la extensión
CopyFiles.Resume;
CopyFilesThread := CopyFiles.Handle;

end
else
begin
MsgApp := 'Hay un Proceso de Copia Activo, Favor Esperar que Finalize';
Beep;
MessageDlg(MsgApp,mtInformation,[mbOK],0);
Exit;
end;

end;

end.

El código anterior en Delphi 7 bajo Windows 7 Professional x32, es la versión 2 del código propuesto en el Msg #3 el cual permite: [I]copiar de forma recursiva todos los archivos de un directorio y subdirectorios fuente a un directorio destino en función de una mascara de copia.

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, [I]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, [I]solo se incluyo como referencia visual un contador de copia (Copiado XX de YY), que indica el archivo que esta siendo copiado en un momento determinado al directorio destino.

5- Se elimino el uso del componente TFileListBox, mejorando la velocidad de copia y eliminado potenciales problemas de Not Thread Safe.

6- Si no se especifica la extensión de los archivos a copiar (TCopyFiles.FileExt), se copiaran todos los archivos recursivamente del directorio fuente al destino.

7- Si se especifica una nueva extensión (TCopyFiles.FileExtNew), se copiaran todos los archivos recursivamente del directorio fuente al destino con la nueva extensión.

Espero sea útil :)

Nelson.

[gdlrinfo]

Amigoo eres un genio funciona de maravillas muchísimas gracias!!!!!

[gdlrinfo]

Buenas nlsgarcia como estas quisiera hacerte una consulta, en la búsqueda cuando copio hay algunos archivos que tienen unas siglas que no me interesa copiar, esos archivos son puntuales por ejemplo 4878-rib-jij.rft --> este tiene la sigla RIB y no me interesa copiarlo, el tema es que estuve pensando como evitar copiarlo y lo único que se me ocurre es que a medida que va buscando lo archivos lee una el nombre repasándolo como una cadena de texto y compare, si existe la palabra rib o cam o cac, que son las que no tengo que copiar, pero me da la sensación que se haría extremadamente lento el copiado, crees que puede haber otra forma de hacerlo ? desde ya muchas gracias como siempre !!!!!

[nlsgarcia]

gdlrinfo,


...en la búsqueda cuando copio...hay algunos archivos que tienen unas siglas que no me interesa copiar...esos archivos son puntuales...se me ocurre es que a medida que va buscando lo archivos...compare...si existe la palabra...pero me da la sensación que se haría extremadamente lento el copiado...¿Crees que puede haber otra forma de hacerlo?...

:rolleyes:

Pregunto:

1- ¿En que tipo de aplicación esta instalada esta rutina?, ¿Cual es el objetivo de la aplicación?.

2- ¿La aplicación en cuestión es de índole comercial o académica?, ¿En que país es utilizada?.

3- ¿Cual es el promedio de archivos copiados normalmente?, ¿Cual es la frecuencia de uso de la aplicación?.

4- ¿Cual es el tamaño promedio de los archivos a copiar?, ¿Cual es el tiempo promedio de copia de todos los archivos?.

5- La máquina donde se ejecuta la aplicación ¿Es Servidor o Standalone?, ¿Cuales son las características técnicas de la máquina en cuestión a nivel de Procesador, Disco y Memoria?.

6- Si se discrimina los archivos a ser copiados, ¿Cuantas siglas a excluir de la copia deberían ser consideradas?.

Espero sea útil :)

Nelson.

[mamcx]

el tema es que estuve pensando como evitar copiarlo y lo único que se me ocurre es que a medida que va buscando lo archivos lee una el nombre repasándolo como una cadena de texto y compare .... pero me da la sensación que se haría extremadamente lento el copiado

En vez de "sensaciones" haz la prueba, mide y compara. NUNCA hagas cambios de desempeño basados en sensaciones, suposiciones y demas, y menos implementes las sensaciones que otros tienen de tus sensaciones!. Siempre se debe hacer profiling (https://es.wikipedia.org/wiki/An%C3%A1lisis_de_rendimiento_de_software). Osea, porque supones que va a ser lento? Y si te *parece*, sabes realmente que es *rapido*?.

Por ejemplo, si no sabes a que tasa de MB/s se puede saturar el disco, no sabes si lo que haces es o no rapido. Una vez que sabes cual es el techo de desempeño, puedes realmenten empezar a tomar decisiones.

En especial, porque la mayor parte del tiempo las rutinas/subsistemas que uses son ya suficientemente rapidos y el problema esta principalmente en la eleccion de las estructuras de datos y algoritmos globales (no locales).

Con respecto a tu pregunta:

En vez de filtrar lo "invalido", filtro lo *valido*. Como sabes que algo es el dato correcto? Chequea contra eso y no al revez (lo invalido tiene una tendencia hacia el infinito!)

Puede ser con una mascara, una expresion regular o contra una BD en memoria (quizas usando un hashtable). Ya que el I/O (todo lo que sea manejo de archivos, sockets, BD, etc) tiende a ser lo mas lento, veraz que lo que sea que hagas en codigo tiene un impacto minimo.

[gdlrinfo]

Que tal Nelson:

En cuanto a tus preguntas la primera:

1.- El objetivo del programa es hacer una copia de archivos guardados de un disco a otro no es gran cosa pero si están en varias carpetas y esto antes se hacia a mano simplemente es por simplificar trabajo que nos hacia perder mucho tiempo nada mas .

2.- La aplicación la uso para tareas personales y se usa en argentina. (repito lo anterior solo es para facilitar algunos procesos que a mano son engorrosos)

3.- los archivos promedio son 6.000 a 10.000 la frecuencia es 3 veces a la semana.

4.- los archivos son solo RTF que pesan al rededor de 1mb cada uno, todos los archivos los esta copiando en un promedio de 7 minutos si son al rededor de 10.000 sino no dura mas de 5 minutos..

5.- La maquina donde de ejecutan son varias y casi todas tienen las mismas prestaciones la mayoría tiene 6gb de ram, micro de 6 núcleos, y discos de 1tb.

6.- si discriminamos hay 5 tipos que no copiaría por ejemplo (rib- cac - cam - rgi - rg) estas, están en el nombre del archivo es decir los archivos que tienen estas siglas no hay que copiarlos por ejemplo un nombre seria algo asi CCO-P-10015-RIB-1880810.RTF ---> este casualmente no es necesario copiarlo.

Gracias por tu interés y te agradezco!!! un abrazo

[gdlrinfo]

Hola mamcx:

Por lo que dices he probado hacer el proceso de leer la cadena de texto del nombre y es 5 veces mas lento el copiado, quizás a veces no hay que probar algo para saber que no iva a andar, hay cosas que están a la vista.

Tampoco podemos hacer una relación de saturación del disco en copia de MB/s cuando los archivos no pasan mas de 1mb cada uno no es un manejo de volumen en MB importante sino en cantidad de archivos, que no es lo mismo copiar 6.000 archivos de 1 MB que copiar 6.000 de 400 MB en relación no es comparable.

Simplemente contesto a lo que me preguntas porque me parece que hay cosas que son comparables solo cuando son significativas y requieren realmente un análisis especifico, pero si hablamos de copiar un simple puñado de archivos y lee nombre de cada uno no va a ser lo mismo si no los lee obviamente tardara mas, quizás no logre expresarme para que pudieras comprenderlo un saludo !!!

[nlsgarcia]

gdlrinfo,


...si discriminamos hay 5 tipos que no copiaría...

:rolleyes:

Voy a hacer una nueva versión que te permita discriminar los archivos que no quieras copiar, en lo que la tenga disponible la publico :D

Saludos,

Nelson.

[ecfisa]

Hola gdIrinfo

Ayer pude comprobar que del modo que te sugerí en el mensaje #9 (http://www.clubdelphi.com/foros/showpost.php?p=480956&postcount=9), funciona correctamente en Delphi XE.


...este tiene la sigla RIB y no me interesa copiarlo, el tema es que estuve pensando como evitar copiarlo y lo único que se me ocurre es que a medida que va buscando lo archivos lee una el nombre repasándolo como una cadena de texto y compare, si existe la palabra rib o cam o cac, que son las que no tengo que copiar, pero me da la sensación que se haría extremadamente lento el copiado, crees que puede haber otra forma de hacerlo ?

Lo que solicitas ahora requiere el análisis del nombre del archivo, no hay otro modo de hacerlo que revisar si los monemas a excluir se encuentran en el nombre del archivo. Y si... claro, esa verificación inflinge un retardo en el proceso aunque en el contexto de la copia no es el principal actor. El copiado de archivos es una operación lenta per se, como lo es cualquier acción que requiera accesos a disco.

Sumando que comentas que son muchos los archivos a todo lo anterior, se justifica el uso de hilos. No por que redunde en un incremento de la velocidad sino por que libera al usuario de la espera.


(* VERSION PARA DELPHI XE *)
unit uCopyAll;

interface

uses
Windows, Messages, SysUtils, Variants, Classes;

type
TCopyAllFiles = class(TThread)
private
FFiles, FExclude: TStrings;
FSource, FTarget, FExtension: string;
procedure FindFiles(Folder: string);
procedure CopyFiles;
function IsSameExt(FileName: string): Boolean;
function IsBeCopied(FileName: string): Boolean;
function GetExclude: string;
procedure SetExclude(const Value: string);
procedure SetExtension(Value: string);
procedure SetSource(const Value: string);
procedure SetTarget(const Value: string);
protected
procedure Execute; override;
public
constructor Create; reintroduce; overload;
procedure BeginCopy;
destructor Destroy; override;
property Source: string read FSource write SetSource;
property Target: string read FTarget write SetTarget;
property Exclude: string read GetExclude write SetExclude;
property Extension: string read FExtension write SetExtension;
end;

implementation

uses Forms, Dialogs, ShellApi;

// Constructor
constructor TCopyAllFiles.Create;
begin
inherited Create(True);
Priority:= tpNormal;
FreeOnTerminate:= True;
FFiles:= TStringList.Create;
FExclude:= TStringList.Create;
end;

// Devuelve verdadero si coincide la extensión
function TCopyAllFiles.IsSameExt(FileName: string): Boolean;
begin
Result:= UpperCase(ExtractFileExt(FileName)) = FExtension;
end;

// Devuelve verdadero si encuentra una máscara en el nombre
function TCopyAllFiles.IsBeCopied(FileName: string): Boolean;
var
i: Integer;
Name: string;
begin
Result:= True;
if FExclude.Count > 0 then
Name:= UpperCase(ChangeFileExt(ExtractFileName(FileName), ''));
for i:= 0 to FExclude.Count-1 do
if AnsiPos(UpperCase(FExclude), Name) <> 0 then
begin
Result:= False;
Exit;
end;
end;

// Devuelve mascara
function TCopyAllFiles.GetExclude: string;
begin
Result:= FExclude.Text;
end;

// Asigna mascara
procedure TCopyAllFiles.SetExclude(const Value: string);
begin
ExtractStrings([';'],[], PWideChar(Value), FExclude);
end;

// Asigna extensión
procedure TCopyAllFiles.SetExtension(Value: string);
begin
if Value = EmptyStr then
raise Exception.Create('Falta ingresar extensión');
if AnsiPos('.', Value) = 0 then
Value:= '.' + Value;
FExtension := UpperCase(Value);
end;

// Asigna ruta origen
procedure TCopyAllFiles.SetSource(const Value: string);
begin
FSource:= IncludeTrailingPathDelimiter(Value);
if not DirectoryExists(FSource) then
raise Exception.Create('Ruta al orígen inexistente. Operación abortada.');
end;

// Asigna ruta destino
procedure TCopyAllFiles.SetTarget(const Value: string);
const
MSG = 'Carpeta destino inexistente.'+#10#13+'¿ Desea crearla ?';
begin
FTarget:= IncludeTrailingPathDelimiter(Value);
if not DirectoryExists(Value) then
begin
if MessageDlg(MSG,mtConfirmation,[mbYes, mbNo],0) = IDNO then
raise Exception.Create('Operación abortada.');
CreateDirectory(PWideChar(FTarget),nil);
end;
end;

// Obtiene archivos de determinada extensión en carpeta y subcarpetas
procedure TCopyAllFiles.FindFiles(Folder: string);
var
SR: TSearchRec;
begin
Folder:= IncludeTrailingPathDelimiter(Folder);
if FindFirst(Folder + '*.*', $FF, SR) = 0 then
repeat
if ((SR.Attr and fadirectory) = fadirectory) then
begin
if(SR.Name <> '.') and (SR.Name <> '..') then
FindFiles(Folder + SR.Name)
end
else if IsBeCopied(SR.Name) and IsSameExt(SR.Name) then
FFiles.Add(Folder + SR.Name);
until FindNext(SR) <> 0;
FindClose(SR);
end;

// Copia todos los archivos de determinada extension
procedure TCopyAllFiles.CopyFiles;
var
i : Integer;
shfos: SHFILEOPSTRUCT;
begin
if not Terminated then
begin
FindFiles(FSource);
if FFiles.Count > 1 then
for i:= 0 to FFiles.Count-1 do
begin
ZeroMemory(@shfos, SizeOf(shfos));
shfos.Wnd:= Application.Handle;
shfos.wFunc:= FO_COPY;
shfos.hNameMappings:= nil;
shfos.pFrom:= PWideChar(FFiles[i]+#0+#0);
shfos.pTo:= PWideChar(FTarget+#0+#0);
shfos.fFlags:= FOF_NOCONFIRMATION+FOF_SILENT+FOF_RENAMEONCOLLISION;
SHFileOperation(SHFOS);
end;
end;
ShowMessage('Copia finalizada');
end;

// Execute
procedure TCopyAllFiles.Execute;
begin
Synchronize(CopyFiles);
end;

(* Comenzar *)
procedure TCopyAllFiles.BeginCopy;
begin
Execute;
end;

(* Destructor *)
destructor TCopyAllFiles.Destroy;
begin
FFiles.Free;
FExclude.Free;
end;
end.


Ejemplo de uso:

...
implementation
{$WARNINGS OFF}
uses FileCtrl, uCopyAll;

procedure TForm1.spdBtnSourceClick(Sender: TObject);
var
SelDir: string;
begin
if SelectDirectory(SelDir, [sdPrompt], 0) then
EditSource.Text:= SelDir;
end;

procedure TForm1.spdBtnTargetClick(Sender: TObject);
var
SelDir: string;
begin
if SelectDirectory(SelDir, [sdPrompt], 0) then
EditTarget.Text:= SelDir;
end;

procedure TForm1.btnStartCopyClick(Sender: TObject);
begin
with TCopyAllFiles.Create do
try
Source := Trim(EditSource.Text);
Target := Trim(EditTarget.Text);
Extension:= Trim(EditExtension.Text);
Exclude := Trim(EditMonemes.Text);
BeginCopy;
finally
Free;
end;
end;
...

El programa copia todos los archivos de la extensión indicada desde la carpeta orígen hasta la carpeta destino, excepto aquellos cuyos nombres incluyan alguno de los monemas especificados. Si la carpeta destino no existe pregunta si se desea crearla y de acuerdo a la elección del usuario, la crea o aborta la operación.

El código fue probado bajo Windows 7 32bits en Delphi 7 y Delphi XE. Si usas el primero tenés que reemplazar las ocurrencias de [I]PWideChar por PChar y viceversa de otro modo.
En las pruebas que realicé sobre una carpeta con 76 subcarpetas y 1857 archivos tardó un tiempo promedio de unos 20 segundos.

Creo haber expuesto el ejemplo del uso de la clase de forma entendible... Pero si tenes alguna dificultad para implementarlo no dudes en avisame y te adjunto el código fuente.

Saludos :)

[gdlrinfo]

ecfisa: Gracias por tu respuesta ni bien lo pruebo te comento !!!!!

[gdlrinfo]

[QUOTE=ecfisa;482899]

Hola ecfisa te cuento que probé y funciona muy bien el único problema que hay es que no me deja poner todas las frases que quiero discriminar por ejemplo no quiero que copie nada que contenga CAC - CAM - RIB pero en el edit solo me deja poner uno ejemplo el CAC y si no lo copia la idea es poner todas las siglas juntas así no copia ninguno de esos archivos, pero la verdad que poniendo de a uno anda muy bien pero la idea es poner todas las siglas que no se quieren copiar desde ya como siempre gracias por tu ayuda

[nlsgarcia]

gdlrinfo,


...en la búsqueda cuando copio...hay algunos archivos que tienen unas siglas que no me interesa copiar...

:rolleyes:

Revisa este código:

unit Unit1;

interface

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

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

TCopyFiles = class(TThread)
private
DirSource, DirTarget, FileExt, FileExtNew : String;
FilesExcluded : TStringList;
MsgApp : String;
IFile,FFile : LongWord;
protected
procedure SearchFiles(DirSource, DirTarget, FileExt : String; var
FileList : TStringList;
FilesExcluded : TStringList
);
constructor Create(CreateSuspended : Boolean);
procedure Execute; override;
procedure MsgCopy;
procedure MsgEnd;
end;

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

implementation

{$R *.dfm}

// Constructor de la clase TCopyFiles
constructor TCopyFiles.Create(CreateSuspended : Boolean);
begin
inherited;
FilesExcluded := TStringList.Create;
end;

// Selecciona los archivos a ser copiados del directorio fuente al destino de forma recursiva
procedure TCopyFiles.SearchFiles(DirSource, DirTarget, FileExt : String;
var FileList : TStringList;
FilesExcluded : TStringList
);
var
SR : TSearchRec;
i : Integer;
ExcludedFile : Boolean;

begin

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

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

if FindFirst(DirSource + '*.*', faAnyFile, SR) = 0 then
repeat
if ((SR.Attr and fadirectory) = fadirectory) then
begin
if(SR.Name <> '.') and (SR.Name <> '..') then
SearchFiles(DirSource + SR.Name, DirTarget, FileExt, FileList, FilesExcluded);
end
else
begin
ExcludedFile := False;

for i := 0 to FilesExcluded.Count - 1 do
if Pos(LowerCase(FilesExcluded.Strings), LowerCase(SR.Name)) > 0 then
begin
ExcludedFile := True;
Break;
end;

if ExcludedFile then Continue;

if FileExt = EmptyStr then
FileList.Add(DirSource + SR.Name)
else
if LowerCase(ExtractFileExt(SR.Name)) = LowerCase(FileExt) then
FileList.Add(DirSource + SR.Name);
end;
until FindNext(SR) <> 0;

FindClose(SR);

end;

// Ejecuta el hilo de copia de archivos
procedure TCopyFiles.Execute;
var
FileList : TStringList;
i : Integer;
FromFileName, ToFileName : String;
AuxFileName, AuxFileExt : String;
CountFile : Integer;

begin

FreeOnTerminate := True;

FileList := TStringList.Create;

SearchFiles(DirSource, DirTarget, FileExt, FileList, FilesExcluded);

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

FromFileName := FileList.Strings;

if FileExtNew <> EmptyStr then
ToFileName := IncludeTrailingPathDelimiter(DirTarget)
+ ChangeFileExt(ExtractFileName(FileList.Strings),FileExtNew)
else
ToFileName := IncludeTrailingPathDelimiter(DirTarget) + ExtractFileName(FileList.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;
FilesExcluded.Free;

Synchronize(MsgEnd);

end;

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

// Muestra un mensaje de finalización de copia de archivos
procedure TCopyFiles.MsgEnd;
begin
Form1.Caption := 'CopyFiles';
MsgApp := Format('Copia Recursiva de Archivos *%s del Folder %s al Folder %s Completada',
[FileExt, 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, FileExt, FileExtNew : String;
FilesExcluded : TStringList;

begin

DirSource := 'D:\HostDownload';
DirTarget := 'D:\TestNelson-2';
FileExt := '.rtf';
FileExtNew := '.doc';

// Exclusión de archivos a ser copiados (Se pueden excluir tantos como se requiera)
FilesExcluded := TStringList.Create;
FilesExcluded.Add('x1'); // Excluye todos los archivos que incluyan x1 en su nombre
FilesExcluded.Add('x2'); // Excluye todos los archivos que incluyan x2 en su nombre
FilesExcluded.Add('x3'); // Excluye todos los archivos que incluyan x3 en su nombre

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.FileExt := FileExt; // CopyFiles.FileExt := '' copia todos los archivos
CopyFiles.FileExtNew := FileExtNew; // CopyFiles.FileExtNew := '' no cambia la extensión
CopyFiles.FilesExcluded.Assign(FilesExcluded);
CopyFiles.Resume;
CopyFilesThread := CopyFiles.Handle;

FilesExcluded.Free;

end
else
begin
MsgApp := 'Hay un Proceso de Copia Activo, Favor Esperar que Finalize';
Beep;
MessageDlg(MsgApp,mtInformation,[mbOK],0);
Exit;
end;

end;

end.

El código anterior en Delphi 7 bajo Windows 7 Professional x32, es la versión 3 del código propuesto en el Msg #3 el cual permite: [I]copiar de forma recursiva todos los archivos de un directorio y subdirectorios fuente a un directorio destino en función de una mascara de copia.

El código del ejemplo esta disponible en el link : CopyFiles.rar (http://terawiki.clubdelphi.com/Delphi/Ejemplos/Varios/?download=CopyFiles.rar)

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, [I]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, [I]solo se incluyo como referencia visual un contador de copia (Copiado XX de YY), que indica el archivo que esta siendo copiado en un momento determinado al directorio destino.

5- Si no se especifica la extensión de los archivos a copiar (TCopyFiles.FileExt), se copiaran todos los archivos recursivamente del directorio fuente al destino.

6- Si se especifica una nueva extensión (TCopyFiles.FileExtNew), se copiaran todos los archivos recursivamente del directorio fuente al destino con la nueva extensión.

7- Se pueden excluir archivos de la copia por medio de TCopyFiles.FilesExcluded, el cual permite crear una lista (TStringList) de nombres parciales o completos de archivos que no serán incluidos en la copia, ejemplo : Si se quiere excluir de la copia los archivos FileX1.rtf, FileX2.rtf y FileX3.rtf se puede realizar de las siguientes formas:

FilesExcluded.Add('x1'); // Excluye todos los archivos que incluyan x1 en su nombre
FilesExcluded.Add('x2'); // Excluye todos los archivos que incluyan x2 en su nombre
FilesExcluded.Add('x3'); // Excluye todos los archivos que incluyan x3 en su nombre

ó

FilesExcluded.Add('FileX1.rtf'); // Excluye el archivo que se llame FileX1.rtf
FilesExcluded.Add('FileX2.rtf'); // Excluye el archivo que se llame FileX2.rtf
FilesExcluded.Add('FileX3.rtf'); // Excluye el archivo que se llame FileX3.rtf

ó

FilesExcluded.Add('x'); // Excluye todos los archivos que incluyan x en su nombre

La exclusión de archivos es Case Insensitive

La opción de exclusión, tiende a disminuir los tiempos de copia según se muestra en la siguiente prueba:

1- 169 Files RTF, 2.19 GB Tamaño Total -> 00:01:55 (Sin exclusión)

2- 169 Files RTF, 2.19 GB Tamaño Total -> 00:01:38 (Con exclusión de 3 tipos de archivos)

Espero sea útil :)

Nelson.

[ecfisa]

Hola gdLrinfo.
[QUOTE=ecfisa;482899]

Hola ecfisa te cuento que probé y funciona muy bien el único problema que hay es que no me deja poner todas las frases que quiero discriminar por ejemplo no quiero que copie nada que contenga CAC - CAM - RIB pero en el edit solo me deja poner uno ejemplo el CAC y si no lo copia la idea es poner todas las siglas juntas así no copia ninguno de esos archivos, pero la verdad que poniendo de a uno anda muy bien pero la idea es poner todas las siglas que no se quieren copiar desde ya como siempre gracias por tu ayuda
Permite poner la cantidad de monemas que deses separados por punto y coma ( ; ) por ejemplo:

CAC;CAM;RIB;Sam;eno;ico;uVa;...

Los espacios entre punto y coma y monema serán considerados

Saludos :)

[ecfisa]

Hola gdlrinfo.

Me quedé pensando que quizá te resulte mejor cotejar con el código fuente, así que te lo adjunto.

Es la versión para Delphi 7, así que no olvides reemplazar en la unidad uCopyAll todas las ocurrencias de PAnsiChar por PWideChar (Search->Replace).

Saludos :)

[gdlrinfo]

Chicos la verdad estoy muy agradecido por su ayuda, los foros funcionan gracias a personas como ustedes que se preocupan y nos ayudan a quienes somos novatos, a salir adelante con nuestros proyectos gracias por todo, ni bien arme todo estaré escribiendo nuevamente y agradecido por su apoyo es bueno ayudar sin pedir nada a cambio eso hace la grandeza de las personas muchas gracias !!!!!

[gdlrinfo]

Hola muchachos recuerdo cuando me dieron una mano con esto ahora tengo una duda asi como se excluyen se pude hacer que en vez de excluir incluya ? gracias como siempre !!!

[ecfisa]

Hola gdIrinfo.
Hola muchachos recuerdo cuando me dieron una mano con esto ahora tengo una duda asi como se excluyen se pude hacer que en vez de excluir incluya ? gracias como siempre !!!
Solo hay que cambiar la condición de retorno:

...
function TCopyAllFiles.IsBeCopied(FileName: string): Boolean;
var
i: Integer;
Name: string;
begin
Result := False; // (antes True);
if FExclude.Count > 0 then
Name := UpperCase(ChangeFileExt(ExtractFileName(FileName), ''));
for i := 0 to FExclude.Count-1 do
if AnsiPos(UpperCase(FExclude[i]), Name) <> 0 then
begin
Result := True; // (antes False)
Exit;
end;
end;
...


Saludos :)

[gdlrinfo]

:rolleyes: Geniallll gracias nuevamente!!! Atte. Gonzalo

[gdlrinfo]

[QUOTE=ecfisa;499607] [QUOTE=ecfisa]

Perdon mi ignorancia pero no encuentro esto que me decis Aca---



unit Unit1;

interface

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

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

TCopyFiles = class(TThread)
private
DirSource, DirTarget, FileExt, FileExtNew : String;
FilesExcluded : TStringList;
MsgApp : String;
IFile,FFile : LongWord;
protected
procedure SearchFiles(DirSource, DirTarget, FileExt : String; var
FileList : TStringList;
FilesExcluded : TStringList
);
constructor Create(CreateSuspended : Boolean);
procedure Execute; override;
procedure MsgCopy;
procedure MsgEnd;
end;

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

implementation

{$R *.dfm}

// Constructor de la clase TCopyFiles
constructor TCopyFiles.Create(CreateSuspended : Boolean);
begin
inherited;
FilesExcluded := TStringList.Create;
end;

// Selecciona los archivos a ser copiados del directorio fuente al destino de forma recursiva
procedure TCopyFiles.SearchFiles(DirSource, DirTarget, FileExt : String;
var FileList : TStringList;
FilesExcluded : TStringList
);
var
SR : TSearchRec;
i : Integer;
ExcludedFile : Boolean;

begin

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

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

if FindFirst(DirSource + '*.*', faAnyFile, SR) = 0 then
repeat
if ((SR.Attr and fadirectory) = fadirectory) then
begin
if(SR.Name <> '.') and (SR.Name <> '..') then
SearchFiles(DirSource + SR.Name, DirTarget, FileExt, FileList, FilesExcluded);
end
else
begin
ExcludedFile := False;

for i := 0 to FilesExcluded.Count - 1 do
if Pos(LowerCase(FilesExcluded.Strings[i]), LowerCase(SR.Name)) > 0 then
begin
ExcludedFile := True;
Break;
end;

if ExcludedFile then Continue;

if FileExt = EmptyStr then
FileList.Add(DirSource + SR.Name)
else
if LowerCase(ExtractFileExt(SR.Name)) = LowerCase(FileExt) then
FileList.Add(DirSource + SR.Name);
end;
until FindNext(SR) <> 0;

FindClose(SR);

end;

// Ejecuta el hilo de copia de archivos
procedure TCopyFiles.Execute;
var
FileList : TStringList;
i : Integer;
FromFileName, ToFileName : String;
AuxFileName, AuxFileExt : String;
CountFile : Integer;

begin

FreeOnTerminate := True;

FileList := TStringList.Create;

SearchFiles(DirSource, DirTarget, FileExt, FileList, FilesExcluded);

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

FromFileName := FileList.Strings[i];

if FileExtNew <> EmptyStr then
ToFileName := IncludeTrailingPathDelimiter(DirTarget)
+ ChangeFileExt(ExtractFileName(FileList.Strings[i]),FileExtNew)
else
ToFileName := IncludeTrailingPathDelimiter(DirTarget) + ExtractFileName(FileList.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;
FilesExcluded.Free;

Synchronize(MsgEnd);

end;

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

// Muestra un mensaje de finalización de copia de archivos
procedure TCopyFiles.MsgEnd;
begin
Form1.Caption := 'CopyFiles';
MsgApp := Format('Copia Recursiva de Archivos *%s del Folder %s al Folder %s Completada',
[FileExt, 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, FileExt, FileExtNew : String;
FilesExcluded : TStringList;

begin

DirSource := 'D:\HostDownload';
DirTarget := 'D:\TestNelson-2';
FileExt := '.rtf';
FileExtNew := '.doc';

// Exclusión de archivos a ser copiados (Se pueden excluir tantos como se requiera)
FilesExcluded := TStringList.Create;
FilesExcluded.Add('x1'); // Excluye todos los archivos que incluyan x1 en su nombre
FilesExcluded.Add('x2'); // Excluye todos los archivos que incluyan x2 en su nombre
FilesExcluded.Add('x3'); // Excluye todos los archivos que incluyan x3 en su nombre

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.FileExt := FileExt; // CopyFiles.FileExt := '' copia todos los archivos
CopyFiles.FileExtNew := FileExtNew; // CopyFiles.FileExtNew := '' no cambia la extensión
CopyFiles.FilesExcluded.Assign(FilesExcluded);
CopyFiles.Resume;
CopyFilesThread := CopyFiles.Handle;

FilesExcluded.Free;

end
else
begin
MsgApp := 'Hay un Proceso de Copia Activo, Favor Esperar que Finalize';
Beep;
MessageDlg(MsgApp,mtInformation,[mbOK],0);
Exit;
end;

end;

end.

[gdlrinfo]

Estaba de otra manera no me había dado cuenta muchas gracias funciona a la perfección!!! atte. Gonzalo