Ver Mensaje Individual
  #2  
Antiguo 06-09-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 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
__________________
Daniel Didriksen

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