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;
