In newer versions of Delphi, there is a function that does this: IOUtils.TDirectory.GetFiles
, to use it, add IOUtils
to Uses
.
Use 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
Alternatively, you can use Findfirst
and FindNext
" recursively to search 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 for storing backups of files, these will have the .zzz
extension, the second directory is where the .prj
files will be moved.