Estrutura de pastas não funciona como deveria
Preciso criar várias pastas, uma dentro de outra e por fim, mover os arquivos para essas pastas. Fiz de um jeito, mas está feio demais, muitos IF's. Gostaria de uma ajuda. Do jeito que eu fiz, não funciona, ou seja, ele cria as pastas, mas repete as pastas e move um arquivo apenas e os dmais arquivos ele coloca em uma pasta base, não a raiz, a primeira que ele cria.
procedure TForm1.InverteArquivo(Origem, Destino: String); var SR: TSearchRec; DDir,SDir, Dir: String; I: Integer; NmDir, NmExt, diret:string; posicao: boolean; begin SDir := IncludeTrailingPathDelimiter(Origem); DDir := IncludeTrailingPathDelimiter(Destino); if not DirectoryExists(DDir + 'TIF') then ForceDirectories(DDir + 'TIF'); if not DirectoryExists(DDir + 'PDF') then ForceDirectories(DDir + 'PDF'); if not DirectoryExists(DDir + 'TXT') then ForceDirectories(DDir + 'TXT'); I := FindFirst(SDir + '*.*', faAnyFile, SR); while I = 0 do begin if (SR.Name <> '.') and (SR.Name <> '..') and (SR.Attr <> faDirectory)then begin NmDir := UpperCase(Copy(ExtractFileExt(SDir + SR.Name),2,3)); DDir := DDir + IncludeTrailingPathDelimiter(NmDir); if NmDir = 'TIF' then begin //DDir := DDir + 'TIF'; if not DirectoryExists(Dir + Copy(SR.Name,1,4)) then begin ForceDirectories(DDir + Copy(SR.Name,1,4)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,1,4)); end; if not DirectoryExists(DDir + Copy(SR.Name,5,2)) then begin ForceDirectories(DDir + Copy(SR.Name,5,2)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,5,2)); end; if not DirectoryExists(DDir + Copy(SR.Name,7,2)) then begin ForceDirectories(DDir + Copy(SR.Name,7,2)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,7,2)); end; if not DirectoryExists(DDir + NomePasta(SR.Name,2)) then begin ForceDirectories(DDir + NomePasta(SR.Name,2)); DDir := DDir + IncludeTrailingPathDelimiter(NomePasta(SR.Name,2)); end; MoveFile(PChar(SDir + SR.Name),PChar(DDir + SR.Name)); DDir := DDir + IncludeTrailingPathDelimiter(NmDir); end else if NmDir = 'PDF'then begin if not DirectoryExists(Dir + Copy(SR.Name,1,4)) then begin ForceDirectories(DDir + Copy(SR.Name,1,4)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,1,4)); end; if not DirectoryExists(DDir + Copy(SR.Name,5,2)) then begin ForceDirectories(DDir + Copy(SR.Name,5,2)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,5,2)); end; if not DirectoryExists(DDir + Copy(SR.Name,7,2)) then begin ForceDirectories(DDir + Copy(SR.Name,7,2)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,7,2)); end; if not DirectoryExists(DDir + NomePasta(SR.Name,2)) then begin ForceDirectories(DDir + NomePasta(SR.Name,2)); DDir := DDir + IncludeTrailingPathDelimiter(NomePasta(SR.Name,2)); end; MoveFile(PChar(SDir + SR.Name),PChar(DDir + SR.Name)); DDir := DDir + IncludeTrailingPathDelimiter(NmDir); end else if NmDir = 'TXT' then begin if not DirectoryExists(Dir + Copy(SR.Name,1,4)) then begin ForceDirectories(DDir + Copy(SR.Name,1,4)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,1,4)); end; if not DirectoryExists(DDir + Copy(SR.Name,5,2)) then begin ForceDirectories(DDir + Copy(SR.Name,5,2)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,5,2)); end; if not DirectoryExists(DDir + Copy(SR.Name,7,2)) then begin ForceDirectories(DDir + Copy(SR.Name,7,2)); DDir := DDir + IncludeTrailingPathDelimiter(Copy(SR.Name,7,2)); end; if not DirectoryExists(DDir + NomePasta(SR.Name,2)) then begin ForceDirectories(DDir + NomePasta(SR.Name,2)); DDir := DDir + IncludeTrailingPathDelimiter(NomePasta(SR.Name,2)); end; MoveFile(PChar(SDir + SR.Name),PChar(DDir + SR.Name)); DDir := DDir + IncludeTrailingPathDelimiter(NmDir); end; end; //DDir := IncludeTrailingPathDelimiter(Destino); I := FindNext(SR); end; FindClose(SR); I := FindFirst(SDir + '*', faDirectory, SR); while I =0 do begin if (SR.Attr = faDirectory) and (SR.Name <> '.') and (SR.Name <> '..') then InverteArquivo(SDir + SR.Name,DDir); I := FindNext(SR); end; end;
Pjava
Curtidas 0
Respostas
Emerson Nascimento
25/07/2011
essa seu problema está se estendendo bastante...
explique exatamente o que você precisa.
explique exatamente o que você precisa.
GOSTEI 0
Adriano Bollas
25/07/2011
Olá, amigo vc poderia descrever exatamente o que vc deseja fazer, pq vou tentar resolver de outra forma ai posto o código pra vc, outra coisa, gostaria de saber qual é a versão do delphi que está usando.
GOSTEI 0