MoveFile não funciona
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
Curtidas 0
Respostas
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,
(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
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
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).
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
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