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;
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;
function InterbaseRunning : boolean;
begin
result := boolean(FindWindow('IB_Server','InterBase Server')
or FindWindow('IB_Guard','InterBase Guardian'));
end;
function ShutDownInterbase : boolean;
var IBSRVHandle,IBGARHandle : THandle;
begin
if IsNT then begin
result := ServiceStop('','InterBaseGuardian');
end
else
begin
IBGARHandle := FindWindow('IB_Guard','InterBase Guardian');
if IBGARHandle > 0 then
begin
PostMessage(IBGARHandle,31,0,0);
PostMessage(IBGARHandle,16,0,0);
end;
IBSRVHandle := FindWindow('IB_Server','InterBase Server');
if IBSRVHandle > 0 then
begin
PostMessage(IBSRVHandle,31,0,0);
PostMessage(IBSRVHandle,16,0,0);
end;
result := InterbaseRunning;
end;
try
CreaFicheroFlag;
except
end
end;
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;
BorraFicheroFlag;
end
else result := false;
end;
function InterbaseInstalled : boolean;
var Filename : string;
Running : boolean;
begin
Running := InterbaseRunning;
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;