Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Bases de datos > Firebird e Interbase
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 26-03-2013
sowei sowei is offline
Miembro
 
Registrado: abr 2010
Posts: 21
Poder: 0
sowei Va por buen camino
Gracias !

Muy útil !
Responder Con Cita
  #2  
Antiguo 27-03-2013
Avatar de cesarsoftware
cesarsoftware cesarsoftware is offline
Miembro
 
Registrado: nov 2006
Posts: 241
Poder: 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
  #3  
Antiguo 28-03-2013
Avatar de Al González
[Al González] Al González is offline
In .pas since 1991
 
Registrado: may 2003
Posts: 5.604
Poder: 30
Al González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en brutoAl González Es un diamante en bruto
Cita:
Empezado por cesarsoftware Ver Mensaje
[...] 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.

Última edición por Al González fecha: 28-03-2013 a las 00:06:29.
Responder Con Cita
  #4  
Antiguo 28-03-2013
Avatar de cesarsoftware
cesarsoftware cesarsoftware is offline
Miembro
 
Registrado: nov 2006
Posts: 241
Poder: 18
cesarsoftware Va por buen camino
Hola Al, es cierto si se usa openkeyreadonly da menos problemas en caso de que el registro este bloqueado al usuario.

Saludos.
__________________
Disfruta de la vida ahora, vas a estar muerto mucho tiempo.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 20:15:01.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi