Ver Mensaje Individual
  #18  
Antiguo 10-10-2014
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola gdIrinfo

Ayer pude comprobar que del modo que te sugerí en el mensaje #9, funciona correctamente en Delphi XE.

Cita:
Empezado por gdlrinfo Ver Mensaje
...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 [-]
(* 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[i]), 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:
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
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita