Busqueda de archivos especificos

[ecfisa]

Hola gdIrinfo

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

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 [-]
(* 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

[gdlrinfo]

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

[[nlsgarcia]]

gdlrinfo,

Empezado por gdlrinfo

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

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
    { 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.

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: 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

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- 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:

Código Delphi [-]
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

ó

Código Delphi [-]
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

ó

Código Delphi [-]
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.

[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

[ecfisa]

Hola gdLrinfo.
[quote=gdlrinfo;482917]

Empezado por ecfisa

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.

Empezado por 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 !!!

Solo hay que cambiar la condición de retorno:

Código Delphi [-]
...
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