ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBServices.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 6573 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
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 { 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 function GetDPBParamTypeName(ParamType: byte): Ansistring;
93 end;
94
95 implementation
96
97 uses FBMessages, IBUtils;
98
99 const
100 SPBPrefix = 'isc_spb_';
101 isc_spb_last_spb_constant = 13;
102 SPBConstantNames: array[1..isc_spb_last_spb_constant] of String = (
103 'user_name',
104 'sys_user_name',
105 'sys_user_name_enc',
106 'password',
107 'password_enc',
108 'command_line',
109 'db_name',
110 'verbose',
111 'options',
112 'connect_timeout',
113 'dummy_packet_interval',
114 'sql_role_name',
115 'expected_db'
116 );
117
118 SPBConstantValues: array[1..isc_spb_last_spb_constant] of Integer = (
119 isc_spb_user_name,
120 isc_spb_sys_user_name,
121 isc_spb_sys_user_name_enc,
122 isc_spb_password,
123 isc_spb_password_enc,
124 isc_spb_command_line,
125 isc_spb_dbname,
126 isc_spb_verbose,
127 isc_spb_options,
128 isc_spb_connect_timeout,
129 isc_spb_dummy_packet_interval,
130 isc_spb_sql_role_name,
131 isc_spb_expected_db
132 );
133
134 { TSPBItem }
135
136 function TSPBItem.getParamTypeName: AnsiString;
137 begin
138 Result := LookupParamTypeName(getParamType);
139 end;
140
141 class function TSPBItem.LookupParamTypeName(ParamType: byte): AnsiString;
142 var i: integer;
143 begin
144 Result := '';
145 for i := 1 to isc_spb_last_spb_constant do
146 if SPBConstantValues [i] = ParamType then
147 begin
148 Result := SPBConstantNames[i];
149 break;
150 end;
151 end;
152
153 { TFBServiceManager }
154
155 procedure TFBServiceManager.CheckServerName;
156 begin
157 if (FServerName = '') and (FProtocol <> Local) then
158 IBError(ibxeServerNameMissing, [nil]);
159 end;
160
161 constructor TFBServiceManager.Create(api: TFBClientAPI; ServerName: AnsiString;
162 Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
163 begin
164 inherited Create;
165 FFirebirdAPI := api.getAPI; {Keep reference to interface}
166 FProtocol := Protocol;
167 FSPB := SPB;
168 FServerName := ServerName;
169 FPort := Port;
170 Attach;
171 end;
172
173 destructor TFBServiceManager.Destroy;
174 begin
175 Detach(true);
176 inherited Destroy;
177 end;
178
179 function TFBServiceManager.getFirebirdAPI: IFirebirdAPI;
180 begin
181 Result := FFirebirdAPI;
182 end;
183
184 function TFBServiceManager.getSPB: ISPB;
185 begin
186 Result := FSPB;
187 end;
188
189 function TFBServiceManager.getServerName: AnsiString;
190 begin
191 Result := FServerName;
192 end;
193
194 function TFBServiceManager.getProtocol: TProtocol;
195 begin
196 Result := FProtocol;
197 end;
198
199 function TFBServiceManager.getPortNo: AnsiString;
200 begin
201 Result := FPort;
202 end;
203
204 procedure TFBServiceManager.Attach;
205 var ConnectString: AnsiString;
206 begin
207 ConnectString := MakeConnectString(FServerName,'service_mgr',FProtocol,FPort);
208 InternalAttach(ConnectString);
209 end;
210
211 function TFBServiceManager.AllocateSRB: ISRB;
212 begin
213 Result := TSRB.Create(FFirebirdAPI as TFBClientAPI);
214 end;
215
216 function TFBServiceManager.AllocateSQPB: ISQPB;
217 begin
218 Result := TSQPB.Create(FFirebirdAPI as TFBClientAPI);
219 end;
220
221 function TFBServiceManager.Query(Request: ISRB; RaiseExceptionOnError: boolean
222 ): IServiceQueryResults;
223 begin
224 Result := Query(nil,Request,RaiseExceptionOnError);
225 end;
226
227 { TSPB }
228
229 function TSPB.LookupItemType(ParamTypeName: AnsiString): byte;
230 var i: integer;
231 begin
232 Result := 0;
233 ParamTypeName := LowerCase(ParamTypeName);
234 if Pos(SPBPrefix,ParamTypeName) = 1 then
235 system.Delete(ParamTypeName,1,Length(SPBPrefix));
236 for i := 1 to isc_spb_last_spb_constant do
237 if SPBConstantNames [i] = ParamTypeName then
238 begin
239 Result := SPBConstantValues[i];
240 break;
241 end;
242 end;
243
244 constructor TSPB.Create(api: TFBClientAPI);
245 begin
246 inherited Create(api);
247 FDataLength := 2;
248 FBuffer^ := isc_spb_version;
249 (FBuffer+1)^ := isc_spb_current_version;
250 end;
251
252 function TSPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
253 begin
254 Result := TSPBItem.LookupParamTypeName(ParamType);
255 end;
256
257 end.
258