Mover arquivo das pastas e deletar pastas
Eu havia postado aqui sobre como mover arquivos e criar pastas e colocar os arquivos dentro dessas pastas. Ok, consegui. Agora preciso fazer o inverso. Mover das pastas para uma única pasta e depois ir deletando as pastas vazias, que são muitas, umas 1.000 ou mais pastas. Essas pastas ficam dentro de uma pasta(base) e apartir dela deletar todas as demais. A rotina abaixo, deveria copiar os arquivos para uma pasta específica e não está, ele está copiando o arquivo e a pasta.
A rotina abaixo deveria apagar as pastas e não está acontecendo. Ela identifica as pastas, mas não apaga. Não sei o porque isto está acontecendo.
procedure TForm1.InverteArquivo(Origem, Destino: String);
var
SR: TSearchRec;
DDir,SDir: String;
I: Integer;
Posicao: Byte;
begin
SDir := IncludeTrailingPathDelimiter(Origem);
I := FindFirst(SDir + '*.*', faAnyFile, SR);
while I = 0 do
begin
DDir := IncludeTrailingPathDelimiter(Destino);
I := FindNext(SR);
end;
FindClose(SR);
I := FindFirst(SDir + '*', faDirectory, SR);
while I =0 do
begin
if (SR.Name <> '.') and (SR.Name <> '..') then
MoveArquivo(SDir + SR.Name,DDir);
Posicao := Pos('.TIF',SR.Name);
if Posicao > 0 then
begin
//ForceDirectories(DDir + NomePasta(SR.Name));
//SDir := SDir + IncludeTrailingPathDelimiter(NomePasta(SR.Name));
MoveFile(PChar(SDir+SR.Name),PChar(DDir+SR.Name));
//DellTree(SDir,False);
//SDir := IncludeTrailingPathDelimiter(Origem);
end;
I := FindNext(SR);
end;
//end;
end;procedure TForm1.ApagaDir(const RootDir: String);
var
SearchRec : TSearchRec;
Erc: Byte;
begin
Try
ChDir(RootDir); {Caminho Especificado}
Erc := FindFirst('*.*',faAnyFile,SearchRec);
//Erc := 0;
while Erc = 0 do
begin
if ((SearchRec.Name <> '.' ) and (SearchRec.Name <> '..')) then
begin
if (SearchRec.Attr and faDirectory>0) then
begin
{Achou o diretório e ira apagar seus arquivos}
ApagaDir(SearchRec.Name);
end
else
begin
{Achou um arquivo. Apagar ou não}
end;
end;
Erc := FindNext (SearchRec);
{ Erc igual a zero se o FindNext obtiver sucesso, senão erro do DOS}
Application.ProcessMessages;
end;
finally
if Length(RootDir) > 3 then
ChDir('..');
end;
end;
Pjava
Curtidas 0
Respostas
José
20/07/2011
Este tópico esta sendo fechado por inatividade. Se necessário, sinalizar para que seja reaberto ou abrir um novo.
GOSTEI 0