Carpeta y carpeta adentro

[Paulao]

Quiero crear una serie de carpetas una a dentro de otra y despues mover un archivo para esta carpeta. La regla es esta:
La primera regla es crear una carpeta con los 4 primer substring(Copy(String,1,4)). Bueno, despues, viene otra carpeta que es la posicion 5 y 6 y despues la posicion 7 y 8. Quando terminar todo, entonces si mueve el archivo para esta carpeta, ademas todos los archivos. Mi programa cria las carpetas, pero la repete las 3 ultimas y pone un archivo solo dentro della e los demas archivos pone en la primera carpeta. Mi codigo se quedo mui procedural y fue haciendo, haciendo y se quedo mui feo, pero feo mismo. Abajo mi codigo.

Código Delphi [-]
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;