GARANTIR DESCONTO

Fórum Backup Restore firebird delphi em rede! #562190

12/09/2016

0

Oi pessoal estou tentando fazer um sistema para realizar o backup e restore do Banco de dados na rede eu comecei utilizando os componentes
TIBRestoreService, TIBBackupService só que não conseguir fazer funcionar em rede. e se for o caso atá fazer pelo winexec só que não entende direito como ele funca nesses casos...
Eduardo Silva

Eduardo Silva

Responder

Post mais votado

13/09/2016

Não é perfeito, mas aqui funciona bem.


var
   gParams: string;
   Sucessfull: boolean;
   gbak: string;
begin
   gbak := GetRegistryValue('SOFTWARE\\Firebird Project\\Firebird Server\\Instances', 'DefaultInstance') + 'bin\\gbak.exe';
   //gbak := vPathApp + 'gbak.exe';
   if not FileExists(gbak) then
   begin
      if not FileExists(vPathApp + 'gbak.exe') then
      begin
         Application.MessageBox('Ferramenta de backup não encontrada neste computador.', '', MB_ICONERROR + MB_OK);
         Exit;
      end;
      gbak := vPathApp + 'gbak.exe'; // precisa copiar o fbclient.dll e gbak.exe pro diretorio dos executáveis
   end;
   gParams := '-b -v -y ' + '"' + edt_LogFile.Text + '"' + ' ' + '-user ' + edt_usuario.Text + ' ' + '-password ' + edt_senha.Text + ' ' + '"' + edt_DatabaseFile.Text + '"' + ' ' + '"' + edt_BackupFile.Text + '"';
   if fileexists(edt_backupfile.Text) then
      DeleteFile(edt_backupfile.Text);
   if fileexists(edt_logfile.Text) then
      DeleteFile(edt_logfile.Text);
   SucessFull := ExecProcess(gbak, gParams, SW_HIDE, 'Backup', True);
   memobackuplog.Lines.Clear;
   if FileExists(edt_logfile.text) then
      memobackuplog.Lines.LoadFromFile(edt_logfile.text);
   if Sucessfull then
      ShowMessage('Backup realizado com SUCESSO.' + #13 + '[' + edt_BackupFile.Text + ']')
   else
      ShowMessage('Backup realizado com ERROS.');



form_backup_firebird.png

Raylan Zibel

Raylan Zibel
Responder

Gostei + 2

Mais Posts

12/09/2016

Raylan Zibel

Via linha de comando é simples:


## backup

gbak -b -v -user sysdba -pas masterkey servidor:c:\\banco\\banco.fdb c:\\backup\\backup.fbk

## restore

gbak -r -rep -v -user sysdba -pas masterkey c:\\backup\\backup.fbk servidor:c:\\banco\\banco.fdb

Responder

Gostei + 0

13/09/2016

Eduardo Silva

Raylan obrigado !
esses eu vi ate mesmo aqui no fórum só que o que estou me batendo é como por isso no Delphi 7 e no Delphi 10.1
Responder

Gostei + 0

13/09/2016

Eduardo Silva

blz vou testar aqui!
Precisa declarar algo no uses?
Responder

Gostei + 0

13/09/2016

Eduardo Silva

unit UBackupRestore;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, IBServices , DB, DBTables, ShellApi,
  Registry;
.
.
.
procedure TfrmBackupRestore.btnBackupClick(Sender: TObject);
var
   gParams    : string;
   Sucessfull : boolean;
   gbak       : string;
begin
  gbak := GetRegistryValue('SOFTWARE\\Firebird Project\\Firebird Server\\Instances', 'DefaultInstance') + 'bin\\gbak.exe';
  //gbak := vPathApp + 'gbak.exe';
  if not FileExists(gbak) then
  begin
    if not FileExists(vPathApp + 'gbak.exe') then
    begin
       Application.MessageBox('Ferramenta de backup não encontrada neste computador.', '', MB_ICONERROR + MB_OK);
       Exit;
    end;
    // precisa copiar o fbclient.dll e gbak.exe pro diretorio dos executáveis
    gbak := vPathApp + 'gbak.exe';
  end;
  gParams := '-g -b -v -y ' + '"' + edtBanco.Hint + '"' + ' ' + '-user SYSDBA -password pro690625'+ ' ' + '"' + edtBanco.Text + '"' + ' ' + '"' +vAqruivo+ '"';

  if fileexists(vAqruivo)      then DeleteFile(vAqruivo);

  if fileexists(edtBanco.Hint) then DeleteFile(edtBanco.Hint);

  SucessFull := ExecProcess(gbak, gParams, SW_HIDE, 'Backup', True);
  mmBackup.Lines.Clear;

  if FileExists(edtBanco.Hint) then mmBackup.Lines.LoadFromFile(edtBanco.Hint);

  if Sucessfull then
    ShowMessage('Backup realizado com SUCESSO.' + #13 + '[' +vAqruivo+ ']')
  else
    ShowMessage('Backup realizado com ERROS.');
end;

[Error] UBackupRestore.pas(105): Undeclared identifier: 'GetRegistryValue'



apresenta esses dois erros
Responder

Gostei + 0

13/09/2016

Eduardo Silva

[Error] UBackupRestore.pas(123): Undeclared identifier: 'ExecProcess'
Responder

Gostei + 0

14/09/2016

Raylan Zibel

function ExecProcess(FileName, Params: string; WindowState: Word; ProcessName: string = ''; Wait: Boolean =
   True): Boolean;
var
   SI: TStartupInfo;
   PI: TProcessInformation;
   CmdLine: string;
   Status: Cardinal;
begin
   CmdLine := FileName + ' ' + Params;
   FillChar(SI, SizeOf(SI), #0);
   with SI do
   begin
      cb := SizeOf(SI);
      dwFillAttribute := FOREGROUND_RED;
      if ProcessName <> '' then
         lpTitle := PChar(ProcessName);
      wShowWindow := WindowState;
      dwFlags := STARTF_USESHOWWINDOW + STARTF_USEFILLATTRIBUTE;
   end;
   Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
      nil, PChar(ExtractFilePath(FileName)), SI, PI);
   if Result then
   begin
      if Wait then
         WaitForSingleObject(PI.hProcess, INFINITE);
      {***********************************************}
      {alteração para capturar o codigo retornado pelo processo}
      {***********************************************}
      GetExitCodeProcess(PI.hProcess, status);
      Result := Status = 0;
      {***********************************************}
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
   end;
end;
Responder

Gostei + 0

14/09/2016

Raylan Zibel

unction TfrmBackup.GetRegistryValue(const AKey, AValue: string): string;
var
   Reg: TRegistry;
begin
   Reg := TRegistry.Create;
   try
      with Reg do
      begin
         RootKey := HKEY_LOCAL_MACHINE;
         if OpenKey(AKey, False) then
            if ValueExists(AValue) then
               Result := ReadString(AValue);
         CloseKey;
      end;
   finally
      FreeAndNil(Reg);
   end;
end;
Responder

Gostei + 0

14/09/2016

Eduardo Silva

Veja bem Eu fiz os teste e na função
  SucessFull := ExecProcess(gbak, gParams, SW_HIDE, 'Backup', True);

só retorna Falso e não faz o backup não sei onde estou errando...

procedure TfrmBackupRestore.btnBackupClick(Sender: TObject);
var
   gParams    : string;
   Sucessfull : boolean;
   gbak       : string;
begin
  mmBackup.Lines.Add(' ');
  mmBackup.Lines.Add('Backup iniciado em ' + DateToStr(Date) + ' - ' +  TimeToStr(Time));
  mmBackup.Lines.Add('Arquivo de origem:' + edtBanco.Text);
  mmBackup.Lines.Add(' ');
  gbak := GetRegistryValue('SOFTWARE\\Firebird Project\\Firebird Server\\Instances','DefaultInstance');
  gbak := gbak + 'bin\\gbak.exe';
  //gbak := vPathApp + 'gbak.exe';
  if not FileExists(gbak) then
  begin
    if not FileExists(vPathApp + 'gbak.exe') then
    begin
       Application.MessageBox('Ferramenta de backup não encontrada neste computador.', '', MB_ICONERROR + MB_OK);
       Exit;
    end;
    // precisa copiar o fbclient.dll e gbak.exe pro diretorio dos executáveis
    gbak := vPathApp + 'gbak.exe';
  end;     // <options>   -user <username> -password <password> <Log>       <source>          <destination>
  gParams := '-g -b -v -t -user SYSDBA -password pro690625 -y '+vLogfile+' '+edtBanco.Text+' '+vAqruivo;
  // Apaga o Fbk Antigo
  if fileexists(vAqruivo) then
    DeleteFile(vAqruivo);
  // Apaga o arquivo de Log antigo
  if fileexists(vLogfile) then
    DeleteFile(vLogfile);
  // Tive que procurar como fazia essa Função vou postar o codigo la em baixo 
  SucessFull := ExecProcess(gbak, gParams, SW_HIDE, 'Backup', True);  
  mmBackup.Lines.Add(' ');
  mmBackup.Lines.Add(' ');
  mmBackup.Lines.Add(' ');
  mmBackup.Lines.Add(' ');

  if FileExists(vLogfile) then
    mmBackup.Lines.LoadFromFile(vLogfile);

  if Sucessfull then
  begin
    mmBackup.Lines.Add('Backup realizado com SUCESSO.' + #13 + '[' +vAqruivo+ ']');
    ShowMessage('Backup realizado com SUCESSO.' + #13 + '[' +vAqruivo+ ']');
  end else
  begin
    mmBackup.Lines.Add('Backup NÃO foi realizado ERROS.');
    ShowMessage('Backup NÃO foi realizado ERROS.');
  end;


ExecProcess ficou Assim.
function TfrmBackupRestore.ExecProcess(FileName, Params: String;
  WindowState: Word; ProcessName: String; Wait: Boolean): Boolean;
var
  SI      : TStartupInfo;
  PI      : TProcessInformation;
  CmdLine : String;
//  Status  : Cardinal;
begin
  CmdLine:= FileName+''+Params;
  FillChar(SI, SizeOf(SI), #0);
  with SI do
  begin
    cb              := SizeOf(SI);
    dwFillAttribute := FOREGROUND_RED;
    if ProcessName <> '' then lpTitle := PChar(ProcessName);
    wShowWindow     := WindowState;
    dwFlags         := STARTF_USESHOWWINDOW + STARTF_USEFILLATTRIBUTE;
  end;
  Result := CreateProcess(nil,                                                  // lpApplicationName
                          PChar(CmdLine),                                       // lpCommandLine
                          nil,                                                  // lpProcessAttributes
                          nil,                                                  // lpThreadAttributes
                          False,                                                // bInheritHandles
                          CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,          // dwCreationFlags
                          nil,                                                  // lpEnvironment
                          PChar(ExtractFilePath(FileName)),                     // lpCurrentDirectory
                          SI,                                                   // lpStartupInfo
                          PI);                                                  // lpProcessInformation

  if Result then
  begin
    if Wait then
      WaitForSingleObject(PI.hProcess, INFINITE);

    CloseHandle(PI.hProcess);
    CloseHandle(PI.hThread);
  end;
Responder

Gostei + 0

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

Aceitar