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, 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;

 { TSPBItem }

  TSPBItem = class(TParamBlockItem,ISPBItem)
  public
   function getParamTypeName: AnsiString; override;
   class function LookupParamTypeName(ParamType: byte): AnsiString;
  end;

 { TSPB }

  TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
  protected
   function LookupItemType(ParamTypeName: AnsiString): byte; override;
  public
   constructor Create(api: TFBClientAPI);
   function GetParamTypeName(ParamType: byte): Ansistring;
   function ISPB.GetDPBParamTypeName = GetParamTypeName;
  end;

implementation

uses FBMessages, IBUtils;

const
  SPBPrefix = 'isc_spb_';
  isc_spb_last_spb_constant = 13;
  SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
    'user_name',
    'sys_user_name',
    'sys_user_name_enc',
    'password',
    'password_enc',
    'command_line',
    'db_name',
    'verbose',
    'options',
    'connect_timeout',
    'dummy_packet_interval',
    'sql_role_name',
    'expected_db'
  );

  SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
    isc_spb_user_name,
    isc_spb_sys_user_name,
    isc_spb_sys_user_name_enc,
    isc_spb_password,
    isc_spb_password_enc,
    isc_spb_command_line,
    isc_spb_dbname,
    isc_spb_verbose,
    isc_spb_options,
    isc_spb_connect_timeout,
    isc_spb_dummy_packet_interval,
    isc_spb_sql_role_name,
    isc_spb_expected_db
  );

{ TSPBItem }

function TSPBItem.getParamTypeName: AnsiString;
begin
    Result := LookupParamTypeName(getParamType);
end;

class function TSPBItem.LookupParamTypeName(ParamType: byte): AnsiString;
var i: integer;
begin
  Result := '';
  for i := 1 to isc_spb_last_spb_constant do
    if SPBConstantValues [i] = ParamType then
    begin
      Result := SPBConstantNames[i];
      break;
    end;
end;

