Ver Mensaje Individual
  #7  
Antiguo 27-03-2013
Avatar de cesarsoftware
cesarsoftware cesarsoftware is offline
Miembro
 
Registrado: nov 2006
Posts: 241
Reputación: 18
cesarsoftware Va por buen camino
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
__________________
Disfruta de la vida ahora, vas a estar muerto mucho tiempo.

Última edición por cesarsoftware fecha: 27-03-2013 a las 21:04:52.
Responder Con Cita