Mover archivos y deletar carpeta

[*Caro*]

Hola de nuevo, para mover el directorio con todos sus archivos lo puedes hacer de esta forma:

Código Delphi [-]
function MoveDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;
 
//llamada
var
Origen, Destino : STring;
begin
 Origen := 'c:\path\origen';
 Destino := 'c:\path\destino';
 if MoveDir(Origen, Destino) then
  showmessage('Ok');

si el directorio destino no existe, te lo renombra.

Para borrar, aunque el directorio no este vacío:

Código Delphi [-]
function DelDir(dir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_DELETE;
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
    pFrom  := PChar(dir + #0);
  end;
  Result := (0 = ShFileOperation(fos));
end;
 
//llamada
 if DelDir('c:\path\directorio') then
  showmessage('Ok');

Todo esto lo he sacado de aquí, revisa esa página.

Saluditos

[Paulao]

Ola de nuevo. No es mover el directorio con los archivos. Es Crear un directorio y mover el archivo para el y despues el otro Directorio crear y mover otro archivo. Si tengo 1.000 archivos, tengo que crear 1.000 directorios y en cada uno tener solamente un archivo. QWue pasa es que no estas movendo. Si paso asi:
MoveFile('D:\NAC\test.tif','D\Destino\test.tif'), funciona, pero si pongo en un Loop For, para ir descargando para cada archivo que el encuentrar, entonces no funciona. Los archivos acá son grandes, y no consigo anejar a este forum, si no los enviaria para q usteds analicen. Pero abajo mis codigos. Este codigo un amigo me lo envio y yo hizo una adaptacion para mover los archivos.

Código Delphi [-]
type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    ProgressBar: TProgressBar;
    SourceDrive: TDriveComboBox;
    SourceDirectory: TDirectoryListBox;
    DestinationFiles: TFileListBox;
    CopiaArquivo: TLabel;
    DestinationDirectory: TDirectoryListBox;
    DestinationDrive: TDriveComboBox;
    SourceFiles: TFileListBox;
    Origem: TLabel;
    Destino: TLabel;
    WriteOpt: TRadioGroup;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    fCopia: TCopiaArquivo;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  FName,SDir,DDir:string;
  CopyBuffer: Pointer; { buffer for copying }
  TimeStamp, BytesCopied: Longint;
  Source, Dest,dir_atual: Integer; { handles }
  i,incre:integer;
  SSepar,DSepar:string;
  label TryAgain,TryAgain2,TryAgain3,TryAgain4; //Did I really use labels ????!!!
  const
    ChunkSize: Longint = 32768;
begin
  if (SourceDrive.Drive = DestinationDrive.Drive) and
    (SourceDirectory.Directory = DestinationDirectory.Directory) then
    ShowMessage('Não é possível copiar para o mesmo diretório!')
  else
  begin
  try
    Screen.Cursor:=crHourGlass;
    SDir := SourceDirectory.Directory;
    DDir := DestinationDirectory.Directory;
    if SDir[length(SDir)] = '\' then
      SSepar := ''
    else
      SSepar := '\';
    if DDir[length(DDir)] = '\' then
      DSepar := ''
    else
      DSepar := '\';
    GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  for i := 0 to SourceFiles.Items.Count-1 do
  begin
    FName:=ExtractFileName(SourceFiles.Items[i]);
    ProgressBar.Position:=trunc(i*100/SourceFiles.Items.Count);
    CopiaArquivo.Caption:='Copiando arquivo: ' + FName;
    CopiaArquivo.Update;
    TimeStamp := FileAge(FName); { get source's time stamp }
    TryAgain:
    Source := FileOpen(SDir+SSepar+FName, fmShareDenyWrite); { open source file }
    if Source < 0 then
    case MessageDlg('Erro de Leitura de Arquivo'#13#10+FName,mtError,
      [mbAbort,mbRetry,mbIgnore],0) of
      mrAbort:Break; //Exit for... loop
      mrRetry:GoTo TryAgain;
      mrIgnore:Continue;//Continue for... loop
    end;
    if WriteOpt.ItemIndex = 1 then //See if there is an old file
      if FileExists(DDir+DSepar+FName) then
        case MessageDlg('O Arquivo '+FName+' já existe.'#13#10'Grava por cima?', mtConfirmation,
          [mbYes,mbNo,mbAll],0) of
          mrYes:begin end;
          mrNo: Continue; //Continue for ... loop
          mrAll:WriteOpt.ItemIndex:=0; //Always overwrite
        end;
    TryAgain2:
   // Dest := FileCreate(DDir+DSepar+FName); { create output file}
    MoveFile(PChar(SDir+DSepar+FName),PChar(DDir+DSepar+FName));//Aqui movo
    if Dest < 0 then
      case MessageDlg('Erro para criar '+FName,mtError, [mbAbort,mbRetry,mbIgnore],0) of
        mrAbort:Break; //Exit for... loop
        mrRetry:GoTo TryAgain2;
        mrIgnore:Continue;//Continue for... loop
      end;
    try
      repeat
        TryAgain3:
        {$I-}
        BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
        {$I+}
      if IOResult <> 0 then
        case MessageDlg('Erro ao ler arquivo'#13#10+FName,mtError,
          [mbAbort,mbRetry,mbIgnore],0) of
          mrAbort:Break; //Exit repeat... loop
          mrRetry:GoTo TryAgain3;
          mrIgnore:Continue;//Continue repeat... loop
        end;
      if BytesCopied > 0 then
      begin{ if we read anything... }
        TryAgain4:
        {$I-}
        //FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
        {$I+}

        if IOResult <> 0 then
          case MessageDlg('Erro ao gravar arquivo'#13#10+FName,mtError,
            [mbAbort,mbRetry,mbIgnore],0) of
            mrAbort:Break; //Exit repeat... loop
            mrRetry:GoTo TryAgain4;
           mrIgnore:Continue;//Continue repeat... loop
          end;
      end;
      until BytesCopied < ChunkSize; { until we run out of chunks }
    finally
      FileSetDate(Dest, TimeStamp);
      FileClose(Dest); { close the destination file }
    end;
  end;
  finally
    ProgressBar.Position := 0;
    CopiaArquivo.Caption := '';
    DestinationFiles.Update;
    FreeMem(CopyBuffer, ChunkSize);
    Screen.Cursor := crDefault;
  end;
  end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
//  fCopia.MoveArquivos(SourceFiles, DestinationFiles);
MoveFile(PChar('D:\Teste_Destino\19900712-35400-NAC-0001-NOT.tif'),PChar('D:\Teste_SGI\19900712-35400-NAC-0001-NOT.tif'))
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  fCopia := TCopiaArquivo.Create;
end;
end.

[*Caro*]

Hola Paulao, prueba de esta forma:

Código Delphi [-]
var
 Origen, Destino : String;
 DirDestino, DirNuevo, NombreDir, Archivo, PathNuevo : String;
begin
  Ind := 0;
  NombreDir := 'Directorio';
  for i := 0 to SourceFiles.Items.Count-1 do
  begin
   Archivo := SourceFiles.Items[i];
   DirDestino := DestinationDirectory.Directory;
   Inc(Ind);
   DirNuevo := NombreDir+IntToStr(Ind);
   PathNuevo := DirDestino+'\'+DirNuevo;
   if Not DirectoryExists(PathNuevo) then
    begin
     MkDir(PathNuevo);//si el directorio no existe, creamos uno nuevo
     Origen := SourceDirectory.Directory+'\'+Archivo;
     Destino := PathNuevo+'\'+Archivo;
     MoveFile(PChar(Origen),PChar(Destino));
    end;
  end;

Saluditos

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