Mover archivos y deletar carpeta
 

Uso MoveFile, para mover archivo de una carpeta para otra, pero no estas funcionando.
Como usar el MoveFile de forma corecta?

Hola Paulao.

Ejemplo:

Código Delphi [-]
   MoveFile('C:\ARCHIVO.TXT', 'D:\PRUEBA\ARCHIVO.TXT');
   // o también
   MoveFile('C:\ARCHIVO.TXT', 'D:\PRUEBA\OTRONOMBRE.@@@');

Saludos.

Ecfisa, una pregunta. Tengo que poner el Path + el archivo en la carpeta de destino, o solo pongo el Path completo, pero sin el archivo.

Hola Paulao.

Tenes que poner: Path + Nombre_de_Archivo + Extensión_de archivo

Si utilizas variables, sería:

Código Delphi [-]
var
  Ori,Des: string;
begin
  Ori:= 'C:\PRUEBA.TXT';
  Des:= 'E:\PRUEBA.TXT';
  MoveFile(PChar(Ori), PChar(Des));
end;

Saludos.

Bueno, ya hizo y funciono. Era la extencion que faltava. Pero, ahora, quando yo deletar el archivo, tengo que deletar la carpeta tambien. Esto voy a ver ahora como lo hago.

Hola Paolao, ¿con deletar te refieres a borrar el directorio?, si tu directorio (carpeta) esta vacío puedes utilizar RemoveDir.

Código Delphi [-]
 RemoveDir('c:\path\directorio');

Saluditos

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

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.

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

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;

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.

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

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.

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:

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;

Cierro este hilo porque has abierto otro para continuarlo.