Alguien sabe como hacer un ShotDown a Firebird 1.51????

[AGAG4]

Alguien sabe como hacer un ShotDown y volver a Abrir Firebird 1.51 por Código Delphi????

Agradezco cualquier comentario.

[roman]

Yo no, pero cadetill sí (http://www.clubdelphi.com/foros/showthread.php?t=10363&highlight=interbase+arrancar)

// Saludos

[AGAG4]

Gracias Roman, pero ya lo había visto , el inconveniente es que se le olvido poner el cuerpo de las Siguientes Funciones:

function GetEnumPriv : boolean;
function GetSysDirectory : string;
function GetServices(sMachine: string; sServices: TStrings): boolean;
function IsNT : boolean;
function IsAdmin: Boolean;
function Display_status(status_code: DWORD) : string;
function ExistService(sMachine, sService : string) : boolean;
function ProcessRunning(Proces: string): boolean;
function ServiceCreate(sMachine, sService, sDisplayName, sBinFile : string;
StartType : integer) : boolean;


ó bien en donde los puedo localizar????
Que tenga buen día.

[AGAG4]

Ya los Encontre y lo muestro por si a alguien le sea de utilidad....

unit FireBirdUtils;


interface
function ServiceStart(sMachine, sService : string ) : boolean;
function ServiceStop(sMachine, sService : string ) : boolean;
function IsNT: boolean;
function FireBirdInstalled : boolean;
function InterbaseInstalled : boolean;
function GetSysDirectory: string;
function StartInterbase: boolean;
function GetInterbaseGuardianFile: string;
function ShutDownInterbase: boolean;
function IsWinNT: Boolean;
function IsServerRunning: Boolean;
function InterbaseRunning : boolean;
function GetServerVersion: string;
function GetServerVersionInsRun: string;

implementation
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinSvc, StdCtrls, registry,IBServices;
Const
{Constante para FireBird}
FB_ServerExeName = 'fbserver.exe';
FB_RegKey = '\Software\Firebird Project\Firebird Server\Instances';
IB_RegKey = '\Software\Borland\InterBase\CurrentVersion';
FB_IB_RootDir = 'RootDirectory';
FB_IB_ServerDir = 'ServerDirectory';
FB_IB_ServerClass = 'IB_Server';
FB_ServerClass = 'FB_Server';
FB_IB_ServiceName = 'InterBaseServer';
FB_AutoStartName = 'FirebirdServer';
IB_Version = 'Version';
FB_Version = 'Version';
FDBAName = 'SYSDBA';
FDBAPwd = 'masterkey';
FDBALoginPrompt = false;

var
VersionInfoAvailable: boolean;
FIBInfo: TIBServerProperties;
FServer, FDatabaseName: string;
FUserName, FUserPwd: string;
FCharSet: string;
FSQLDialect: Integer;
FProtocol: TProtocol;
LastDBInfoRefresh: TDateTime;

function GetServerVersionInsRun: string;
begin
result := '';
try
result := GetServerVersion;
except result := '';
end;
end;

function RefreshIBinfo(AnOption: TPropertyOption): boolean;
begin
{créé le composant à la volée}
if FIBInfo = nil then FIBInfo := TIBServerProperties.Create(nil);
{effectue la restauration}
with FIBInfo, Params do
try
ServerName := FServer;
if FServer = '' then Protocol := Local else Protocol := FProtocol;
Clear;
Add('user_name=' + FDBAName);
Add('password=' + FDBAPwd);
LoginPrompt := FDBALoginPrompt;
Options := [AnOption];
Active := True;
case AnOption of
Database:
begin
FetchDatabaseInfo;
LastDBInfoRefresh := Now;
end;
ConfigParameters: FetchConfigParams;
Version: FetchVersionInfo;
end;
Active := False;
Result := True;
except
Result := False;
end;
end;

//—————————————————————————————————————————————————————————————————————————————
// Versión FireBird
//—————————————————————————————————————————————————————————————————————————————

function GetServerVersion: string;
begin
if not VersionInfoAvailable then
VersionInfoAvailable := RefreshIBInfo(Version);
if VersionInfoAvailable then
Result := FIBInfo.VersionInfo.ServerVersion
else Result := '';
end;

//—————————————————————————————————————————————————————————————————————————————
// Parar un servicio en NT
//—————————————————————————————————————————————————————————————————————————————
function ServiceStop(sMachine, sService : string ) : boolean;
var schm, schs : SC_Handle;
ss : TServiceStatus;
dwChkP : DWord;
begin
schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
if(schm > 0)then begin
schs := OpenService(schm,PChar(sService),SERVICE_STOP or SERVICE_QUERY_STATUS);
if(schs > 0)then begin
if (ControlService(schs,SERVICE_CONTROL_STOP,ss)) then begin
if (QueryServiceStatus(schs,ss)) then begin
while (SERVICE_STOPPED <> ss.dwCurrentState) do begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
if (not QueryServiceStatus(schs,ss))then begin
break;
end;
if (ss.dwCheckPoint < dwChkP) then begin
break;
end;
end;
end;
end;
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := (SERVICE_STOPPED = ss.dwCurrentState);
end;

//—————————————————————————————————————————————————————————————————————————————
// Arrancar un servicio en NT
//—————————————————————————————————————————————————————————————————————————————
function ServiceStart(sMachine, sService : string ) : boolean;
var schm, schs : SC_Handle;
ss : TServiceStatus;
psTemp : PChar;
dwChkP : DWord;
begin
ss.dwCurrentState := 0;
schm := OpenSCManager(PChar(sMachine),Nil,SC_MANAGER_CONNECT);
if(schm > 0)then begin
schs := OpenService(schm,PChar(sService),SERVICE_START or SERVICE_QUERY_STATUS);
if (schs > 0) then begin
psTemp := Nil;
if (StartService(schs,0,psTemp)) then begin
if (QueryServiceStatus(schs,ss)) then begin
while (SERVICE_RUNNING <> ss.dwCurrentState) do begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
if (not QueryServiceStatus(schs,ss)) then begin
break;
end;
if (ss.dwCheckPoint < dwChkP) then begin
break;
end;
end;
end;
end;
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := SERVICE_RUNNING = ss.dwCurrentState;
end;

//—————————————————————————————————————————————————————————————————————————————
// Saber si FireBird está en marcha
//—————————————————————————————————————————————————————————————————————————————

function InterbaseRunning : boolean;
begin
result := boolean(FindWindow('fbServer','FireBird Server')
or FindWindow('IB_Guard','FireBird Guardian'));
end;
//—————————————————————————————————————————————————————————————————————————————
// Returns true if applications runs on NT/2000
//—————————————————————————————————————————————————————————————————————————————
function IsNT: boolean;
var osv: TOSVERSIONINFO;
begin
fillchar(osv, sizeof(TOSVERSIONINFO), 0);
osv.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
GetVersionEx(osv);
if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
result := true
else result := false;
end;

function IsServerRunning: Boolean;
//try to find the Firebird server window
begin
Result := (FindWindow({FB_IB_ServerClass}FB_ServerClass, nil) <> 0);
end;

function IsWinNT: Boolean;
begin
Result := (Win32Platform = VER_PLATFORM_WIN32_NT);
end;

//—————————————————————————————————————————————————————————————————————————————
// Shuts down Interbase
//—————————————————————————————————————————————————————————————————————————————
function ShutDownInterbase: boolean;
var IBSRVHandle, IBGARHandle: THandle;
begin
if IsNT then
begin
result := ServiceStop('', 'InterBaseGuardian');
end else
begin
IBGARHandle := FindWindow('FB_Guard', 'FireBird Guardian');
if IBGARHandle > 0 then
begin
PostMessage(IBGARHandle, 31, 0, 0);
PostMessage(IBGARHandle, 16, 0, 0);
end;
IBSRVHandle := FindWindow('FB_Server', 'FireBird Server');
if IBSRVHandle > 0 then
begin
PostMessage(IBSRVHandle, 31, 0, 0);
PostMessage(IBSRVHandle, 16, 0, 0);
end;
result := IsServerRunning;
end;
end;
//—————————————————————————————————————————————————————————————————————————————
// Returns the full name to the Interbase guardian EXE file
//—————————————————————————————————————————————————————————————————————————————
function GetInterbaseGuardianFile: string;
var Filename: string;
Reg: TRegistry;
begin
result := '';
Filename := '';
Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.KeyExists('Software\Borland\InterBase\CurrentVersion') then
begin
if Reg.OpenKeyReadOnly('Software\Borland\InterBase\CurrentVersion') then
begin
//Filename := FixPath(Reg.ReadString('ServerDirectory')) + 'ibguard.exe';
Filename := Reg.ReadString('ServerDirectory') + '\ibguard.exe';
Reg.CloseKey;
end;
end
else begin
if Reg.KeyExists(FB_RegKey) then
begin
if Reg.OpenKeyReadOnly(FB_RegKey) then
begin
//Filename := FixPath(Reg.ReadString('ServerDirectory')) + 'ibguard.exe';
Filename := Reg.ReadString('DefaultInstance') + 'bin\fbguard.exe';
Reg.CloseKey;
end;
end;
end;
finally
Reg.free;
end;
result := filename;
end;


//—————————————————————————————————————————————————————————————————————————————
// Starts Interbase
//—————————————————————————————————————————————————————————————————————————————

function StartInterbase: boolean;
var Filename: string;
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
begin
filename := GetInterbaseGuardianFile;
if FileExists(Filename) then
begin
if IsNT then
begin
result := ServiceStart('', 'InterBaseGuardian');
end
else begin
Fillchar(StartupInfo, Sizeof(TStartupInfo), 0);
StartupInfo.cb := sizeof(StartupInfo);
StartupInfo.lpReserved := nil;
StartupInfo.lpTitle := nil;
StartupInfo.lpDesktop := nil;
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWNA;
StartupInfo.cbReserved2 := 0;
StartupInfo.lpReserved2 := nil;
result := CreateProcess(nil, pchar(filename), nil, nil, False,
NORMAL_PRIORITY_CLASS,
nil, pchar(ExtractFilePath(filename)), StartupInfo, ProcessInformation);
end;
end
else result := false;
end;

function GetSysDirectory: string;
var SysDir: Pchar;
begin
SysDir := StrAlloc(255);
try
fillchar(SysDir^, 255, 0);
GetSystemDirectory(SysDir, 255); // Get the "windows\system" directory
result := SysDir;
finally
StrDispose(SysDir);
end;
end;

//—————————————————————————————————————————————————————————————————————————————
// Saber si Interbase está instalado
//—————————————————————————————————————————————————————————————————————————————
function InterbaseInstalled : boolean;
var Filename : string;
Running : boolean;
begin
Running := IsServerRunning;
if Running = false then
begin
filename := GetInterbaseGuardianFile;
if FileExists(Filename) then
result := FileExists(IncludeTrailingPathDelimiter(GetSysDirectory)+'gds32.dll')
else result := false;
end
else result := true;
end;

function FireBirdInstalled : boolean;
var Filename : string;
Running : boolean;
begin
Running := IsServerRunning;
if Running = false then
begin
filename := GetInterbaseGuardianFile;
if FileExists(Filename) then
result := FileExists(IncludeTrailingPathDelimiter(GetSysDirectory)+'gds32.dll')
else result := false;
end
else result := true;
end;

end.


Saludos.