Fórum Estrutura de pastas não funciona como deveria #405552

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;