ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBAttachment.pas
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: 39751 byte(s)
Log Message: 
Merged into public release

File Contents

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