fbintf/client/FBServices.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API. Although predominantly
 *  a new development they include source code taken from IBX and may be
 *  considered a derived product. This software thus also includes the copyright
 *  notice and license conditions from IBX.
 *
 *  Except for those parts dervied from IBX, contents of this file are subject
 *  to the Initial Developer's Public License Version 1.0 (the "License"); you
 *  may not use this file except in compliance with the License. You may obtain a
 *  copy of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FBServices;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, IB,  FBParamBlock, FBActivityMonitor;

type

  { TFBServiceManager }

  TFBServiceManager = class(TFBInterfacedObject)
  private
    FFirebirdAPI: IFirebirdAPI;
    FProtocol: TProtocol;
    FServerName: AnsiString;
    FPort: AnsiString;
    procedure CheckServerName;
  protected
    FSPB: ISPB;
    procedure InternalAttach(ConnectString: AnsiString); virtual; abstract;
  public
    constructor Create(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
    destructor Destroy; override;
  public
    {IServiceManager}
    function getSPB: ISPB;
    function getServerName: AnsiString;
    function getProtocol: TProtocol;
    function getPortNo: AnsiString;
    procedure Attach;
    procedure Detach(Force: boolean=false); virtual; abstract;
    function AllocateSRB: ISRB;
    function AllocateSQPB: ISQPB;
    function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload; virtual; abstract;
    function Query(Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults;  overload;
  end;

implementation

uses FBMessages, FBClientAPI, IBUtils;

{ TFBServiceManager }

procedure TFBServiceManager.CheckServerName;
begin
  if (FServerName = '') and (FProtocol <> Local) then
    IBError(ibxeServerNameMissing, [nil]);
end;

constructor TFBServiceManager.Create(ServerName: AnsiString;
  Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
begin
  inherited Create;
  FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
  FProtocol := Protocol;
  FSPB := SPB;
  FServerName := ServerName;
  FPort := Port;
  Attach;
end;

destructor TFBServiceManager.Destroy;
begin
  Detach(true);
  inherited Destroy;
end;

function TFBServiceManager.getSPB: ISPB;
begin
  Result := FSPB;
end;

function TFBServiceManager.getServerName: AnsiString;
begin
  Result := FServerName;
end;

function TFBServiceManager.getProtocol: TProtocol;
begin
  Result := FProtocol;
end;

function TFBServiceManager.getPortNo: AnsiString;
begin
  Result := FPort;
end;

procedure TFBServiceManager.Attach;
var ConnectString: AnsiString;
begin
  ConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPort);
  InternalAttach(ConnectString);
end;

function TFBServiceManager.AllocateSRB: ISRB;
begin
  Result := TSRB.Create;
end;

function TFBServiceManager.AllocateSQPB: ISQPB;
begin
   Result := TSQPB.Create;
end;

function TFBServiceManager.Query(Request: ISRB; RaiseExceptionOnError: boolean
  ): IServiceQueryResults;
begin
   Result := Query(nil,Request,RaiseExceptionOnError);
end;

end.

Revision:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	3932 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	45	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API. Although predominantly
4			* a new development they include source code taken from IBX and may be
5			* considered a derived product. This software thus also includes the copyright
6			* notice and license conditions from IBX.
7			*
8			* Except for those parts dervied from IBX, contents of this file are subject
9			* to the Initial Developer's Public License Version 1.0 (the "License"); you
10			* may not use this file except in compliance with the License. You may obtain a
11			* copy of the License here:
12			*
13			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
14			*
15			* Software distributed under the License is distributed on an "AS
16			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17			* implied. See the License for the specific language governing rights
18			* and limitations under the License.
19			*
20			* The Initial Developer of the Original Code is Tony Whyman.
21			*
22			* The Original Code is (C) 2016 Tony Whyman, MWA Software
23			* (http://www.mwasoftware.co.uk).
24			*
25			* All Rights Reserved.
26			*
27			* Contributor(s): ______________________________________.
28			*
29			*)
30			unit FBServices;
31	tony	56	{$IFDEF MSWINDOWS}
32			{$DEFINE WINDOWS}
33			{$ENDIF}
34	tony	45
35			{$IFDEF FPC}
36	tony	56	{$mode delphi}
37	tony	45	{$interfaces COM}
38			{$ENDIF}
39
40			interface
41
42			uses
43			Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor;
44
45			type
46
47			{ TFBServiceManager }
48
49			TFBServiceManager = class(TFBInterfacedObject)
50			private
51			FFirebirdAPI: IFirebirdAPI;
52			FProtocol: TProtocol;
53	tony	56	FServerName: AnsiString;
54	tony	143	FPort: AnsiString;
55	tony	45	procedure CheckServerName;
56			protected
57			FSPB: ISPB;
58	tony	56	procedure InternalAttach(ConnectString: AnsiString); virtual; abstract;
59	tony	45	public
60	tony	143	constructor Create(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
61	tony	45	destructor Destroy; override;
62			public
63			{IServiceManager}
64			function getSPB: ISPB;
65	tony	56	function getServerName: AnsiString;
66	tony	209	function getProtocol: TProtocol;
67			function getPortNo: AnsiString;
68	tony	45	procedure Attach;
69			procedure Detach(Force: boolean=false); virtual; abstract;
70			function AllocateSRB: ISRB;
71			function AllocateSQPB: ISQPB;
72	tony	209	function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload; virtual; abstract;
73			function Query(Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload;
74	tony	45	end;
75
76			implementation
77
78	tony	143	uses FBMessages, FBClientAPI, IBUtils;
79	tony	45
80			{ TFBServiceManager }
81
82			procedure TFBServiceManager.CheckServerName;
83			begin
84			if (FServerName = '') and (FProtocol <> Local) then
85			IBError(ibxeServerNameMissing, [nil]);
86			end;
87
88	tony	143	constructor TFBServiceManager.Create(ServerName: AnsiString;
89			Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
90	tony	45	begin
91			inherited Create;
92			FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
93			FProtocol := Protocol;
94			FSPB := SPB;
95			FServerName := ServerName;
96	tony	143	FPort := Port;
97	tony	45	Attach;
98			end;
99
100			destructor TFBServiceManager.Destroy;
101			begin
102			Detach(true);
103			inherited Destroy;
104			end;
105
106			function TFBServiceManager.getSPB: ISPB;
107			begin
108			Result := FSPB;
109			end;
110
111	tony	56	function TFBServiceManager.getServerName: AnsiString;
112	tony	45	begin
113			Result := FServerName;
114			end;
115
116	tony	209	function TFBServiceManager.getProtocol: TProtocol;
117			begin
118			Result := FProtocol;
119			end;
120
121			function TFBServiceManager.getPortNo: AnsiString;
122			begin
123			Result := FPort;
124			end;
125
126	tony	45	procedure TFBServiceManager.Attach;
127	tony	56	var ConnectString: AnsiString;
128	tony	45	begin
129	tony	143	ConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPort);
130	tony	45	InternalAttach(ConnectString);
131			end;
132
133			function TFBServiceManager.AllocateSRB: ISRB;
134			begin
135			Result := TSRB.Create;
136			end;
137
138			function TFBServiceManager.AllocateSQPB: ISQPB;
139			begin
140			Result := TSQPB.Create;
141			end;
142
143	tony	209	function TFBServiceManager.Query(Request: ISRB; RaiseExceptionOnError: boolean
144			): IServiceQueryResults;
145	tony	45	begin
146	tony	209	Result := Query(nil,Request,RaiseExceptionOnError);
147	tony	45	end;
148
149			end.
150