[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;