BackUp Restore Automático

[buitrago]

Es increhible, cuando veo los forums, me doy cuanta que este mundo no ta to perdió....

Gracias por el código, ha sido muy util.

Saludos
Fernando Buitrago

[sowei]

Gracias !

Muy útil !

[cesarsoftware]

Buenas, siguiendo a guillotmarc, añadir la que uso yo con la diferencia que no hace falta copiar el gbak sino que lo busca donde este instalado y ya de paso hace una restauracion porque gbak deja una copia comprimida. De paso os mando una funcion para ejecutar programas externos con un poco mas de control sobre la ejecucion.

Código Delphi [-]
function SacaRutaFireBird(): string;
var
  Reg: TRegistry;
  Resultado: string;
begin
  Resultado := '';
  Reg := Tregistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
     if Reg.OpenKey(
       '\SOFTWARE\Firebird Project\Firebird Server\Instances', True) then
     begin
       Resultado := Reg.Readstring('DefaultInstance');
       Reg.CloseKey;
     end;
  finally
    Reg.Free;
  end;
  Result := Resultado;
end;

function Ejecuta(espera: boolean; directorio, programa, parametros: string): cardinal;
var
  Info: TShellExecuteInfo;
  pInfo: PShellExecuteInfo;
  WaitCode: DWord;
  Handle: THandle;
  msg: ansistring;
begin
  Handle := 0;
  {Puntero a Info}
  pInfo := @Info;
  {Rellenamos Info}
  with Info do
  begin
    cbSize := SizeOf(Info);
    fMask := SEE_MASK_NOCLOSEPROCESS;// + SEE_MASK_IDLIST +
    wnd := Handle;
    lpVerb := 'open';
    lpFile := PChar(programa);
    {Parametros al ejecutable}
    lpParameters := PChar(parametros);
    lpDirectory := PChar(directorio);
    nShow := SW_ShowNormal;
    hInstApp := 0;
    lpIDList := nil;
  end;
  {Ejecutamos}
  if ShellExecuteEx(pInfo) = True then
  begin
    Result := pInfo.hProcess;
    {Esperamos que termine}
    if espera = False then
      Exit;
    repeat
      WaitCode := WaitForSingleObject(Info.hProcess, 500);
      Application.ProcessMessages;
    until (WaitCode <> WAIT_TIMEOUT);
  end
  else
  begin
    case pInfo.hInstApp of
      ERROR_FILE_NOT_FOUND: msg := 'The specified file was not found.';
      ERROR_PATH_NOT_FOUND: msg := 'The specified path was not found.';
      ERROR_DDE_FAIL: msg := 'The Dynamic Data Exchange (DDE) transaction failed.';
      ERROR_NO_ASSOCIATION: msg := 'There is no application associated with the given file name extension.';
      ERROR_ACCESS_DENIED: msg := 'Access to the specified file is denied.';
      ERROR_DLL_NOT_FOUND: msg := 'One of the library files necessary to run the application can"t be found.';
      ERROR_CANCELLED: msg := 'The function prompted the user for additional information, but the user canceled the request.';
      ERROR_NOT_ENOUGH_MEMORY: msg := 'There is not enough memory to perform the specified action.';
      ERROR_SHARING_VIOLATION: msg := 'A sharing violation occurred.';
    end;
    Result := 0;
  end;
end;

procedure TFormCopiarConfig.CopiaBBDD();
var
  rutaFireBird, user, dirBBDD, copiaBBDD, restauraBBDD, cadena, fn, hn: string;
  programa, parametros: string;
begin
  rutaFireBird := SacaRutaFireBird();
  if rutaFireBird = '' then
  begin
    Application.MessageBox('No se ha localizado al motor FireBird',
                           'Atención', MB_ICONWARNING);
    Exit;
  end;
  LabelFile.Caption := 'Copiando Base de Datos, espera a que terminar.';
  LabelFile.Refresh;
  rutaFireBird := rutaFireBird + 'bin\';
  programa := 'gbak.exe';
  dirBBDD := ' "' + BBDDservidorBase + ':' + BBDDdataBase + '"';
  cadena := FechaNacional;
  fn := Copy(cadena, 7, 4) + Copy(cadena, 4, 2) + Copy(cadena, 1, 2);
  cadena := HoraNacional;
  hn := Copy(cadena, 1, 2) + Copy(cadena, 4, 2) + Copy(cadena, 7, 2);
  copiaBBDD := ' "' + EditDestino.Text + fn + '_' + hn + '_' + 'CSerp.fdb' + '"';
  user := ' -v -user SYSDBA -pas masterkey';
  parametros := ' -b ' + dirBBDD + copiaBBDD + user;
  Ejecuta(True, rutaFireBird, programa, parametros);
  LabelFile.Caption := 'Restaurando copia ...';
  LabelFile.Refresh;
  restauraBBDD := ' "' + EditDestino.Text + fn + '_' + hn + '_' + 'CSerp.fdb' + '"';
  parametros := ' -c ' + copiaBBDD + restauraBBDD + user;
  Ejecuta(True, rutaFireBird, programa, parametros);
  LabelFile.Caption := 'Copia terminada.';
  LabelFile.Refresh;
end;

De nada

[[Al González]]

Empezado por cesarsoftware

[...] os mando una funcion [...]

Código Delphi [-]
function SacaRutaFireBird(): string;
var
  Reg: TRegistry;
  Resultado: string;
begin
  Resultado := '';
  Reg := Tregistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
     if Reg.OpenKey(
       '\SOFTWARE\Firebird Project\Firebird Server\Instances', True) then
     begin
       Resultado := Reg.Readstring('DefaultInstance');
       Reg.CloseKey;
     end;
  finally
    Reg.Free;
  end;
  Result := Resultado;
end;

[...]

De nada

Hola César.

Sin menoscabo de las útiles rutinas que nos regalas, viendo la primera de ellas me permito hacer una versión un poco mejorada:

Código Delphi [-]
Function FirebirdDir :String;
Begin
  With TRegistry.Create Do
    Try
      RootKey := HKey_Local_Machine;

      If OpenKeyReadOnly (
      '\Software\Firebird Project\Firebird Server\Instances') Then
        Result := ReadString ('DefaultInstance')
      Else
        Result := '';
    Finally
      Free;
    End;
End;

Saludos.

P.D. Aprovecho para saludar a Marc y Raúl (segundo y tercer mensaje), donde quiera que se encuentren después de tantos años de intenso Delphi.

[cesarsoftware]

Hola Al, es cierto si se usa openkeyreadonly da menos problemas en caso de que el registro este bloqueado al usuario.

Saludos.