ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBAttachment.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 38854 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# Content
1 (*
2 * Firebird Interface (fbintf). The fbintf components provide a set of
3 * Pascal language bindings for the Firebird API.
4 *
5 * The contents of this file are subject to the Initial Developer's
6 * Public License Version 1.0 (the "License"); you may not use this
7 * file except in compliance with the License. You may obtain a copy
8 * of the License here:
9 *
10 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
11 *
12 * Software distributed under the License is distributed on an "AS
13 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14 * implied. See the License for the specific language governing rights
15 * and limitations under the License.
16 *
17 * The Initial Developer of the Original Code is Tony Whyman.
18 *
19 * The Original Code is (C) 2016 Tony Whyman, MWA Software
20 * (http://www.mwasoftware.co.uk).
21 *
22 * All Rights Reserved.
23 *
24 * Contributor(s): ______________________________________.
25 *
26 *)
27 unit FBAttachment;
28 {$IFDEF MSWINDOWS}
29 {$DEFINE WINDOWS}
30 {$ENDIF}
31
32 {$IFDEF FPC}
33 {$mode delphi}
34 {$interfaces COM}
35 {$define HASREQEX}
36 {$ENDIF}
37
38 interface
39
40 uses
41 Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB, FBParamBlock,
42 FBActivityMonitor, FBClientAPI;
43
44 type
45 TCharsetMap = record
46 CharsetID: integer;
47 CharSetName: AnsiString;
48 CharSetWidth: integer;
49 CodePage: TSystemCodePage;
50 AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
51 end;
52
53 { TFBAttachment }
54
55 TFBAttachment = class(TActivityHandler)
56 private
57 FDPB: IDPB;
58 FFirebirdAPI: IFirebirdAPI;
59 FODSMajorVersion: integer;
60 FODSMinorVersion: integer;
61 FUserCharSetMap: array of TCharSetMap;
62 FSecDatabase: AnsiString;
63 protected
64 FDatabaseName: AnsiString;
65 FRaiseExceptionOnConnectError: boolean;
66 FSQLDialect: integer;
67 FHasDefaultCharSet: boolean;
68 FCharSetID: integer;
69 FCodePage: TSystemCodePage;
70 FRemoteProtocol: AnsiString;
71 FAuthMethod: AnsiString;
72 constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
73 RaiseExceptionOnConnectError: boolean);
74 procedure CheckHandle; virtual; abstract;
75 function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
76 procedure GetODSAndConnectionInfo;
77 function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
78 function IsConnected: boolean; virtual; abstract;
79 procedure EndAllTransactions;
80 procedure DPBFromCreateSQL(CreateSQL: AnsiString);
81 procedure SetParameters(SQLParams: ISQLParams; params: array of const);
82 procedure UseServerICUChanged; virtual;
83 public
84 destructor Destroy; override;
85 function getFirebirdAPI: IFirebirdAPI;
86 function getDPB: IDPB;
87 function AllocateBPB: IBPB;
88 function AllocateDIRB: IDIRB;
89 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
90 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
91 procedure Disconnect(Force: boolean=false); virtual; abstract;
92 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
93 procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
94 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
95 procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
96 function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
97 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
98 function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
99 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
100 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
101 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
102 params: array of const): IResultSet; overload;
103 function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
104 function OpenCursor(transaction: ITransaction; sql: AnsiString;
105 params: array of const): IResultSet; overload;
106 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
107 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
108 params: array of const): IResultSet; overload;
109 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
110 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
111 params: array of const): IResultSet; overload;
112 function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
113 function OpenCursorAtStart(sql: AnsiString;
114 params: array of const): IResultSet; overload;
115 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
116 function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
117 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
118 aSQLDialect: integer; GenerateParamNames: boolean=false;
119 CaseSensitiveParams: boolean = false): IStatement; overload; virtual; abstract;
120 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
121 GenerateParamNames: boolean=false;
122 CaseSensitiveParams: boolean = false): IStatement; overload;
123 function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
124 function GetEventHandler(Event: AnsiString): IEvents; overload;
125
126 function GetSQLDialect: integer;
127 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
128 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
129 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
130 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
131 function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
132 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
133 ): IArray; overload;
134 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
135 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
136 function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
137 property SQLDialect: integer read FSQLDialect;
138 property DPB: IDPB read FDPB;
139 public
140 function GetDBInformation(Requests: array of byte): IDBInformation; overload;
141 function GetDBInformation(Request: byte): IDBInformation; overload;
142 function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
143 function GetConnectString: AnsiString;
144 function GetRemoteProtocol: AnsiString;
145 function GetAuthenticationMethod: AnsiString;
146 function GetSecurityDatabase: AnsiString;
147 function GetODSMajorVersion: integer;
148 function GetODSMinorVersion: integer;
149 function HasDecFloatSupport: boolean; virtual;
150
151 public
152 {Character Sets}
153 function HasDefaultCharSet: boolean;
154 function GetDefaultCharSetID: integer;
155 function GetCharsetName(CharSetID: integer): AnsiString;
156 function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
157 function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
158 function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
159 function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
160 procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
161 AllowReverseLookup:boolean; out CharSetID: integer);
162 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
163 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
164 property CharSetID: integer read FCharSetID;
165 property CodePage: TSystemCodePage read FCodePage;
166
167 public
168 {Time Zone Support}
169 function GetTimeZoneServices: ITimeZoneServices; virtual;
170 function HasTimeZoneSupport: boolean; virtual;
171
172 end;
173
174 { TDPBItem }
175
176 TDPBItem = class(TParamBlockItem,IDPBItem)
177 public
178 function getParamTypeName: AnsiString; override;
179 end;
180
181 { TDPB }
182
183 TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
184 protected
185 function LookupItemType(ParamTypeName: AnsiString): byte; override;
186 public
187 constructor Create(api: TFBClientAPI);
188 function GetDPBParamTypeName(ParamType: byte): Ansistring;
189 end;
190
191 implementation
192
193 uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
194
195 const
196 CharSetMap: array [0..69] of TCharsetMap = (
197 (CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_ACP; AllowReverseLookup: true),
198 (CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE; AllowReverseLookup: true),
199 (CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: CP_ASCII; AllowReverseLookup: true),
200 (CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8; AllowReverseLookup: false),
201 (CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8; AllowReverseLookup: true),
202 (CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932; AllowReverseLookup: true),
203 (CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932; AllowReverseLookup: true),
204 (CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
205 (CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
206 (CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737; AllowReverseLookup: true),
207 (CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437; AllowReverseLookup: true),
208 (CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850; AllowReverseLookup: true),
209 (CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865; AllowReverseLookup: true),
210 (CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860; AllowReverseLookup: true),
211 (CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863; AllowReverseLookup: true),
212 (CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775; AllowReverseLookup: true),
213 (CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858; AllowReverseLookup: true),
214 (CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862; AllowReverseLookup: true),
215 (CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864; AllowReverseLookup: true),
216 (CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE; AllowReverseLookup: true),
217 (CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
218 (CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591; AllowReverseLookup: true),
219 (CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592; AllowReverseLookup: true),
220 (CharsetID: 23; CharSetName: 'ISO8859_3'; CharSetWidth: 1; CodePage: 28593; AllowReverseLookup: true),
221 (CharsetID: 24; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
222 (CharsetID: 25; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
223 (CharsetID: 26; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
224 (CharsetID: 27; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
225 (CharsetID: 28; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
226 (CharsetID: 29; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
227 (CharsetID: 30; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
228 (CharsetID: 31; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
229 (CharsetID: 32; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
230 (CharsetID: 33; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
231 (CharsetID: 34; CharSetName: 'ISO8859_4'; CharSetWidth: 1; CodePage: 28594; AllowReverseLookup: true),
232 (CharsetID: 35; CharSetName: 'ISO8859_5'; CharSetWidth: 1; CodePage: 28595; AllowReverseLookup: true),
233 (CharsetID: 36; CharSetName: 'ISO8859_6'; CharSetWidth: 1; CodePage: 28596; AllowReverseLookup: true),
234 (CharsetID: 37; CharSetName: 'ISO8859_7'; CharSetWidth: 1; CodePage: 28597; AllowReverseLookup: true),
235 (CharsetID: 38; CharSetName: 'ISO8859_8'; CharSetWidth: 1; CodePage: 28598; AllowReverseLookup: true),
236 (CharsetID: 39; CharSetName: 'ISO8859_9'; CharSetWidth: 1; CodePage: 28599; AllowReverseLookup: true),
237 (CharsetID: 40; CharSetName: 'ISO8859_13'; CharSetWidth: 1; CodePage: 28603; AllowReverseLookup: true),
238 (CharsetID: 41; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
239 (CharsetID: 42; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
240 (CharsetID: 43; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
241 (CharsetID: 44; CharSetName: 'KSC_5601'; CharSetWidth: 2; CodePage: 949; AllowReverseLookup: true),
242 (CharsetID: 45; CharSetName: 'DOS852'; CharSetWidth: 1; CodePage: 852; AllowReverseLookup: true),
243 (CharsetID: 46; CharSetName: 'DOS857'; CharSetWidth: 1; CodePage: 857; AllowReverseLookup: true),
244 (CharsetID: 47; CharSetName: 'DOS861'; CharSetWidth: 1; CodePage: 861; AllowReverseLookup: true),
245 (CharsetID: 48; CharSetName: 'DOS866'; CharSetWidth: 1; CodePage: 866; AllowReverseLookup: true),
246 (CharsetID: 49; CharSetName: 'DOS869'; CharSetWidth: 1; CodePage: 869; AllowReverseLookup: true),
247 (CharsetID: 50; CharSetName: 'CYRL'; CharSetWidth: 1; CodePage: 1251; AllowReverseLookup: true),
248 (CharsetID: 51; CharSetName: 'WIN1250'; CharSetWidth: 1; CodePage: 1250; AllowReverseLookup: true),
249 (CharsetID: 52; CharSetName: 'WIN1251'; CharSetWidth: 1; CodePage: 1251; AllowReverseLookup: true),
250 (CharsetID: 53; CharSetName: 'WIN1252'; CharSetWidth: 1; CodePage: 1252; AllowReverseLookup: true),
251 (CharsetID: 54; CharSetName: 'WIN1253'; CharSetWidth: 1; CodePage: 1253; AllowReverseLookup: true),
252 (CharsetID: 55; CharSetName: 'WIN1254'; CharSetWidth: 1; CodePage: 1254; AllowReverseLookup: true),
253 (CharsetID: 56; CharSetName: 'BIG_5'; CharSetWidth: 2; CodePage: 950; AllowReverseLookup: true),
254 (CharsetID: 57; CharSetName: 'GB_2312'; CharSetWidth: 2; CodePage: 936; AllowReverseLookup: true),
255 (CharsetID: 58; CharSetName: 'WIN1255'; CharSetWidth: 1; CodePage: 1255; AllowReverseLookup: true),
256 (CharsetID: 59; CharSetName: 'WIN1256'; CharSetWidth: 1; CodePage: 1256; AllowReverseLookup: true),
257 (CharsetID: 60; CharSetName: 'WIN1257'; CharSetWidth: 1; CodePage: 1257; AllowReverseLookup: true),
258 (CharsetID: 61; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
259 (CharsetID: 62; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
260 (CharsetID: 63; CharSetName: 'KOI8R'; CharSetWidth: 1; CodePage: 20866; AllowReverseLookup: true),
261 (CharsetID: 64; CharSetName: 'KOI8U'; CharSetWidth: 1; CodePage: 21866; AllowReverseLookup: true),
262 (CharsetID: 65; CharSetName: 'WIN1258'; CharSetWidth: 1; CodePage: 1258; AllowReverseLookup: true),
263 (CharsetID: 66; CharSetName: 'TIS620'; CharSetWidth: 1; CodePage: 874; AllowReverseLookup: true),
264 (CharsetID: 67; CharSetName: 'GBK'; CharSetWidth: 2; CodePage: 936; AllowReverseLookup: true),
265 (CharsetID: 68; CharSetName: 'CP943C'; CharSetWidth: 2; CodePage: 943; AllowReverseLookup: true),
266 (CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936; AllowReverseLookup: true)
267 );
268
269 const
270 isc_dpb_last_dpb_constant = isc_dpb_decfloat_traps;
271
272 DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
273 'cdd_pathname',
274 'allocation',
275 'journal',
276 'page_size',
277 'num_buffers',
278 'buffer_length',
279 'debug',
280 'garbage_collect',
281 'verify',
282 'sweep',
283 'enable_journal',
284 'disable_journal',
285 'dbkey_scope',
286 'number_of_users',
287 'trace',
288 'no_garbage_collect',
289 'damaged',
290 'license',
291 'sys_user_name',
292 'encrypt_key',
293 'activate_shadow',
294 'sweep_interval',
295 'delete_shadow',
296 'force_write',
297 'begin_log',
298 'quit_log',
299 'no_reserve',
300 'user_name',
301 'password',
302 'password_enc',
303 'sys_user_name_enc',
304 'interp',
305 'online_dump',
306 'old_file_size',
307 'old_num_files',
308 'old_file',
309 'old_start_page',
310 'old_start_seqno',
311 'old_start_file',
312 'drop_walfile',
313 'old_dump_id',
314 'wal_backup_dir',
315 'wal_chkptlen',
316 'wal_numbufs',
317 'wal_bufsize',
318 'wal_grp_cmt_wait',
319 'lc_messages',
320 'lc_ctype',
321 'cache_manager',
322 'shutdown',
323 'online',
324 'shutdown_delay',
325 'reserved',
326 'overwrite',
327 'sec_attach',
328 'disable_wal',
329 'connect_timeout',
330 'dummy_packet_interval',
331 'gbak_attach',
332 'sql_role_name',
333 'set_page_buffers',
334 'working_directory',
335 'sql_dialect',
336 'set_db_readonly',
337 'set_db_sql_dialect',
338 'gfix_attach',
339 'gstat_attach',
340 'set_db_charset',
341 'gsec_attach',
342 'address_path' ,
343 'process_id',
344 'no_db_triggers',
345 'trusted_auth',
346 'process_name',
347 'trusted_role',
348 'org_filename',
349 'utf8_ilename',
350 'ext_call_depth',
351 'auth_block',
352 'client_version',
353 'remote_protocol',
354 'host_name',
355 'os_user',
356 'specific_auth_data',
357 'auth_plugin_list',
358 'auth_plugin_name',
359 'config',
360 'nolinger',
361 'reset_icu',
362 'map_attach',
363 'session_time_zone',
364 'set_db_replica',
365 'set_bind',
366 'decfloat_round',
367 'decfloat_traps'
368 );
369
370
371
372 { TFBAttachment }
373
374 procedure TFBAttachment.GetODSAndConnectionInfo;
375 var DBInfo: IDBInformation;
376 i: integer;
377 Stmt: IStatement;
378 ResultSet: IResultSet;
379 Param: IDPBItem;
380 begin
381 if not IsConnected then Exit;
382 DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
383 isc_info_db_SQL_Dialect]);
384 for i := 0 to DBInfo.GetCount - 1 do
385 with DBInfo[i] do
386 case getItemType of
387 isc_info_ods_minor_version:
388 FODSMinorVersion := getAsInteger;
389 isc_info_ods_version:
390 FODSMajorVersion := getAsInteger;
391 isc_info_db_SQL_Dialect:
392 FSQLDialect := getAsInteger;
393 end;
394
395 FCharSetID := 0;
396 FRemoteProtocol := '';
397 FAuthMethod := 'Legacy_Auth';
398 FSecDatabase := 'Default';
399 if FODSMajorVersion > 11 then
400 begin
401 Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
402 'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
403 'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION ');
404 ResultSet := Stmt.OpenCursor;
405 if ResultSet.FetchNext then
406 begin
407 FCharSetID := ResultSet[0].AsInteger;
408 FRemoteProtocol := Trim(ResultSet[1].AsString);
409 FAuthMethod := Trim(ResultSet[2].AsString);
410 FSecDatabase := Trim(ResultSet[3].AsString);
411 end
412 end
413 else
414 if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
415 begin
416 Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
417 'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
418 'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
419 ResultSet := Stmt.OpenCursor;
420 if ResultSet.FetchNext then
421 begin
422 FCharSetID := ResultSet[0].AsInteger;
423 FRemoteProtocol := Trim(ResultSet[1].AsString);
424 end
425 end
426 else
427 if DPB <> nil then
428 begin
429 Param := DPB.Find(isc_dpb_lc_ctype);
430 if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
431 FCharSetID := 0;
432 case GetProtocol(FDatabaseName) of
433 TCP: FRemoteProtocol := 'TCPv4';
434 Local: FRemoteProtocol := '';
435 NamedPipe: FRemoteProtocol := 'Netbui';
436 SPX: FRemoteProtocol := 'SPX'
437 end;
438 end;
439 FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
440 end;
441
442 constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
443 DPB: IDPB; RaiseExceptionOnConnectError: boolean);
444 begin
445 inherited Create;
446 FFirebirdAPI := api.GetAPI; {Keep reference to interface}
447 FSQLDialect := 3;
448 FDatabaseName := DatabaseName;
449 FDPB := DPB;
450 SetLength(FUserCharSetMap,0);
451 FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
452 FODSMajorVersion := 0;
453 FODSMinorVersion := 0;
454 end;
455
456 function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
457 var CreateParams: AnsiString;
458 DPBItem: IDPBItem;
459 begin
460 CreateParams := '';
461
462 if aDPB <> nil then
463 begin
464 DPBItem := aDPB.Find(isc_dpb_user_name);
465 if DPBItem <> nil then
466 CreateParams := CreateParams + ' USER ''' + DPBItem.AsString + '''';
467
468 DPBItem := aDPB.Find(isc_dpb_password);
469 if DPBItem <> nil then
470 CreateParams := CreateParams + ' Password ''' + DPBItem.AsString + '''';
471
472 DPBItem := aDPB.Find(isc_dpb_page_size);
473 if DPBItem <> nil then
474 CreateParams := CreateParams + ' PAGE_SIZE ' + DPBItem.AsString;
475
476 DPBItem := aDPB.Find(isc_dpb_lc_ctype);
477 if DPBItem <> nil then
478 CreateParams := CreateParams + ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
479
480 DPBItem := aDPB.Find(isc_dpb_sql_dialect);
481 if DPBItem <> nil then
482 FSQLDialect := DPBItem.AsInteger;
483 end;
484
485 Result := 'CREATE DATABASE ''' + DatabaseName + ''' ' + CreateParams; {do not localize}
486 end;
487
488 procedure TFBAttachment.EndAllTransactions;
489 var i: integer;
490 intf: TInterfacedObject;
491 begin
492 for i := 0 to InterfaceCount - 1 do
493 begin
494 intf := GetInterface(i);
495 if (intf <> nil) and (intf is TFBTransaction) then
496 TFBTransaction(intf).DoDefaultTransactionEnd(true);
497 end;
498 end;
499
500 {$IFDEF HASREQEX}
501 procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
502 var RegexObj: TRegExpr;
503 begin
504 FDPB := FFirebirdAPI.AllocateDPB;
505 RegexObj := TRegExpr.Create;
506 try
507 {extact database file spec}
508 RegexObj.ModifierG := false; {turn off greedy matches}
509 RegexObj.ModifierI := true; {case insensitive match}
510 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
511 if RegexObj.Exec(CreateSQL) then
512 begin
513 DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
514 DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
515 end
516 else
517 begin
518 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
519 if RegexObj.Exec(CreateSQL) then
520 DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
521 end;
522 finally
523 RegexObj.Free;
524 end;
525 if FCharSetID > 0 then
526 DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
527 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
528 end;
529 {$ELSE}
530 procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
531 begin
532 FDPB := FFirebirdAPI.AllocateDPB;
533 if FCharSetID > 0 then
534 DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
535 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
536 end;
537 {$ENDIF}
538
539 procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
540 params: array of const);
541 var i: integer;
542 begin
543 if SQLParams.Count <> Length(params) then
544 IBError(ibxeInvalidParamCount,[SQLParams.Count,Length(params)]);
545
546 for i := 0 to High(params) do
547 begin
548 case params[i].vtype of
549 vtinteger :
550 SQLParams[i].AsInteger := params[i].vinteger;
551 vtInt64:
552 SQLParams[i].AsInt64 := params[i].VInt64^;
553 {$IF declared (vtQWord)}
554 vtQWord:
555 SQLParams[i].AsInt64 := params[i].VQWord^;
556 {$IFEND}
557 vtboolean :
558 SQLParams[i].AsBoolean := params[i].vboolean;
559 vtchar :
560 SQLParams[i].AsString := params[i].vchar;
561 vtextended :
562 SQLParams[i].AsDouble := params[i].VExtended^;
563 vtCurrency:
564 SQLParams[i].AsDouble := params[i].VCurrency^;
565 vtString :
566 SQLParams[i].AsString := strpas(PChar(params[i].VString));
567 vtPChar :
568 SQLParams[i].AsString := strpas(params[i].VPChar);
569 vtAnsiString :
570 SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
571 vtVariant:
572 SQLParams[i].AsVariant := params[i].VVariant^;
573 vtWideChar:
574 SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
575 vtPWideChar:
576 SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
577 vtWideString:
578 SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
579 vtUnicodeString:
580 SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
581 else
582 IBError(ibxeInvalidVariantType,[nil]);
583 end;
584 end;
585 end;
586
587 procedure TFBAttachment.UseServerICUChanged;
588 begin
589 // Do nothing by default
590 end;
591
592 destructor TFBAttachment.Destroy;
593 begin
594 Disconnect(true);
595 inherited Destroy;
596 end;
597
598 function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
599 begin
600 Result := FFirebirdAPI;
601 end;
602
603 function TFBAttachment.getDPB: IDPB;
604 begin
605 Result := FDPB;
606 end;
607
608 function TFBAttachment.AllocateBPB: IBPB;
609 begin
610 Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
611 end;
612
613 function TFBAttachment.AllocateDIRB: IDIRB;
614 begin
615 Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
616 end;
617
618 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
619 aSQLDialect: integer);
620 begin
621 ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
622 end;
623
624 procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
625 begin
626 ExecImmediate(transaction,sql,FSQLDialect);
627 end;
628
629 procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
630 begin
631 ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
632 end;
633
634 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
635 SQLDialect: integer; params: array of const): IResults;
636 begin
637 Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
638 end;
639
640 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
641 SQLDialect: integer; params: array of const): IResults;
642 begin
643 with Prepare(transaction,sql,SQLDialect) do
644 begin
645 SetParameters(SQLParams,params);
646 Result := Execute;
647 end;
648 end;
649
650 function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
651 params: array of const): IResults;
652 begin
653 Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
654 end;
655
656 function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
657 params: array of const): IResults;
658 begin
659 with Prepare(transaction,sql,FSQLDialect) do
660 begin
661 SetParameters(SQLParams,params);
662 Result := Execute;
663 end;
664 end;
665
666 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
667 aSQLDialect: integer): IResultSet;
668 begin
669 Result := OpenCursor(transaction,sql,aSQLDialect,[]);
670 end;
671
672 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
673 aSQLDialect: integer; params: array of const): IResultSet;
674 var Statement: IStatement;
675 begin
676 CheckHandle;
677 Statement := Prepare(transaction,sql,aSQLDialect);
678 SetParameters(Statement.SQLParams,params);
679 Result := Statement.OpenCursor;
680 end;
681
682 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
683 ): IResultSet;
684 begin
685 Result := OpenCursor(transaction,sql,FSQLDialect,[]);
686 end;
687
688 function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
689 params: array of const): IResultSet;
690 begin
691 Result := OpenCursor(transaction,sql,FSQLDialect,params);
692 end;
693
694 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
695 sql: AnsiString; aSQLDialect: integer): IResultSet;
696 begin
697 Result := OpenCursor(transaction,sql,aSQLDialect,[]);
698 Result.FetchNext;
699 end;
700
701 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
702 sql: AnsiString; aSQLDialect: integer; params: array of const): IResultSet;
703 begin
704 Result := OpenCursor(transaction,sql,aSQLDialect,params);
705 Result.FetchNext;
706 end;
707
708 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
709 ): IResultSet;
710 begin
711 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
712 end;
713
714 function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
715 sql: AnsiString; params: array of const): IResultSet;
716 begin
717 Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
718 end;
719
720 function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
721 begin
722 Result := OpenCursorAtStart(sql,[]);
723 end;
724
725 function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
726 params: array of const): IResultSet;
727 begin
728 Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
729 end;
730
731 function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
732 ): IStatement;
733 begin
734 Result := Prepare(transaction,sql,FSQLDialect);
735 end;
736
737 function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
738 sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean): IStatement;
739 begin
740 Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams);
741 end;
742
743 function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
744 var S: TStringList;
745 begin
746 S := TStringList.Create;
747 try
748 S.Add(Event);
749 Result := GetEventHandler(S);
750 finally
751 S.Free;
752 end;
753 end;
754
755 function TFBAttachment.GetSQLDialect: integer;
756 begin
757 Result := FSQLDialect;
758 end;
759
760 function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
761 ColumnName: AnsiString; BPB: IBPB): IBlob;
762 begin
763 Result := CreateBlob(transaction,GetBlobMetaData(Transaction,RelationName,ColumnName),BPB);
764 end;
765
766 function TFBAttachment.OpenBlob(transaction: ITransaction; RelationName,
767 ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
768 begin
769 Result := OpenBlob(Transaction,
770 GetBlobMetaData(Transaction,RelationName,ColumnName),
771 BlobID,BPB);
772 end;
773
774 function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
775 BPB: IBPB): IBlob;
776 begin
777 Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
778 end;
779
780 function TFBAttachment.CreateArray(transaction: ITransaction; RelationName,
781 ColumnName: AnsiString): IArray;
782 begin
783 Result := CreateArray(transaction,GetArrayMetaData(transaction,RelationName,ColumnName));
784 end;
785
786 function TFBAttachment.OpenArray(transaction: ITransaction; RelationName,
787 ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
788 begin
789 Result := OpenArray(transaction,
790 GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
791 end;
792
793 function TFBAttachment.GetDBInformation(Requests: array of byte
794 ): IDBInformation;
795 var ReqBuffer: PByte;
796 i: integer;
797 begin
798 CheckHandle;
799 if Length(Requests) = 1 then
800 Result := GetDBInformation(Requests[0])
801 else
802 begin
803 GetMem(ReqBuffer,Length(Requests));
804 try
805 for i := 0 to Length(Requests) - 1 do
806 ReqBuffer[i] := Requests[i];
807
808 Result := GetDBInfo(ReqBuffer,Length(Requests));
809
810 finally
811 FreeMem(ReqBuffer);
812 end;
813 end;
814 end;
815
816 function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
817 begin
818 CheckHandle;
819 Result := GetDBInfo(@Request,1);
820 end;
821
822 function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
823 begin
824 CheckHandle;
825 with Requests as TDIRB do
826 Result := GetDBInfo(getBuffer,getDataLength);
827 end;
828
829 function TFBAttachment.GetConnectString: AnsiString;
830 begin
831 Result := FDatabaseName;
832 end;
833
834 function TFBAttachment.GetRemoteProtocol: AnsiString;
835 begin
836 Result := FRemoteProtocol;
837 end;
838
839 function TFBAttachment.GetAuthenticationMethod: AnsiString;
840 begin
841 Result := FAuthMethod;
842 end;
843
844 function TFBAttachment.GetSecurityDatabase: AnsiString;
845 begin
846 Result := FSecDatabase;
847 end;
848
849 function TFBAttachment.GetODSMajorVersion: integer;
850 begin
851 Result := FODSMajorVersion;
852 end;
853
854 function TFBAttachment.GetODSMinorVersion: integer;
855 begin
856 Result := FODSMinorVersion;
857 end;
858
859 function TFBAttachment.HasDecFloatSupport: boolean;
860 begin
861 Result := false;
862 end;
863
864 function TFBAttachment.HasDefaultCharSet: boolean;
865 begin
866 Result := FHasDefaultCharSet
867 end;
868
869 function TFBAttachment.GetDefaultCharSetID: integer;
870 begin
871 Result := FCharsetID;
872 end;
873
874 function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
875 var i: integer;
876 begin
877 Result := '';
878 if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
879 (CharSetMap[CharSetID].CharSetID = CharSetID) then
880 begin
881 Result := CharSetMap[CharSetID].CharSetName;
882 Exit;
883 end;
884
885 for i := 0 to Length(FUserCharSetMap) - 1 do
886 if FUserCharSetMap[i].CharSetID = CharSetID then
887 begin
888 Result := FUserCharSetMap[i].CharSetName;
889 Exit;
890 end;
891 end;
892
893 function TFBAttachment.CharSetID2CodePage(CharSetID: integer;
894 var CodePage: TSystemCodePage): boolean;
895 var i: integer;
896 begin
897 Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
898 and (CharSetMap[CharSetID].CharSetID = CharSetID);
899 if Result then
900 begin
901 CodePage := CharSetMap[CharSetID].CodePage;
902 Result := true;
903 Exit;
904 end;
905
906 for i := 0 to Length(FUserCharSetMap) - 1 do
907 if FUserCharSetMap[i].CharSetID = CharSetID then
908 begin
909 CodePage := FUserCharSetMap[i].CodePage;
910 Result := true;
911 Exit;
912 end;
913 end;
914
915 function TFBAttachment.CodePage2CharSetID(CodePage: TSystemCodePage;
916 var CharSetID: integer): boolean;
917 var i: integer;
918 begin
919 Result := false;
920 for i := Low(CharSetMap) to High(CharSetMap) do
921 if (CharSetMap[i].AllowReverseLookup) and (CharSetMap[i].CodePage = CodePage) then
922 begin
923 CharSetID := CharSetMap[i].CharSetID;
924 Result := true;
925 Exit;
926 end;
927
928 for i := 0 to Length(FUserCharSetMap) - 1 do
929 if (FUserCharSetMap[i].AllowReverseLookup) and (FUserCharSetMap[i].CodePage = CodePage) then
930 begin
931 CharSetID := FUserCharSetMap[i].CharSetID;
932 Result := true;
933 Exit;
934 end;
935 end;
936
937 function TFBAttachment.CharSetName2CharSetID(CharSetName: AnsiString;
938 var CharSetID: integer): boolean;
939 var i: integer;
940 begin
941 Result := false;
942 for i := Low(CharSetMap) to High(CharSetMap) do
943 if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
944 begin
945 CharSetID := CharSetMap[i].CharSetID;
946 Result := true;
947 Exit;
948 end;
949
950 for i := 0 to Length(FUserCharSetMap) - 1 do
951 if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
952 begin
953 CharSetID := FUserCharSetMap[i].CharSetID;
954 Result := true;
955 Exit;
956 end;
957 end;
958
959 function TFBAttachment.CharSetWidth(CharSetID: integer; var Width: integer
960 ): boolean;
961 var i: integer;
962 begin
963 Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
964 and (CharSetMap[CharSetID].CharSetID = CharSetID);
965 if Result then
966 begin
967 Width := CharSetMap[CharSetID].CharSetWidth;
968 Result := true;
969 Exit;
970 end;
971
972 for i := 0 to Length(FUserCharSetMap) - 1 do
973 if FUserCharSetMap[i].CharSetID = CharSetID then
974 begin
975 Width := FUserCharSetMap[i].CharSetWidth;
976 Result := true;
977 Exit;
978 end;
979 end;
980
981 const
982 sqlLookupCharSet = 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER From RDB$CHARACTER_SETS '+
983 'Where RDB$SYSTEM_FLAG = 0 and RDB$CHARACTER_SET_NAME = UPPER(?)';
984
985 procedure TFBAttachment.RegisterCharSet(CharSetName: AnsiString;
986 CodePage: TSystemCodePage; AllowReverseLookup: boolean; out CharSetID: integer
987 );
988 var CharSets: IResultSet;
989 idx: integer;
990 begin
991 if CharSetName2CharSetID(CharSetName,CharSetID) then
992 IBError(ibxeCharacterSetExists,[CharSetName]);
993
994 CharSets := OpenCursorAtStart(sqlLookupCharSet,[CharSetName]);
995 if CharSets.IsEof then
996 IBError(ibxeUnknownUserCharSet,[CharSetName]);
997
998 idx := Length(FUserCharSetMap);
999 SetLength(FUserCharSetMap,idx+1);
1000 FUserCharSetMap[idx].AllowReverseLookup := AllowReverseLookup;
1001 FUserCharSetMap[idx].CharSetID := CharSets[0].AsInteger;
1002 FUserCharSetMap[idx].CharSetName := AnsiUpperCase(CharSetName);
1003 FUserCharSetMap[idx].CharSetWidth := CharSets[1].AsInteger;
1004 FUserCharSetMap[idx].CodePage := CodePage;
1005 CharSetID := CharSets[0].AsInteger;
1006 end;
1007
1008 function TFBAttachment.GetTimeZoneServices: ITimeZoneServices;
1009 begin
1010 IBError(ibxeNotSupported,[]);
1011 end;
1012
1013 function TFBAttachment.HasTimeZoneSupport: boolean;
1014 begin
1015 Result := false;
1016 end;
1017
1018 { TDPBItem }
1019
1020 function TDPBItem.getParamTypeName: AnsiString;
1021 begin
1022 Result := DPBPrefix + DPBConstantNames[getParamType];
1023 end;
1024
1025 { TDPB }
1026
1027 constructor TDPB.Create(api: TFBClientAPI);
1028 begin
1029 inherited Create(api);
1030 FDataLength := 1;
1031 FBuffer^ := isc_dpb_version1;
1032 end;
1033
1034 function TDPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
1035 begin
1036 if ParamType <= isc_dpb_last_dpb_constant then
1037 Result := DPBConstantNames[ParamType]
1038 else
1039 Result := '';
1040 end;
1041
1042 function TDPB.LookupItemType(ParamTypeName: AnsiString): byte;
1043 var i: byte;
1044 begin
1045 Result := 0;
1046 ParamTypeName := LowerCase(ParamTypeName);
1047 if (Pos(DPBPrefix, ParamTypeName) = 1) then
1048 Delete(ParamTypeName, 1, Length(DPBPrefix));
1049
1050 for i := 1 to isc_dpb_last_dpb_constant do
1051 if (ParamTypeName = DPBConstantNames[i]) then
1052 begin
1053 Result := i;
1054 break;
1055 end;
1056 end;
1057
1058 end.
1059