Move all files with the extension.prj for a folder

Question

Move all files with the extension.prj for a folder

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

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

Is it possible to read all the folders, go finding the files .prj, and go pasting in a result folder?

2

delphi diretório recursão

Author: stderr, 2016-08-02

Source

1 answers

score 2 · Accepted Answer

In newer 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 e FindNext recursively to search for the 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 backup copies of the files, these they will have the extension .zzz, the second directory is where the files .prj will be moved to.