Hola gdIrinfo
Ayer pude comprobar que del modo que te sugerí en el mensaje
#9, funciona correctamente en
Delphi XE.
Cita:
Empezado por gdlrinfo
...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.
Código Delphi
[-]
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 TCopyAllFiles.Create;
begin
inherited Create(True);
Priority:= tpNormal;
FreeOnTerminate:= True;
FFiles:= TStringList.Create;
FExclude:= TStringList.Create;
end;
function TCopyAllFiles.IsSameExt(FileName: string): Boolean;
begin
Result:= UpperCase(ExtractFileExt(FileName)) = FExtension;
end;
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[i]), Name) <> 0 then
begin
Result:= False;
Exit;
end;
end;
function TCopyAllFiles.GetExclude: string;
begin
Result:= FExclude.Text;
end;
procedure TCopyAllFiles.SetExclude(const Value: string);
begin
ExtractStrings([';'],[], PWideChar(Value), FExclude);
end;
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;
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;
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;
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;
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;
procedure TCopyAllFiles.Execute;
begin
Synchronize(CopyFiles);
end;
procedure TCopyAllFiles.BeginCopy;
begin
Execute;
end;
destructor TCopyAllFiles.Destroy;
begin
FFiles.Free;
FExclude.Free;
end;
end.
Ejemplo de uso:
Código Delphi
[-]
...
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
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