Copiar una carpeta (y su contenido) a otra carpeta

5601 vistas

Vamos a ver dos métodos para realizar este proceso

Uso del API ShFileOperation
Esta función del API de Windows la tenemos incluida en la unit ShellApi. Aconsejamos una revisión de la misma en la ayuda en linea para ver todas sus posibilidades ya que permite varias opciones tal como no mostrar el progreso de la copia, permitir o no UNDO, etc...



delphi
  1. procedure TForm1.Button1Click(Sender: TObject);
  2.  
  3.   function CopiaTodo(Origen,Destino : String) :
  4.   LongInt;
  5.   var
  6.     F : TShFileOpStruct;
  7.     sOrigen, sDestino : String;
  8.   begin
  9.     Result := 0;
  10.     sOrigen := Origen + #0;
  11.     sDestino := Destino + #0;
  12.  
  13.     with F do
  14.     begin
  15.       Wnd  := Application.Handle;
  16.       wFunc := FO_COPY;
  17.       pFrom := @sOrigen[1];
  18.       pTo  := @sDestino[1];
  19.       fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION
  20.     end;
  21.  
  22.     Result := ShFileOperation(F);
  23. end;
  24.  
  25. begin
  26.   CopiaTodo('c:\Delphi3\*.*','c:\kk');
  27. end;



Uso de TSearchRec
Con este método pretendemos dar una visión del funcionamiento de las funciones FindFirst, FindNext y FindClose de la unidad SysUtils para recorrer archivos y carpetas



delphi
  1. procedure TFileDatos.CopyDirectory(
  2.               Origen,            // carpeta origen
  3.               Destino,          // carpeta destino
  4.               Mask: string;      // mascara de copia
  5.               Process: boolean  // procesar mensajes después de la copia de cada fichero
  6.               );
  7. var
  8.   Files: integer;
  9.   FOrigen: string;
  10.   FDestino: string;
  11.   ok: boolean;
  12.   Search: TSearchRec;
  13. begin
  14.   // nos aseguramos que las carpetas terminan con la barra invertida "\"
  15.   Origen := IncludeTrailingPathDelimiter(Origen);
  16.   Destino := IncludeTrailingPathDelimiter(Destino);
  17.  
  18.   Files := FindFirst(Origen + Mask, faAnyFile, Search);
  19.   while Files = 0 do
  20.   begin
  21.     // si no es una carpeta...
  22.     if Search.Attr <> faDirectory then
  23.     begin
  24.       FOrigen := Origen + Search.Name;
  25.       FDestino  := Destino + Search.Name;
  26.       ok := CopyFile(PChar(FOrigen), PChar(FDestino), false);
  27.       if not ok then raise Exception.Create('No se pudo copiar el fichero: ' + Search.Name);
  28.     end
  29.     else // si es una carpeta...
  30.     begin
  31.       if (Search.Name <> '.') and (Search.Name <> '..') then
  32.       begin
  33.         ok := CreateDir(Destino + Search.Name);
  34.         if not ok then raise Exception.Create('No se pudo crear el directorio: ' + Search.Name)
  35.         else CopyDirectory(Origen + Search.Name, Destino + '\' + Search.Name, Mask);
  36.       end;
  37.     end;
  38.     Files := FindNext(Search);
  39.  
  40.     if Process then Application.ProcessMessages;
  41.   end;
  42.   FindClose(Search);
  43. end;