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;
pInfo := @Info;
with Info do
begin
cbSize := SizeOf(Info);
fMask := SEE_MASK_NOCLOSEPROCESS; wnd := Handle;
lpVerb := 'open';
lpFile := PChar(programa);
lpParameters := PChar(parametros);
lpDirectory := PChar(directorio);
nShow := SW_ShowNormal;
hInstApp := 0;
lpIDList := nil;
end;
if ShellExecuteEx(pInfo) = True then
begin
Result := pInfo.hProcess;
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