Mover archivos y deletar carpeta

[Paulao]

Ola todos. Hizo una forma y funciono, pero mi cliente cambio nuevamente y ahora el quer que tenga una carpeta base y el sistema haria todo lo demas. Hizo el escogendo una Carpeta onde estan los archivos y entonces haria la moveda. Bueno, que pasa es que ahora no lo hace. Hizo un FindFirst, para entrar en todas las carpetas y buscar los archivos. Hizo dentro de un Repeat..Until, pero el sale del Loop antes de acuentrar los archivos. Abajo mis codigos(ambos) la parte que está comentada, si saco los SearchRec, funciona bien.

Código Delphi [-]
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  FName,SDir,DDir,dir, Mask:string;
  i:integer;
  SR: TSearchRec;
  Posicao: Byte;
begin
  (*if (SourceDrive.Drive = DestinationDrive.Drive) and
    (SourceDirectory.Directory = DestinationDirectory.Directory) then
  begin
    ShowMessage('Não é possível mover para o mesmo diretório!');
    exit;
  end; *)
  //ProgressBar.Max := SourceFiles.Items.Count;
  //ProgressBar.Position := 0;
  try
    Screen.Cursor:=crHourGlass;
    SDir := IncludeTrailingPathDelimiter(edtOrigem.Directory);
    SourceFiles.SelectAll;
    //for i := 0 to SourceFiles.Items.Count-1 do
   // begin
      //if SourceFiles.Selected[i] then
      //begin
        Mask := SDir + '*.*';
        if FindFirst(Mask, faDirectory, SR) = 0 then
        repeat
        DDir := IncludeTrailingPathDelimiter(edtDestino.Directory);
        if (SR.Name <> '.') and (SR.Name <> '..')then
        //FName := ExtractFileName(SourceFiles.Items[i]);
        begin
        FName := SR.Name;
        Posicao := Pos('.tif', FName);
        {if File/Exists(DDir+FName) then
          case WriteOpt.ItemIndex of
            1: case MessageDlg('O Arquivo '+FName+' já existe.'#13#10'Grava por cima?', mtConfirmation,
                 [mbYes,mbNo,mbAll],0) of
                 mrNo: Continue; //Continue for ... loop
                 mrAll:WriteOpt.ItemIndex:=0; //Always overwrite
              end;
            2: continue;
          end;  }
        //CopiaArquivo.Caption:='Movendo arquivo: ' + FName;
        //CopiaArquivo.Update;
        if Posicao > 0 then
        begin
          ForceDirectories(DDir + NomePasta(FName));
          DDir := DDir + IncludeTrailingPathDelimiter(NomePasta(FName));
          // Dest := FileCreate(DDir+DSepar+FName); { create output file}
          MoveFile(PChar(SDir+FName),PChar(DDir+FName));
        end;
      end;
      until FindNext(SR) <> 0;
      ProgressBar.StepIt;
      Application.ProcessMessages;
    //end;
  finally
    ProgressBar.Position := 0;
    CopiaArquivo.Caption := '';
    SourceFiles.Update;
    DestinationFiles.Update;
    Screen.Cursor := crDefault;
  end;
end;

[Paulao]

Tengo que hacer una rutina, que entrará en diversas carpetas, mover este archivo en una sola carpeta y elimine la carpeta. Es algo parecido a esto. Tengo una carpeta llamada OK. Dentro de esta carpeta hay otra con el nombre de cada mes (01,02,03). En el interior es de 1.000 carpetas, mas o menos, cada una con un solo archivo dentro de ella. Son estas carpetas, que debería obtener el archivo (. TIF) y enviado a un solo directorio y luego eliminar estas carpetas, no para las carpetas vacías, puesto que ya no se utiliza. Esta búsqueda debe ir en todas las carpetas que contienen la carpeta (OK) y buscar archivos con extensión .TIF y ponerse en movimiento y eliminación de carpetas. Uso FindFirst, pero no entra en todas las carpetas. En alguna situación el entra en bucle sin fin.

[Casimiro Noteví]

Pues te informo igualmente, en este sitio explica claramente el manejo de findfirst, findnext, etc.

[Paulao]

Es que aca en mi empresa donde trabajo, el proxy no estas permitindo que si abra este link. Yo estoy lejo de mi casa, entonces yo no voy todos los dias para mi casa, solo el fin de semana y donde me quedo durante la semana, estoy sin conexion. Tengo que compra un 3G, pero solo quando receber mi sueldo. Entonces, internet mismo, solo aca en la empresa. Saigo tarde de la noche y no consigo ir a un Cyber para buscar estas cosas, pues llego mui cansado en mi casa. Por esto no consigo abrir este link. Si tener otra solucion, agradezco mucho. Tengo una solucion, pero si hay muchas carpetas, el sale del loop.

[Casimiro Noteví]

Pues no entiendo por qué te cierran el acceso a sitios como delphibasics, si es una herramienta de información para el trabajo.
En fin, a ver si puedes ver la imagen:

[Paulao]

Ya resolvi mi problema com el MoveFile. O que pasa ahora es que yo no consigo deletar las carpetas vacia. No me da ningun error, pero no deleta, apaga. Abajo la rutina para apagar las carpetas.

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

[Casimiro Noteví]

Cierro este hilo porque has abierto otro para continuarlo.