o fileExits não da erro mais não salva

15/02/2023

0

procedure TFM_Backup.BtnBckClick(Sender: TObject);
const
origem = ''''C:\Padaria\Banco\PADARIA.FDB'''';
begin
dm.CONEXAO.Connected:=false;


if EdtLocal.Text = '''''''' then
begin
showmessage(''''Escolha um local antes de iniciar'''');
abort;
end;

if fileExists(EdtLocal.Text) then
Begin
if messagedlg(''''Existe um arquivo de backup nesse local deseja substitui-lo?'''',MtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
DeleteFile(EdtLocal.Text);

if CopyFile( origem, pchar(EdtLocal.Text), True) then
begin
showmessage(''''Backup realizado com sucesso!'''');
end;
end;
End
else
begin
if CopyFile( origem, pchar(EdtLocal.Text), True) then
begin
showmessage(''''Backup realizado com sucesso!'''');
end;
end;
dm.CONEXAO.Connected:= True;
close;
end;

procedure TFM_Backup.bt_abrirClick(Sender: TObject);
var
selDir : string;
begin
SelectDirectory(''''Selecione uma pasta'''', '''''''', selDir);
EdtLocal.text := seldir;
end;

o programa compila sem nenhum erro, escolho o diretorio onde quero salvar, e ao clicar no botão btnbck ele não da nenhum erro mas não salva o arquivo no diretorio escolhido.
Diego Ribeiro

Diego Ribeiro

Responder

Posts

17/02/2023

Emerson Nascimento

alterei um pouco o código.
procedure TFM_Backup.BtnBckClick(Sender: TObject);
const
	origem = 'C:\\Padaria\\Banco\\PADARIA.FDB';
var
	lContinua: boolean;
begin

	if EdtLocal.Text = '' then
		showmessage('Escolha um local antes de iniciar')
	else
	begin
		lContinua := (not FileExists(EdtLocal.Text)) or (messagedlg('Existe um arquivo de backup nesse local deseja substitui-lo?',MtConfirmation,[mbYes,mbNo],0)=mrYes);

		if lContinua then
		begin
			dm.CONEXAO.Connected := false;

			DeleteFile(EdtLocal.Text);

			if CopyFile(origem, pchar(EdtLocal.Text), True) then
				showmessage('Backup realizado com sucesso!');

			dm.CONEXAO.Connected := True;
			close;
		end;
	end;

end;

procedure TFM_Backup.bt_abrirClick(Sender: TObject);
var
	selDir : string;
begin
	SelectDirectory('Selecione uma pasta', '', selDir);
	EdtLocal.text := seldir;
end;

Sobre o problema relatado.... o arquivo está em uso? por acaso não está aberto no IBExpert, por exemplo?
Responder

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar