gdlrinfo,
Cita:
Empezado por gdlrinfo
...si tocas la pantalla o haces algo mientras copia se tilda (Bloquea)...
|
Cita:
Empezado por gdlrinfo
...Es posible que mientras copia al directorio de destino le cambie la extensión *.rtf por *.doc...
|
Cita:
Empezado por nlsgarcia
...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...
|
Revisa este código:
Código Delphi
[-]
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
public
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}
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;
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[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;
Synchronize(MsgEnd);
end;
procedure TCopyFiles.MsgCopy;
begin
Form1.Caption := Format('Copiando %d de %d',[IFile, FFile]);
end;
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;
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.FileExtNew := FileExtNew; 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:
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,
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 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.