{ 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;

{ TSPB }

function TSPB.LookupItemType(ParamTypeName: AnsiString): byte;
var i: integer;
begin
  Result := 0;
  ParamTypeName := LowerCase(ParamTypeName);
  if Pos(SPBPrefix,ParamTypeName) = 1 then
    system.Delete(ParamTypeName,1,Length(SPBPrefix));
  for i := 1 to isc_spb_last_spb_constant do
    if SPBConstantNames [i] = ParamTypeName then
    begin
      Result := SPBConstantValues[i];
      break;
    end;
end;

constructor TSPB.Create(api: TFBClientAPI);
begin
  inherited Create(api);
  FDataLength := 2;
  FBuffer^ := isc_spb_version;
  (FBuffer+1)^ := isc_spb_current_version;
end;

function TSPB.GetParamTypeName(ParamType: byte): Ansistring;
begin
  Result := TSPBItem.LookupParamTypeName(ParamType);
end;

end.

Revision:	345
Committed:	Mon Aug 23 14:22:29 2021 UTC (3 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	6624 byte(s)
Log Message:	Merged into public release
#	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	tony	263	Classes, SysUtils, IB, FBParamBlock, FBActivityMonitor, FBClientAPI;
44	tony	45
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	263	constructor Create(api: TFBClientAPI; ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
61	tony	45	destructor Destroy; override;
62			public
63			{IServiceManager}
64	tony	263	function getFirebirdAPI: IFirebirdAPI;
65	tony	45	function getSPB: ISPB;
66	tony	56	function getServerName: AnsiString;
67	tony	209	function getProtocol: TProtocol;
68			function getPortNo: AnsiString;
69	tony	45	procedure Attach;
70			procedure Detach(Force: boolean=false); virtual; abstract;
71			function AllocateSRB: ISRB;
72			function AllocateSQPB: ISQPB;
73	tony	209	function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload; virtual; abstract;
74			function Query(Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; overload;
75	tony	45	end;
76
77	tony	315	{ TSPBItem }
78
79			TSPBItem = class(TParamBlockItem,ISPBItem)
80			public
81			function getParamTypeName: AnsiString; override;
82			class function LookupParamTypeName(ParamType: byte): AnsiString;
83			end;
84
85			{ TSPB }
86
87			TSPB = class (TCustomParamBlock<TSPBItem,ISPBItem>, ISPB)
88			protected
89			function LookupItemType(ParamTypeName: AnsiString): byte; override;
90			public
91			constructor Create(api: TFBClientAPI);
92	tony	345	function GetParamTypeName(ParamType: byte): Ansistring;
93			function ISPB.GetDPBParamTypeName = GetParamTypeName;
94	tony	315	end;
95
96	tony	45	implementation
97
98	tony	263	uses FBMessages, IBUtils;
99	tony	45
100	tony	315	const
101			SPBPrefix = 'isc_spb_';
102			isc_spb_last_spb_constant = 13;
103			SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
104			'user_name',
105			'sys_user_name',
106			'sys_user_name_enc',
107			'password',
108			'password_enc',
109			'command_line',
110			'db_name',
111			'verbose',
112			'options',
113			'connect_timeout',
114			'dummy_packet_interval',
115			'sql_role_name',
116			'expected_db'
117			);
118
119			SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
120			isc_spb_user_name,
121			isc_spb_sys_user_name,
122			isc_spb_sys_user_name_enc,
123			isc_spb_password,
124			isc_spb_password_enc,
125			isc_spb_command_line,
126			isc_spb_dbname,
127			isc_spb_verbose,
128			isc_spb_options,
129			isc_spb_connect_timeout,
130			isc_spb_dummy_packet_interval,
131			isc_spb_sql_role_name,
132			isc_spb_expected_db
133			);
134
135			{ TSPBItem }
136
137			function TSPBItem.getParamTypeName: AnsiString;
138			begin
139			Result := LookupParamTypeName(getParamType);
140			end;
141
142			class function TSPBItem.LookupParamTypeName(ParamType: byte): AnsiString;
143			var i: integer;
144			begin
145			Result := '';
146			for i := 1 to isc_spb_last_spb_constant do
147			if SPBConstantValues [i] = ParamType then
148			begin
149			Result := SPBConstantNames[i];
150			break;
151			end;
152			end;
153
154	tony	45	{ TFBServiceManager }
155
156			procedure TFBServiceManager.CheckServerName;
157			begin
158			if (FServerName = '') and (FProtocol <> Local) then
159			IBError(ibxeServerNameMissing, [nil]);
160			end;
161
162	tony	263	constructor TFBServiceManager.Create(api: TFBClientAPI; ServerName: AnsiString;
163	tony	143	Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
164	tony	45	begin
165			inherited Create;
166	tony	263	FFirebirdAPI := api.getAPI; {Keep reference to interface}
167	tony	45	FProtocol := Protocol;
168			FSPB := SPB;
169			FServerName := ServerName;
170	tony	143	FPort := Port;
171	tony	45	Attach;
172			end;
173
174			destructor TFBServiceManager.Destroy;
175			begin
176			Detach(true);
177			inherited Destroy;
178			end;
179
180	tony	263	function TFBServiceManager.getFirebirdAPI: IFirebirdAPI;
181			begin
182			Result := FFirebirdAPI;
183			end;
184
185	tony	45	function TFBServiceManager.getSPB: ISPB;
186			begin
187			Result := FSPB;
188			end;
189
190	tony	56	function TFBServiceManager.getServerName: AnsiString;
191	tony	45	begin
192			Result := FServerName;
193			end;
194
195	tony	209	function TFBServiceManager.getProtocol: TProtocol;
196			begin
197			Result := FProtocol;
198			end;
199
200			function TFBServiceManager.getPortNo: AnsiString;
201			begin
202			Result := FPort;
203			end;
204
205	tony	45	procedure TFBServiceManager.Attach;
206	tony	56	var ConnectString: AnsiString;
207	tony	45	begin
208	tony	143	ConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPort);
209	tony	45	InternalAttach(ConnectString);
210			end;
211
212			function TFBServiceManager.AllocateSRB: ISRB;
213			begin
214	tony	263	Result := TSRB.Create(FFirebirdAPI as TFBClientAPI);
215	tony	45	end;
216
217			function TFBServiceManager.AllocateSQPB: ISQPB;
218			begin
219	tony	263	Result := TSQPB.Create(FFirebirdAPI as TFBClientAPI);
220	tony	45	end;
221
222	tony	209	function TFBServiceManager.Query(Request: ISRB; RaiseExceptionOnError: boolean
223			): IServiceQueryResults;
224	tony	45	begin
225	tony	209	Result := Query(nil,Request,RaiseExceptionOnError);
226	tony	45	end;
227
228	tony	315	{ TSPB }
229
230			function TSPB.LookupItemType(ParamTypeName: AnsiString): byte;
231			var i: integer;
232			begin
233			Result := 0;
234			ParamTypeName := LowerCase(ParamTypeName);
235			if Pos(SPBPrefix,ParamTypeName) = 1 then
236			system.Delete(ParamTypeName,1,Length(SPBPrefix));
237			for i := 1 to isc_spb_last_spb_constant do
238			if SPBConstantNames [i] = ParamTypeName then
239			begin
240			Result := SPBConstantValues[i];
241			break;
242			end;
243			end;
244
245			constructor TSPB.Create(api: TFBClientAPI);
246			begin
247			inherited Create(api);
248			FDataLength := 2;
249			FBuffer^ := isc_spb_version;
250			(FBuffer+1)^ := isc_spb_current_version;
251			end;
252
253	tony	345	function TSPB.GetParamTypeName(ParamType: byte): Ansistring;
254	tony	315	begin
255			Result := TSPBItem.LookupParamTypeName(ParamType);
256			end;
257
258	tony	45	end.
259