Firebird - parar e inicial o firebird via codigo

Top  Previous  Next

unit Menu;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

 

type

  TPrincipal = class(TForm)

    PararBtn: TButton;

    IniciarBtn: TButton;

    procedure PararBtnClick(Sender: TObject);

    procedure IniciarBtnClick(Sender: TObject);

  private

    function ShutDownInterbase : boolean;

    function StartInterbase: boolean;

  end;

 

var

  Principal: TPrincipal;

 

implementation

 

{$R *.dfm}

 

Uses ARotinasUnit, IdTCPClient, ARotinas2Unit;

 

function TPrincipal.ShutDownInterbase : boolean;

var

  IBSRVHandle,IBGARHandle : THandle;

begin

  Result := False;

//  if IsNT then

//    result := ServiceStop('','FirebirdServerDefaultInstance'{InterBaseGuardian})

//  else

//  begin

 

    IBGARHandle := FindWindow('FB_Guard','FireBird Guardian');

    IBSRVHandle := FindWindow('FB_Server','FireBird Server');

    if (IBGARHandle > 0)OR(IBSRVHandle > 0) then

    begin

      PostMessage(IBGARHandle,31,0,0);

      PostMessage(IBGARHandle,16,0,0);

 

      PostMessage(IBSRVHandle,31,0,0);

      PostMessage(IBSRVHandle,16,0,0);

      Result :=  True;

    end;

end;

 

function TPrincipal.StartInterbase : boolean;

begin

  WinExec('C:\Arquivos de programas\Firebird\Firebird_1_5\bin\fbserver.exe -a'1);

  WinExec('C:\Arquivos de programas\Firebird\Firebird_1_5\bin\fbguard.exe -a'1);

  Result := True;

end;

 

procedure TPrincipal.PararBtnClick(Sender: TObject);

Var

  S : String;

begin

  if ShutDownInterbase then

    S := 'Serviço finalizado !'

  else

    S := 'Falhou !';

  MsgInforma(S);

end;

 

procedure TPrincipal.IniciarBtnClick(Sender: TObject);

Var

  S: String;

begin

  if StartInterbase then

    S := 'Conectado !'

  else

    S := 'Falhou !';

  MsgInforma(S);

end;

 

end.