[quote=ecfisa;499607] [quote=ecfisa]
Perdon mi ignorancia pero no encuentro esto que me decis Aca---
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;
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 TCopyFiles.Create(CreateSuspended : Boolean);
begin
inherited;
FilesExcluded := TStringList.Create;
end;
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;
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;
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;
FilesExcluded : TStringList;
begin
DirSource := 'D:\HostDownload';
DirTarget := 'D:\TestNelson-2';
FileExt := '.rtf';
FileExtNew := '.doc';
FilesExcluded := TStringList.Create;
FilesExcluded.Add('x1'); FilesExcluded.Add('x2'); FilesExcluded.Add('x3');
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.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.