Move all files with the . prj extension to a folder

Question

I would like to know whether the following situation is possible:

There are several folders inside each other... and within them there are files with the extension .prj.

It is possible to read all folders, keep finding the files .prj, and paste into a result folder?

Answer 1

In more recent versions of Delphi, there is a function that does this: IOUtils.TDirectory.GetFiles, to use it, add IOUtils in Uses.

Use like this:

Uses
  IOUtils;
//...

procedure TForm1.Button2Click(Sender: TObject);
const
  EXTENSAO = '*.prj';
var
  DynArray: TStringDynArray;
  Diretorio, DiretorioBackup, DiretorioResultado: string;
  Arquivo, NomeArquivo: string;
  TotalArquivos, Sucessos, Erros: Integer;
begin
  // Cria um diretório "backup" na pasta selecionada
  DiretorioBackup := IncludeTrailingBackslash('Backup');
  // Cria o diretório para onde será movido os arquivos
  DiretorioResultado := IncludeTrailingBackslash('Resultado');

  try
    // Para selecionar somente diretórios!
    FileOpenDialog1.Options := [fdoPickFolders];
    if FileOpenDialog1.Execute = False then exit;

    // Atenção! Se for pegar o diretório de um arquivo use o ExtractFileDir/ExtractFilePath
    Diretorio := IncludeTrailingBackslash(FileOpenDialog1.FileName);

    // Se o diretório de backup não existir, um é criado
    if not DirectoryExists(Diretorio + DiretorioBackup) then
      CreateDir(Diretorio + DiretorioBackup);

    // Se o diretório não existir, cria-se um
    if not DirectoryExists(Diretorio + DiretorioResultado) then
      CreateDir(Diretorio + DiretorioResultado);

    // Pega os arquivos com a extensão definida constante EXTENSAO, procura em todos
    // diretórios e subdiretórios
    DynArray := TDirectory.GetFiles(Diretorio, EXTENSAO, TSearchOption.soAllDirectories);

    for Arquivo in DynArray do
    begin
      Inc(TotalArquivos);
      // Extrai o nome do arquivo
      NomeArquivo := ExtractFileName(Arquivo);

      // Faz a cópia dos arquivos para o diretório de backup
      // Se o backup existir, ele é substituído, os arquivos terão extensão ".ZZZ"
      CopyFile(pchar(Arquivo), pchar(Diretorio + DiretorioBackup + NomeArquivo + '.ZZZ'), false);

      // Move os arquivos para o diretório "resultado"
      if MoveFile(pchar(Arquivo), pchar(Diretorio + DiretorioResultado + NomeArquivo)) then
        Inc(Sucessos)
      else
        Inc(Erros);
    end;

    MessageBox(0,
             pchar(Format('Total: %d' + sLineBreak + 'Arquivos movidos: %d Erros: %d',
               [TotalArquivos, Sucessos, Erros])),
               'Backup',
               MB_ICONINFORMATION);

  finally
  end;
end;

Alternative

Another alternative is to use the functions Findfirst and FindNext recursively to search for files:

procedure ListarArquivos(Dir: string; const Ext: string; const Lista: TStringList);
var
  SR: TSearchRec;
begin
  Dir := IncludeTrailingBackslash(Dir);

  if FindFirst(Dir + '*.*', faAnyFile or faDirectory, SR) = 0 then
  try
    repeat
      if ((SR.Attr and faDirectory) = 0) and (Pos(Ext, SR.Name) > 0)  then
        lista.Add(dir + SR.Name)

      else if (SR.Name <> '.') and (SR.Name <> '..') then
        ListarArquivos(Dir + SR.Name, Ext, Lista);
    until FindNext(Sr) <> 0;

  finally
    FindClose(SR);
    Application.ProcessMessages;
  end;
end;

To use do:

procedure TForm1.Button1Click(Sender: TObject);
const
  EXTENSAO = '.prj'; // Sem o coringa!
var
  ListaArquivos: TStringList;
  Diretorio, DiretorioBackup, DiretorioResultado: string;
  Arquivo, NomeArquivo: string;
  TotalArquivos, Sucessos, Erros: Integer;
begin
  // Cria um diretório "backup" na pasta selecionada
  DiretorioBackup := IncludeTrailingBackslash('Backup');
  // Cria o diretório para onde será movido os arquivos
  DiretorioResultado := IncludeTrailingBackslash('Resultado');

  try
    ListaArquivos := TStringList.Create;

    // Para selecionar somente diretórios!
    FileOpenDialog1.Options := [fdoPickFolders];
    if FileOpenDialog1.Execute = False then exit;

    // Atenção! Se for pegar o diretório de um arquivo use o ExtractFileDir/ExtractFilePath
    Diretorio := IncludeTrailingBackslash(FileOpenDialog1.FileName);

    // Se o diretório de backup não existir, um é criado
    if not DirectoryExists(Diretorio + DiretorioBackup) then
      CreateDir(Diretorio + DiretorioBackup);

    // Se o diretório não existir, cria-se um
    if not DirectoryExists(Diretorio + DiretorioResultado) then
      CreateDir(Diretorio + DiretorioResultado);

    // Pega os arquivos com a extensão definida constante EXTENSAO, procura em todos
    // diretórios e subdiretórios
    ListarArquivos(Diretorio, EXTENSAO, ListaArquivos);

    for Arquivo in ListaArquivos do
    begin
      Inc(TotalArquivos);
      // Extrai o nome do arquivo
      NomeArquivo := ExtractFileName(Arquivo);

      // Faz a cópia dos arquivos para o diretório de backup
      // Se o backup existir, ele é substituído, os arquivos terão extensão ".ZZZ"
      CopyFile(pchar(Arquivo), pchar(Diretorio + DiretorioBackup + NomeArquivo + '.ZZZ'), false);

      // Move os arquivos para o diretório "resultado"
      if MoveFile(pchar(Arquivo), pchar(Diretorio + DiretorioResultado + NomeArquivo)) then
        Inc(Sucessos)
      else
        Inc(Erros);
    end;

    MessageBox(0,
               pchar(Format('Total: %d' + sLineBreak + 'Arquivos movidos: %d Erros: %d',
               [TotalArquivos, Sucessos, Erros])),
               'Backup',
               MB_ICONINFORMATION);

  finally
    ListaArquivos.Free;
  end;
end;

Note: Both examples create two directories, one to save backups of the files, these will have the extension .zzz, the second directory is where the files will be moved to .prj.