Busqueda de archivos especificos

[gdlrinfo]

Hola amigos:

Tengo un problema al copiar unos archivos yo simplemente quiero copiar de un árbol de directorios (Osea muchas carpetas) unos archivos *RTF que se almacenan ahí, pero no quiero que me copie los directorios en buscado muchos procedimiento en los foros pero no consigo ninguno que lo pueda hacer si alguien me puede dar una mano estaría agradecido desde ya muchas gracias !!!!

[ecfisa]

Hola gdlrinfo.

Fijate si te sirve de este modo:

Código Delphi [-]
...

uses ShellApi;

(* Obtiene archivos de determinada extensión en carpeta y subcarpetas *)
procedure FindFilesByExt(Folder, Ext:AnsiString; Files: TStrings);
var
  SR: TSearchRec;
  Found: Boolean;
begin
  // buscar primero
  if FindFirst(Folder + '*.*', $FF, SR) = 0 then
  repeat
    // Found = verdadero si coincide la extensión
    Found:= Pos(UpperCase(Ext), UpperCase(SR.Name)) <> 0;
    if ((SR.Attr and fadirectory) = fadirectory) then // attr = carpeta ?
    begin
      if(SR.Name <> '.') and (SR.Name <> '..') then  // ¿ es . ó .. ?
        FindFilesByExt(Folder + SR.Name, Ext, Files) // recursar
    end
    else if Found then  // es un archivo, ¿ coincide la extension ?
      Files.Add(Folder + SR.Name); // si, agregarlo
  until FindNext(SR) <> 0;
  FindClose(SR);
end;

(* Copia todos los archivos de determinada extension *)
procedure CopyFilesWithoutDir(Source, Target, Ext: AnsiString);
const
  INVALID_FILE_ATTRIBUTES = Cardinal($FFFFFFFF);
var
  TS   : TStrings;
  i    : Integer;
  SHFOS: SHFILEOPSTRUCT;
