MoveFile não funciona

Delphi

15/07/2011

PEGUEI essa rotina aí abaixo e troquei de copiar para mover. Não funciona, agora se eu coloco assim: MoveFile(PChar('D:\Origem\Teste.tif'),PChar('C:\Destino\Teste.tif')), funciona, mas quando coloco num Loop For e tento executar esse MoveFile, não funciona. Mas acho que não é por causa do LOOP, pois peguei um arquivo dentro desse diretório e tento fazer o Move não funciona, mas se troco de diretório, aí funciona.  
unit uMain;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, FileCtrl, ComCtrls, uFuncao;
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));
    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.
Pjava

Pjava

Curtidas 0

Respostas

Thiago Mury

Thiago Mury

15/07/2011

PJava, onde você monta o caminho de origem e destino
(MoveFile(PChar(SDir+DSepar+FName),PChar(DDir+DSepar+FName));)
aconselho a dar uma mensagem com esses caminhos para verificar se os caminhos são válidos.
Att,
GOSTEI 0
Pjava

Pjava

15/07/2011

Debugando o projeto, esses caminhos estão corretos, mas alguma coisa pode estar intervindo aí. Como falei, não consigo mover desse diretório, mas se eu mudar o arquivo para outro funciona(na mão). Esse cara: SDir+DSepar+FName, está vindo assim: D:\NAC\19900711-111-NAC-0500-NOT.TIF, é dessa forma que está vindo os arquivo e para mim está correto.
GOSTEI 0
Emerson Nascimento

Emerson Nascimento

15/07/2011

me baseando na sua rotina, proponho esta:

var
  FName,SDir,DDir:string;
  i:integer;
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(SourceDirectory.Directory);
    DDir := IncludeTrailingPathDelimiter(DestinationDirectory.Directory);

    for i := 0 to SourceFiles.Items.Count-1 do
    begin
      if SourceFiles.Selected[i] then
      begin
        FName := ExtractFileName(SourceFiles.Items[i]);

        if FileExists(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;

        // Dest := FileCreate(DDir+DSepar+FName); { create output file}
        MoveFile(PChar(SDir+FName),PChar(DDir+FName));
      end;

      ProgressBar.StepIt;
      Application.ProcessMessages;
    end;
  finally
    ProgressBar.Position := 0;
    CopiaArquivo.Caption := '';
    SourceFiles.Update;
    DestinationFiles.Update;
    Screen.Cursor := crDefault;
  end;
end;

tirei tudo que dizia respeito ao procedimento de cópia.
nos meus testes tudo funcionou perfeitamente (veja também se o seu arquivo não está protegido).

GOSTEI 0
Pjava

Pjava

15/07/2011

Olá, Emerson, funcionou beleza. Acontece que dessa forma o Cliente não quiz, pois tem que selecionar a pasta em que estão os arquivos. Fiz umas mudanças no seu código, como retirar o SelectedItem, pois tem que mover todos os arquivos sem seleção. Acontece que o cliente quer apartir de uma pasta base. bem, então criei uma busca com TSearchRec(FindFirst) unto com seu código, com algumas variações. Não estou conseguindo resolver, pois a busca entra nas pastas e antes de pegar o arquivo ele sai do loop(Repeast..Until). Fiz assim e não está funfando. Tá meio bagunçado, porque ainda não terminei. Abaixo os códigos.  
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;
GOSTEI 0
POSTAR