udr/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, FBClientAPI;

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(api: TFBClientAPI; ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
    destructor Destroy; override;
  public
    {IServiceManager}
    function getFirebirdAPI: IFirebirdAPI;
    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, IBUtils;

{ TFBServiceManager }

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

constructor TFBServiceManager.Create(api: TFBClientAPI; ServerName: AnsiString;
  Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
begin
  inherited Create;
  FFirebirdAPI := api.getAPI; {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.getFirebirdAPI: IFirebirdAPI;
begin
  Result := FFirebirdAPI;
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(FFirebirdAPI as TFBClientAPI);
end;

function TFBServiceManager.AllocateSQPB: ISQPB;
begin
   Result := TSQPB.Create(FFirebirdAPI as TFBClientAPI);
end;

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

end.

Revision:	263
Committed:	Thu Dec 6 15:55:01 2018 UTC (5 years, 11 months ago) by tony
Content type:	text/x-pascal
Original Path:	*ibx/trunk/fbintf/client/FBServices.pas*
File size:	4167 byte(s)
Log Message:	Release 2.3.2 committed
#	Content
1	(*
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	{$IFDEF MSWINDOWS}
32	{$DEFINE WINDOWS}
33	{$ENDIF}
34
35	{$IFDEF FPC}
36	{$mode delphi}
37	{$interfaces COM}
38	{$ENDIF}
39
40	interface
41
42	uses
43	Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
44
45	type
46
47	{ TFBServiceManager }
48
49	TFBServiceManager = class(TFBInterfacedObject)
50	private
51	FFirebirdAPI: IFirebirdAPI;
52	FProtocol: TProtocol;
53	FServerName: AnsiString;
54	FPort: AnsiString;
55	procedure CheckServerName;
56	protected
57	FSPB: ISPB;
58	procedure InternalAttach(ConnectString: AnsiString); virtual; abstract;
59	public
60	constructor Create(api: TFBClientAPI; ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
61	destructor Destroy; override;
62	public
63	{IServiceManager}
64	function getFirebirdAPI: IFirebirdAPI;
65	function getSPB: ISPB;
66	function getServerName: AnsiString;
67	function getProtocol: TProtocol;
68	function getPortNo: AnsiString;
69	procedure Attach;
70	procedure Detach(Force: boolean=false); virtual; abstract;
71	function AllocateSRB: ISRB;
72	function AllocateSQPB: ISQPB;
73	function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload; virtual; abstract;
74	function Query(Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload;
75	end;
76
77	implementation
78
79	uses FBMessages, IBUtils;
80
81	{ TFBServiceManager }
82
83	procedure TFBServiceManager.CheckServerName;
84	begin
85	if (FServerName = '') and (FProtocol <> Local) then
86	IBError(ibxeServerNameMissing, [nil]);
87	end;
88
89	constructor TFBServiceManager.Create(api: TFBClientAPI; ServerName: AnsiString;
90	Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
91	begin
92	inherited Create;
93	FFirebirdAPI := api.getAPI; {Keep reference to interface}
94	FProtocol := Protocol;
95	FSPB := SPB;
96	FServerName := ServerName;
97	FPort := Port;
98	Attach;
99	end;
100
101	destructor TFBServiceManager.Destroy;
102	begin
103	Detach(true);
104	inherited Destroy;
105	end;
106
107	function TFBServiceManager.getFirebirdAPI: IFirebirdAPI;
108	begin
109	Result := FFirebirdAPI;
110	end;
111
112	function TFBServiceManager.getSPB: ISPB;
113	begin
114	Result := FSPB;
115	end;
116
117	function TFBServiceManager.getServerName: AnsiString;
118	begin
119	Result := FServerName;
120	end;
121
122	function TFBServiceManager.getProtocol: TProtocol;
123	begin
124	Result := FProtocol;
125	end;
126
127	function TFBServiceManager.getPortNo: AnsiString;
128	begin
129	Result := FPort;
130	end;
131
132	procedure TFBServiceManager.Attach;
133	var ConnectString: AnsiString;
134	begin
135	ConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPort);
136	InternalAttach(ConnectString);
137	end;
138
139	function TFBServiceManager.AllocateSRB: ISRB;
140	begin
141	Result := TSRB.Create(FFirebirdAPI as TFBClientAPI);
142	end;
143
144	function TFBServiceManager.AllocateSQPB: ISQPB;
145	begin
146	Result := TSQPB.Create(FFirebirdAPI as TFBClientAPI);
147	end;
148
149	function TFBServiceManager.Query(Request: ISRB; RaiseExceptionOnError: boolean
150	): IServiceQueryResults;
151	begin
152	Result := Query(nil,Request,RaiseExceptionOnError);
153	end;
154
155	end.
156