Artigos Delphi Pesquisa e cópia de arquivos, diretórios e subdiretórios - Delphi

Neste artigo,irei compartilhar o código fonte de uma procedure que visa copiar a estrutura de pastas de forma personalizável no diretório destino. O Código irá percorrer a estrutura de arquivos da pasta selecionada utilizando os comandos: FINDFIRST e FINDNEXT.

Essas funções retornam 0 quando encontram um arquivo ou pasta;

Para verificar se é um outro diretório devemos checar se o atributo do arquivo é igual a 16. Então adicionaremos o caminho do diretório em uma stringlist para depois copiar seus arquivos.


procedure TfrmTeste.CopyFiles(DirOrigem, DirDest: string);
var
  Arquivos: TSearchRec;
  Encontrou: Integer;
  str : TStringList;
  i : integer;
  CriaDir : String;
begin
  str := TStringList.Create;
  str.Add(DirOrigem);
  i := 0;
  while i <= str.count -1 do
  begin
    CriarDir := StringReplace(strList[i], DirOrigem, '
    ',[rfReplaceAll, rfIgnoreCase]);
    if not DirectoryExists(DirDest + CriarDir ) then 
    {No caso as estruturas de pastas serão iguais logo 
      iremos verificar se a pasta existe o destino}
        ForceDirectories(DirDest + CriarDir );
  SetCurrentDir(DirOrigem + CriarDir);
  Encontrou := FindFirst('*', faAnyFile , Arquivos);   
  {Atrr 16 corresponde a pasta, e 32 a arquivos}
  while Encontrou = 0 do
  begin
   if (Arquivos.attr = 16) then  {Verifica se é pasta}
     str.Add(DirOrigem + Arquivos.Name + '\') {Adiciona a 
     StringList para procura de arquivos}
  else
    CopyFile(Pchar(DirOrigem + Arquivos.Name),
    PChar(DirDest + Arquivos.Name), True);
    {Coloque como True se quiser que se já existir o 
      arquivo ele seja sobrescrito }
   SetFileAttributes(PChar(DirDest + Arquivos.Name), 
   FILE_ATTRIBUTE_NORMAL); {Tira a propriedade READ - ONLY do arquivo}
    Encontrou := FindNext(Arquivos);
  end;
  FindClose(Arquivos);
  Inc(i,1); {Incrementa o contador}
  end;
end;