begin
  // asegurar que las carpetas terminen en delim '\'
  Source:= IncludeTrailingPathDelimiter(Source);
  Target:= IncludeTrailingPathDelimiter(Target);
  // verificar existencia carpeta orígen
  if (GetFileAttributesA(PChar(Source)) = INVALID_FILE_ATTRIBUTES) then
    raise Exception.Create('Carpeta origen inválida');
  // verificar existencia carpeta destino
  if (GetFileAttributesA(PChar(Target)) = INVALID_FILE_ATTRIBUTES) then
    raise Exception.Create('Carpeta destino inválida');
  // comenzar la copia
  TS:= TStringList.Create;
  try
    // obtener archivos a copiar
    FindFilesByExt(Source, Ext, TS);
    // si se encontraron archivos, comenzar copia
    if TS.Count > 1 then
      for i:= 0 to TS.Count-1 do
      begin
        ZeroMemory(@SHFOS, SizeOf(SHFOS));
        SHFOS.Wnd:= Application.Handle;
        SHFOS.wFunc:= FO_COPY;
        SHFOS.hNameMappings:= nil;
        SHFOS.pFrom:= PChar(TS[i]+#0+#0);
        SHFOS.pTo:= PChar(Target+#0+#0);
        SHFileOperation(SHFOS);
      end;
  finally
    TS.Free;
  end;
end;

Llamada de ejemplo:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
begin
  Screen.Cursor:= crHourGlass;// Cursor de espera
  try
    CopyFilesWithoutDir('C:\Users\usr\Documents', 'C:\temp\', '.odt');
  finally
    Screen.Cursor:= crDefault; // cursor normal
    MessageBox(0, 'Copia finalizada', '', MB_ICONINFORMATION);
  end;
end;

Saludos

[[nlsgarcia]]

gdlrinfo,

Empezado por gdlrinfo

...quiero copiar de un árbol de directorios (Osea muchas carpetas) unos archivos *RTF...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TCopyFiles = class(TThread)
  private
    DirSource, DirTarget, FileMask : String;
    FrmCopy : TForm;
    MsgApp : String;
    IFile,FFile : LongWord;
  protected
    procedure Execute; override;
    procedure CopyFiles(DirSource, DirTarget, FileMask : String);
    procedure MsgCopy;
    procedure MsgEnd;
  end;

var
  Form1: TForm1;
  CopyFiles : TCopyFiles;
  CopyFilesThread : THandle = 0;

implementation

{$R *.dfm}

// Ejecuta hilo de copia de archivos
procedure TCopyFiles.Execute;
begin
   FreeOnTerminate := True;
   CopyFiles(DirSource, DirTarget, FileMask);
   Synchronize(MsgEnd);
end;

// Copia archivos de directorio fuente a destino de forma recursiva
procedure TCopyFiles.CopyFiles(DirSource, DirTarget, FileMask : String);
var
   SR : TSearchRec;
   FileList : TFileListBox;
   i, CountFile : Integer;
   FromFileName, ToFileName : String;
   AuxFileName, AuxFileExt : String;

begin

   DirSource := IncludeTrailingPathDelimiter(DirSource);
   DirTarget := IncludeTrailingPathDelimiter(DirTarget);

   if (not DirectoryExists(DirSource)) or (not DirectoryExists(DirTarget)) then
      Exit;

   FileList := TFileListBox.Create(nil);
   FileList.Visible := False;
   FileList.Parent := FrmCopy;
   FileList.Mask := FileMask;
   FileList.Directory := DirSource;

   for i := 0 to FileList.Count - 1 do
   begin

      FromFileName := DirSource + FileList.Items.Strings[i];
      ToFileName := DirTarget + FileList.Items.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;

   if FindFirst(DirSource + '*.*', faAnyFile, SR) = 0 then
   repeat
      if ((SR.Attr and fadirectory) = fadirectory) then
      begin
         if(SR.Name <> '.') and (SR.Name <> '..') then
            CopyFiles(DirSource + SR.Name, DirTarget, FileMask);
      end
   until FindNext(SR) <> 0;

   FindClose(SR);

end;

// Muestra mensaje de progreso de copia de archivos
procedure TCopyFiles.MsgCopy;
begin
   Form1.Caption := Format('Copiando %d de %d',[IFile, FFile]);
end;

// Muestra mensaje de finalización de copia de archivos
procedure TCopyFiles.MsgEnd;
begin
   Form1.Caption := 'CopyFiles';
   MsgApp := Format('Copia de Archivos %s del Folder %s al Folder %s Completada',
                    [FileMask, 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 : String;

begin

   DirSource := 'C:\FolderSource';
   DirTarget := 'C:\FolderTarget';

   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.FileMask := '*.rtf';
      CopyFiles.FrmCopy := Self;
      CopyFiles.Resume;
      CopyFilesThread := CopyFiles.Handle;

   end;

end;

end.

El código anterior en Delphi 7 bajo Windows 7 Professional x32, copia de forma recursiva todos los archivos de un directorio y subdirectorios fuente a un directorio destino en función de una mascara de archivo.

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 del archivo que esta siendo copiado de un directorio fuente en un momento determinado.

Espero sea útil

Nelson.

[gdlrinfo]

Hola muchísimas gracias por responder en primer lugar te cuento ecfisa que el código que me pasaste me da error de compatibilidad de tipos en las líneas que contienen

Código Delphi [-]
 if (GetFileAttributesA(PChar(Source)) = INVALID_FILE_ATTRIBUTES) then

el error es [dcc32 Error] Pagos.pas(85): E2010 Incompatible types: 'PAnsiChar' and 'PWideChar' ////
Eso por una parte por la otra nlsgarcia la verdad me funciona lo que me pasaste pero si tocas la pantalla o haces algo mientras copia se tilda la verdad tendría que mirar a ver que pasa pero la copia lo hace bien una pregunta!!! Es posible que mientras copia al directorio de destino le cambie la extencion *.rtf por *.doc desde ya muchas gracias por todo !!!!

[[nlsgarcia]]

gdlrinfo,

Empezado por gdlrinfo

...si tocas la pantalla o haces algo mientras copia se tilda...

Pregunto : ¿Que significa se tilda?

Nelson.

[gdlrinfo]

Significa que se congela deja de tabajar no funciona mas jajajaj y da un error ---> list index out of bounds (4) y no sigue procesando gracias

[ecfisa]

Empezado por gdlrinfo

Hola muchísimas gracias por responder en primer lugar te cuento ecfisa que el código que me pasaste me da error de compatibilidad de tipos en las líneas que contienen

Código Delphi [-]
 if (GetFileAttributesA(PChar(Source)) = INVALID_FILE_ATTRIBUTES) then

el error es [dcc32 Error] Pagos.pas(85): E2010 Incompatible types: 'PAnsiChar' and 'PWideChar' ////

Hola gdIrinfo.

No puedo afirmarlo por que veo que usas una versión de Delphi mas avanzada que la mía, pero intenta de este modo:

Código Delphi [-]
   if GetFileAttributesA(PAnsiChar(Source)) = INVALID_FILE_ATTRIBUTES then
   //...
   if GetFileAttributesA(PAnsiChar(Target)) = INVALID_FILE_ATTRIBUTES then

Saludos

[[nlsgarcia]]

gdlrinfo,

Empezado por gdlrinfo

...si tocas la pantalla o haces algo mientras copia se tilda (Bloquea)...

Empezado por gdlrinfo

...Es posible que mientras copia al directorio de destino le cambie la extensión *.rtf por *.doc...

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
    { Private declarations }
  public
    { Public declarations }
  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}

// Selecciona los archivos a ser copiados del directorio fuente al destino de forma recursiva
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;

// 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);

   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;

// 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;

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.FileExt := '' copia todos los archivos
      CopyFiles.FileExtNew := FileExtNew; // CopyFiles.FileExtNew := '' no cambia la extensión
      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.