Desabilitar servicio de Interbase...

[Sinaloense]

¿Como puedo desde el código darle un shutdown al servicio del IB server, y como lo puedo activar de nuevo también desde el código?

Gracias.

[__cadetill]

Código Delphi [-]
//—————————————————————————————————————————————————————————————————————————————
// 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 Interbase está en marcha
//—————————————————————————————————————————————————————————————————————————————
function InterbaseRunning : boolean;
begin
     result := boolean(FindWindow('IB_Server','InterBase Server')
               or FindWindow('IB_Guard','InterBase Guardian'));
end;

//—————————————————————————————————————————————————————————————————————————————
// Parar Interbase
//—————————————————————————————————————————————————————————————————————————————
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;

//—————————————————————————————————————————————————————————————————————————————
// Arrancar 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;
       BorraFicheroFlag;
     end
     else result := false;
end;

//—————————————————————————————————————————————————————————————————————————————
// Saber si Interbase está instalado
//—————————————————————————————————————————————————————————————————————————————
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;

Creo que es todo

[__cadetill]

Hola de nuevo

Algunas de las cosas que puse en el mensaje anterior, sólo funcionan para Interbase. Por eso, durante estos días he estado mirando de hacer algo genérico para IB/FB.

He creado dos clases, TService y TIBSservice. La primera es genérica para el control de cualquier servicio de Windows. La segunda es específica para el motor de bases de datos IB/FB

La definición de las clases es la siguiente

Código Delphi [-]
  TService = class(TComponent)
  public
    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 ServiceCreate(sMachine, sService, sDisplayName, sBinFile : string; 
                 StartType : integer) : boolean;
    function ServiceDelete(sMachine, sService : string) : boolean;
    function ServiceStart(sMachine, sService : string) : boolean;
    function ServiceStop(sMachine, sService : string) : boolean;
    function ExistService(sMachine, sService : string) : boolean;
    function ProcessRunning(Proces: string): boolean;
  end;

  TTipoBD = (tbIB, tbFB103, tbFB15, tbNone);

  TIBService = class(TService)
  private
    FTipoBD: TTipoBD;
  protected
  public
    constructor Create(aOwner: TComponent); override;

    function GetVersion: TTipoBD;
    function GetInterbaseGuardianFile : string;
    function GetIBRootDir: string;
    function InterbaseRunning : boolean;
    function ShutDownInterbase : boolean;
    function StartInterbase : boolean;
    function InterbaseInstalled : boolean;
  published
    property TipoBD: TTipoBD read FTipoBD write FTipoBD;
  end;

El nombre de los métodos creo que es bastante significativo para haceros una idea de lo que hacen

Sólo lo he probado en 3 SO (NT, XP y 2k prof.) y con IB 1.5, por lo que no garantizo su plena funcionalidad (razón por la que, de momento no lo subiré a mi web).

Si a alguien le interesa o quiere hacerme de beta-tester con otra combinación.... que me deje aquí un mensaje y ya nos ponemos en contacto