Copiando pastas e subpastas

Delphi

05/03/2005

pessoal estou utilizandu o seguinte codigo para copiar arquivos

begin
  if CheckBox1.State = cbChecked then
  I := FindFirst(Edit1.Text + ´*.*´, faAnyFile, SR);
  while I = 0 do
       begin
       if (SR.Attr and faDirectory) <> faDirectory then
          begin
          Origem1  := Edit1.Text + SR.Name;
          Destino := frm_config.Edit0.Text + SR.Name;
          if not CopyFile(PChar(Origem1), PChar(Destino), true) then
             ShowMessage(´Erro ao copiar arquivo´ + Origem1 + ´ o arquivo já existe´);
       end;
       I := FindNext(SR);
   end;


porem este codigo copia apenas os arquivos de um determinado diretorio, alguem sabe como fazer para copiar as pastas e subpastas???

caso naum exita com esse alguel pode me dizer algum outro????????

obrigado pessoal!!!


Klaveren

Klaveren

Curtidas 0

Melhor post

Kapak

Kapak

13/04/2005

Se ajudar, vc pode copiar no padrão Windows:
uses ShellApi;
var SH:SHFILEOPSTRUCT;
begin
  FillChar(SH, SizeOf(SH), 0);
  SH.Wnd    := Handle;
  SH.wFunc  := FO_Copy;
  SH.pFrom  := ´c:\Pasta Origem\*.*´+#0;
  SH.pTo    := ´c:\Pasta Destino´+0;
  SH.fFlags := FOF_Allowundo;
  SHFileOperation(SH);
end;



GOSTEI 1

Mais Respostas

Massuda

Massuda

05/03/2005

Esta rotina lista arquivos em um diretório e seus subdiretórios. Adapte ela para suas necessidades:
procedure ListarArquivos(const Path: string; const Lista: TStrings);
var
  Search: TSearchRec;
  Done: Boolean;
begin
  Done := FindFirst(Path + ´\*.*´, faAnyFile, Search) <> 0;
  while not Done do begin
    if (Search.Attr and faDirectory) = faDirectory then begin
      if (Search.Name <> ´.´) and (Search.Name <> ´..´) then begin
        ListarArquivos(Path + ´\´ + Search.Name, Lista);
      end;
    end
    else begin
      Lista.Add(Path + ´\´ + Search.Name);
    end;
    Done := FindNext(Search) <> 0;
  end;
end;



GOSTEI 0
Klaveren

Klaveren

05/03/2005

pessoal ve se alguem poderia me dar uma maunzinha...

no exemplo abaixo...

Código: 
procedure ListarArquivos(const Path: string; const Lista: TStrings); 
var 
  Search: TSearchRec; 
  Done: Boolean; 
begin 
  Done := FindFirst(Path + ´\*.*´, faAnyFile, Search) <> 0; 
  while not Done do begin 
    if (Search.Attr and faDirectory) = faDirectory then begin 
      if (Search.Name <> ´.´) and (Search.Name <> ´..´) then begin 
        ListarArquivos(Path + ´\´ + Search.Name, Lista); 
      end; 
    end 
    else begin 
      Lista.Add(Path + ´\´ + Search.Name); 
    end; 
    Done := FindNext(Search) <> 0; 
  end; 
end;


o que vem a ser este [b:6a48751529][color=red:6a48751529]ListarArquivos [/color:6a48751529][/b:6a48751529]e o [b:6a48751529][color=red:6a48751529]Lista[/color:6a48751529][/b:6a48751529] mais ao fim da linha

ListarArquivos(Path + ´\´ + Search.Name, Lista);



Se alguem poder me ajudar, ficarei grato!!!!!!!!


flw


GOSTEI 0
Massuda

Massuda

05/03/2005

...o que vem a ser este [b:a02e41fe6f][color=red:a02e41fe6f]ListarArquivos [/color:a02e41fe6f][/b:a02e41fe6f]e o [b:a02e41fe6f][color=red:a02e41fe6f]Lista[/color:a02e41fe6f][/b:a02e41fe6f] mais ao fim da linha
A rotina é recursiva e serve para gerar uma lista de arquivos existentes em um diretório e seus subdiretórios.

Adaptando ela para cópia de arquivos, ficaria algo assim (não testei)...
uses
  SysUtils,
  FileCtrl,
  ...

procedure CopiarArquivos(De, Para: string); 
var 
  Search: TSearchRec; 
  Done: Boolean; 
begin 
  IncludeTrailingBackslash(De);
  IncludeTrailingBackslash(Para);

  Done := FindFirst(De + ´*.*´, faAnyFile, Search) <> 0; 
  while not Done do begin 

    if (Search.Attr and faDirectory) = faDirectory then begin 

      if (Search.Name <> ´.´) and (Search.Name <> ´..´) then begin 
        ForceDirectories(Para + Search.Name);
        CopiarArquivos(De + Search.Name, Para + Search.Name); 
      end; 
    end 
    else begin 

      if not CopyFile(PChar(De + Search.Name),
        PChar(Para + Search.Name), True) then begin
        // trata erro na cópia
      end;
    end; 

    Done := FindNext(Search) <> 0; 
  end; 
end;



GOSTEI 0
Klaveren

Klaveren

05/03/2005

Pessoal vejam...

        TForm1.Button1Click(´c:\sisbkp\´ + Search.Name, ´c:\bkp\´ + Search.Name);


nesta linha da a seguinte mensagem de erro:

[b:0bc2d4478a][Warning] Unit1.pas(31): Symbol ´IncludeTrailingBackslash´ is specific to a platform[/b:0bc2d4478a]

alguem sabe o que issu quer dizer???
tks


GOSTEI 0
Klaveren

Klaveren

05/03/2005

up


GOSTEI 0
Klaveren

Klaveren

05/03/2005

help me!
please


GOSTEI 0
Eriene Stringhetta

Eriene Stringhetta

05/03/2005

Funciona perfeitamente!
GOSTEI 0
POSTAR