ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/client/FBAttachment.pas

Comparing:
ibx/trunk/fbintf/client/FBAttachment.pas (file contents), Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
ibx/branches/udr/client/FBAttachment.pas (file contents), Revision 388 by tony, Wed Jan 19 13:58:37 2022 UTC

#	Line 16 | Line 16
16		*
17		*  The Initial Developer of the Original Code is Tony Whyman.
18		*
19	<	*  The Original Code is (C) 2016 Tony Whyman, MWA Software
19	>	*  The Original Code is (C) 2016-2021 Tony Whyman, MWA Software
20		*  (http://www.mwasoftware.co.uk).
21		*
22		*  All Rights Reserved.
#	Line 38 | Line 38 | unit FBAttachment;
38		interface
39
40		uses
41	<	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock, FBActivityMonitor;
41	>	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock,
42	>	FBActivityMonitor, FBClientAPI, IBUtils;
43	>
44	>	const
45	>	DefaultMaxInlineBlobLimit = 8192;
46
47		type
48		TCharsetMap = record
#	Line 49 | Line 53 | type
53		AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
54		end;
55
56	+	{ Database Journalling.
57	+
58	+	This class is intended to support a client side journal of all database
59	+	updates, inserts and deletes made by the client during a session. It also records
60	+	the transaction each update was made under.
61	+
62	+	The database schema is required to include a control table "IBX$JOURNALS" and
63	+	an SQL Sequence IBX$SESSIONS. These are created by the class when the
64	+	database is opened, if they are not already present. However, it is recommended
65	+	that they are created as an orginal part of the database schema in order to
66	+	unnecessarily avoid each user being given sufficient priviledge to create tables
67	+	and Sequences.
68	+
69	+	Syntax:
70	+
71	+	Transaction Start:
72	+	*S:<date/time>,<attachmentid>,<session id>,<transaction no.>,<string length>:<transaction Name>,<string length>:<TPB>,<default Completion>
73	+
74	+	Transaction Commit:
75	+	*C:<date/time>,<attachmentid>,<session id>,<transaction no.>
76	+
77	+	Transaction Commit retaining :
78	+	*c:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
79	+
80	+	Transaction Rollback:
81	+	*R:<date/time>,<attachmentid>,<session id>,<transaction no.>
82	+
83	+	Transaction Rollback retaining:
84	+	*r:<date/time>,<attachmentid>,<session id>,<transaction no.><old transaction no.>
85	+
86	+	Update/Insert/Delete
87	+	*Q:<date/time>,<attachmentid>,<session id>,<transaction no.>,<length of query text in bytes>:<query text>
88	+
89	+	}
90	+
91	+	{ TFBJournaling }
92	+
93	+	TFBJournaling = class(TActivityHandler, IJournallingHook)
94	+	private
95	+	{Logfile}
96	+	const sQueryJournal          = '*Q:''%s'',%d,%d,%d,%d:%s' + LineEnding;
97	+	const sTransStartJnl         = '*S:''%s'',%d,%d,%d,%d:%s,%d:%s,%d' + LineEnding;
98	+	const sTransCommitJnl        = '*C:''%s'',%d,%d,%d' + LineEnding;
99	+	const sTransCommitFailJnl    = '*F:''%s'',%d,%d,%d' + LineEnding;
100	+	const sTransCommitRetJnl     = '*c:''%s'',%d,%d,%d,%d' + LineEnding;
101	+	const sTransRollBackJnl      = '*R:''%s'',%d,%d,%d' + LineEnding;
102	+	const sTransRollBackFailJnl  = '*f:''%s'',%d,%d,%d' + LineEnding;
103	+	const sTransRollBackRetJnl   = '*r:''%s'',%d,%d,%d,%d' + LineEnding;
104	+	private
105	+	FOptions: TJournalOptions;
106	+	FJournalFilePath: string;
107	+	FJournalFileStream: TStream;
108	+	FSessionID: integer;
109	+	FDoNotJournal: boolean;
110	+	function GetDateTimeFmt: AnsiString;
111	+	protected
112	+	procedure EndSession(RetainJournal: boolean);
113	+	function GetAttachment: IAttachment; virtual; abstract;
114	+	public
115	+	{IAttachment}
116	+	procedure Disconnect(Force: boolean=false); virtual;
117	+	public
118	+	{IJournallingHook}
119	+	procedure TransactionStart(Tr: ITransaction);
120	+	function TransactionEnd( TransactionID: integer; Completion: TTrCompletionState): boolean;
121	+	procedure TransactionRetained(Tr: ITransaction; OldTransactionID: integer;
122	+	Action: TTransactionAction);
123	+	procedure ExecQuery(Stmt: IStatement);
124	+	procedure ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
125	+	public
126	+	{Client side Journaling}
127	+	function JournalingActive: boolean;
128	+	function GetJournalOptions: TJournalOptions;
129	+	function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
130	+	function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
131	+	function StartJournaling(S: TStream; Options: TJournalOptions): integer; overload;
132	+	procedure StopJournaling(RetainJournal: boolean);
133	+	end;
134	+
135		{ TFBAttachment }
136
137	<	TFBAttachment = class(TActivityHandler)
137	>	TFBAttachment = class(TFBJournaling)
138		private
139		FDPB: IDPB;
140		FFirebirdAPI: IFirebirdAPI;
141		FODSMajorVersion: integer;
142		FODSMinorVersion: integer;
143		FUserCharSetMap: array of TCharSetMap;
144	<	protected
145	<	FDatabaseName: AnsiString;
146	<	FRaiseExceptionOnConnectError: boolean;
144	>	FSecDatabase: AnsiString;
145	>	FInlineBlobLimit: integer;
146	>	FAttachmentID: integer;
147		FSQLDialect: integer;
148		FHasDefaultCharSet: boolean;
149		FCharSetID: integer;
150		FCodePage: TSystemCodePage;
151		FRemoteProtocol: AnsiString;
152		FAuthMethod: AnsiString;
153	<	constructor Create(DatabaseName: AnsiString; DPB: IDPB;
153	>	FHasConnectionInfo: boolean;
154	>	procedure NeedDBInfo;
155	>	procedure NeedConnectionInfo;
156	>	protected
157	>	FDatabaseName: AnsiString;
158	>	FRaiseExceptionOnConnectError: boolean;
159	>	constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB;
160		RaiseExceptionOnConnectError: boolean);
161		procedure CheckHandle; virtual; abstract;
162	+	procedure ClearCachedInfo;
163		function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
74	–	procedure GetODSAndConnectionInfo;
164		function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
165		function IsConnected: boolean; virtual; abstract;
166		procedure EndAllTransactions;
167		procedure DPBFromCreateSQL(CreateSQL: AnsiString);
168		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
169	+	procedure SetSQLDialect(aValue: integer);
170	+	procedure UseServerICUChanged; virtual;
171		public
172		destructor Destroy; override;
173	+	procedure Disconnect(Force: boolean); override;
174	+	function getFirebirdAPI: IFirebirdAPI;
175		function getDPB: IDPB;
176		function AllocateBPB: IBPB;
177		function AllocateDIRB: IDIRB;
178	<	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
179	<	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
180	<	procedure Disconnect(Force: boolean=false); virtual; abstract;
178	>	function StartTransaction(TPB: array of byte;
179	>	DefaultCompletion: TTransactionCompletion;
180	>	aName: AnsiString=''): ITransaction; overload; virtual; abstract;
181	>	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion;
182	>	aName: AnsiString=''): ITransaction; overload; virtual; abstract;
183		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
184		procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
185		procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
#	Line 93 | Line 188 | type
188		function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
189		function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
190		function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
191	<	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
191	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
192	>	Scrollable: boolean=false): IResultSet; overload;
193		function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
194		params: array of const): IResultSet; overload;
195	<	function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
195	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
196		function OpenCursor(transaction: ITransaction; sql: AnsiString;
197		params: array of const): IResultSet; overload;
198	<	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
198	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
199	>	params: array of const): IResultSet; overload;
200	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
201	>	params: array of const): IResultSet; overload;
202		function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
203	+	Scrollable: boolean=false): IResultSet; overload;
204	+	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
205	+	params: array of const): IResultSet; overload;
206	+	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
207		params: array of const): IResultSet; overload;
208	<	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
208	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
209		function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
210		params: array of const): IResultSet; overload;
211	<	function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
211	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
212	>	params: array of const): IResultSet; overload;
213	>	function OpenCursorAtStart(sql: AnsiString;Scrollable: boolean=false): IResultSet; overload;
214	>	function OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
215	>	params: array of const): IResultSet; overload;
216		function OpenCursorAtStart(sql: AnsiString;
217		params: array of const): IResultSet; overload;
218	<	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
219	<	function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
218	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
219	>	function Prepare(transaction: ITransaction; sql: AnsiString; CursorName: AnsiString=''): IStatement; overload;
220		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
221	<	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
221	>	aSQLDialect: integer; GenerateParamNames: boolean=false;
222	>	CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload; virtual; abstract;
223		function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
224	<	GenerateParamNames: boolean=false): IStatement; overload;
224	>	GenerateParamNames: boolean=false;
225	>	CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload;
226		function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
227		function GetEventHandler(Event: AnsiString): IEvents; overload;
228
229		function GetSQLDialect: integer;
230	+	function GetAttachmentID: integer;
231	+	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
232	+	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
233		function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
234	+	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
235		function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
236	<	property SQLDialect: integer read FSQLDialect;
236	>	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString
237	>	): IArray; overload;
238	>	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload; virtual; abstract;
239	>	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
240	>	function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload; virtual; abstract;
241	>	property SQLDialect: integer read GetSQLDialect;
242		property DPB: IDPB read FDPB;
243	<	public
244	<	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
245	<	function GetDBInformation(Request: byte): IDBInformation; overload;
246	<	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
247	<	function GetConnectString: AnsiString;
248	<	function GetRemoteProtocol: AnsiString;
249	<	function GetAuthenticationMethod: AnsiString;
250	<	function GetODSMajorVersion: integer;
251	<	function GetODSMinorVersion: integer;
252	<	{Character Sets}
253	<	function HasDefaultCharSet: boolean;
254	<	function GetDefaultCharSetID: integer;
255	<	function GetCharsetName(CharSetID: integer): AnsiString;
256	<	function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
257	<	function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
258	<	function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
259	<	function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
260	<	procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
261	<	AllowReverseLookup:boolean; out CharSetID: integer);
262	<	property CharSetID: integer read FCharSetID;
263	<	property CodePage: TSystemCodePage read FCodePage;
243	>	public
244	>	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
245	>	function GetDBInformation(Request: byte): IDBInformation; overload;
246	>	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
247	>	function GetConnectString: AnsiString;
248	>	function GetRemoteProtocol: AnsiString;
249	>	function GetAuthenticationMethod: AnsiString;
250	>	function GetSecurityDatabase: AnsiString;
251	>	function GetODSMajorVersion: integer;
252	>	function GetODSMinorVersion: integer;
253	>	function GetCharSetID: integer;
254	>	function HasDecFloatSupport: boolean; virtual;
255	>	function GetInlineBlobLimit: integer;
256	>	procedure SetInlineBlobLimit(limit: integer);
257	>	function HasBatchMode: boolean; virtual;
258	>	function HasTable(aTableName: AnsiString): boolean;
259	>	function HasFunction(aFunctionName: AnsiString): boolean;
260	>	function HasProcedure(aProcName: AnsiString): boolean;
261	>
262	>	public
263	>	{Character Sets}
264	>	function HasDefaultCharSet: boolean;
265	>	function GetDefaultCharSetID: integer;
266	>	function GetCharsetName(CharSetID: integer): AnsiString;
267	>	function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
268	>	function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
269	>	function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
270	>	function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
271	>	procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
272	>	AllowReverseLookup:boolean; out CharSetID: integer);
273	>	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData; virtual; abstract;
274	>	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData; virtual; abstract;
275	>	property CharSetID: integer read GetCharSetID;
276	>	property CodePage: TSystemCodePage read FCodePage;
277	>
278	>	public
279	>	{Time Zone Support}
280	>	function GetTimeZoneServices: ITimeZoneServices; virtual;
281	>	function HasTimeZoneSupport: boolean; virtual;
282	>
283	>	end;
284	>
285	>	{ TDPBItem }
286	>
287	>	TDPBItem = class(TParamBlockItem,IDPBItem)
288	>	public
289	>	function getParamTypeName: AnsiString; override;
290	>	end;
291	>
292	>	{ TDPB }
293	>
294	>	TDPB = class (TCustomParamBlock<TDPBItem,IDPBItem>, IDPB)
295	>	protected
296	>	function LookupItemType(ParamTypeName: AnsiString): byte; override;
297	>	public
298	>	constructor Create(api: TFBClientAPI);
299	>	function GetParamTypeName(ParamType: byte): Ansistring;
300	>	{$IFDEF FPC}
301	>	function IDPB.GetDPBParamTypeName = GetParamTypeName;
302	>	{$ELSE}
303	>	function GetDPBParamTypeName(ParamType: byte): Ansistring;
304	>	{$ENDIF}
305		end;
306
307		implementation
308
309	<	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
309	>	uses FBMessages, IBErrorCodes, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
310	>
311	>	const
312	>	{Journaling}
313	>	sJournalTableName = 'IBX$JOURNALS';
314	>	sSequenceName = 'IBX$SESSIONS';
315	>
316	>	sqlCreateJournalTable =
317	>	'Create Table ' + sJournalTableName + '(' +
318	>	'  IBX$SessionID Integer not null, '+
319	>	'  IBX$TransactionID Integer not null, '+
320	>	'  IBX$OldTransactionID Integer, '+
321	>	'  IBX$USER VarChar(32) Default CURRENT_USER, '+
322	>	'  IBX$CREATED TIMESTAMP Default CURRENT_TIMESTAMP, '+
323	>	'  Primary Key(IBX$SessionID,IBX$TransactionID)' +
324	>	')';
325	>
326	>	sqlCreateSequence = 'CREATE SEQUENCE ' + sSequenceName;
327	>
328	>	sqlGetNextSessionID = 'Select Gen_ID(' + sSequenceName + ',1) as SessionID From RDB$DATABASE';
329	>
330	>	sqlRecordJournalEntry = 'Insert into ' + sJournalTableName + '(IBX$SessionID,IBX$TransactionID,IBX$OldTransactionID) '+
331	>	'Values(?,?,?)';
332	>
333	>	sqlCleanUpSession = 'Delete From ' + sJournalTableName + ' Where IBX$SessionID = ?';
334
335		const
336		CharSetMap: array [0..69] of TCharsetMap = (
#	Line 223 | Line 406 | const
406		(CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936; AllowReverseLookup: true)
407		);
408
409	+	const
410	+	isc_dpb_last_dpb_constant = isc_dpb_decfloat_traps;
411	+
412	+	DPBConstantNames: array[1..isc_dpb_last_dpb_constant] of string = (
413	+	'cdd_pathname',
414	+	'allocation',
415	+	'journal',
416	+	'page_size',
417	+	'num_buffers',
418	+	'buffer_length',
419	+	'debug',
420	+	'garbage_collect',
421	+	'verify',
422	+	'sweep',
423	+	'enable_journal',
424	+	'disable_journal',
425	+	'dbkey_scope',
426	+	'number_of_users',
427	+	'trace',
428	+	'no_garbage_collect',
429	+	'damaged',
430	+	'license',
431	+	'sys_user_name',
432	+	'encrypt_key',
433	+	'activate_shadow',
434	+	'sweep_interval',
435	+	'delete_shadow',
436	+	'force_write',
437	+	'begin_log',
438	+	'quit_log',
439	+	'no_reserve',
440	+	'user_name',
441	+	'password',
442	+	'password_enc',
443	+	'sys_user_name_enc',
444	+	'interp',
445	+	'online_dump',
446	+	'old_file_size',
447	+	'old_num_files',
448	+	'old_file',
449	+	'old_start_page',
450	+	'old_start_seqno',
451	+	'old_start_file',
452	+	'drop_walfile',
453	+	'old_dump_id',
454	+	'wal_backup_dir',
455	+	'wal_chkptlen',
456	+	'wal_numbufs',
457	+	'wal_bufsize',
458	+	'wal_grp_cmt_wait',
459	+	'lc_messages',
460	+	'lc_ctype',
461	+	'cache_manager',
462	+	'shutdown',
463	+	'online',
464	+	'shutdown_delay',
465	+	'reserved',
466	+	'overwrite',
467	+	'sec_attach',
468	+	'disable_wal',
469	+	'connect_timeout',
470	+	'dummy_packet_interval',
471	+	'gbak_attach',
472	+	'sql_role_name',
473	+	'set_page_buffers',
474	+	'working_directory',
475	+	'sql_dialect',
476	+	'set_db_readonly',
477	+	'set_db_sql_dialect',
478	+	'gfix_attach',
479	+	'gstat_attach',
480	+	'set_db_charset',
481	+	'gsec_attach',
482	+	'address_path' ,
483	+	'process_id',
484	+	'no_db_triggers',
485	+	'trusted_auth',
486	+	'process_name',
487	+	'trusted_role',
488	+	'org_filename',
489	+	'utf8_filename',
490	+	'ext_call_depth',
491	+	'auth_block',
492	+	'client_version',
493	+	'remote_protocol',
494	+	'host_name',
495	+	'os_user',
496	+	'specific_auth_data',
497	+	'auth_plugin_list',
498	+	'auth_plugin_name',
499	+	'config',
500	+	'nolinger',
501	+	'reset_icu',
502	+	'map_attach',
503	+	'session_time_zone',
504	+	'set_db_replica',
505	+	'set_bind',
506	+	'decfloat_round',
507	+	'decfloat_traps'
508	+	);
509
510	+	type
511
512	+	{ TQueryProcessor }
513	+
514	+	TQueryProcessor=class(TSQLTokeniser)
515	+	private
516	+	FInString: AnsiString;
517	+	FIndex: integer;
518	+	FStmt: IStatement;
519	+	function DoExecute: AnsiString;
520	+	function GetParamValue(ParamIndex: integer): AnsiString;
521	+	protected
522	+	function GetChar: AnsiChar; override;
523	+	public
524	+	class function Execute(Stmt: IStatement): AnsiString;
525	+	end;
526	+
527	+	{ TQueryProcessor }
528	+
529	+	function TQueryProcessor.DoExecute: AnsiString;
530	+	var token: TSQLTokens;
531	+	ParamIndex: integer;
532	+	begin
533	+	Result := '';
534	+	ParamIndex := 0;
535	+
536	+	while not EOF do
537	+	begin
538	+	token := GetNextToken;
539	+	case token of
540	+	sqltPlaceHolder:
541	+	begin
542	+	Result := Result + GetParamValue(ParamIndex);
543	+	Inc(ParamIndex);
544	+	end;
545	+	else
546	+	Result := Result + TokenText;
547	+	end;
548	+	end;
549	+	end;
550	+
551	+	function TQueryProcessor.GetParamValue(ParamIndex: integer): AnsiString;
552	+	begin
553	+	with FStmt.SQLParams[ParamIndex] do
554	+	begin
555	+	if IsNull then
556	+	Result := 'NULL'
557	+	else
558	+	case GetSQLType of
559	+	SQL_BLOB:
560	+	if getSubType = 1 then {string}
561	+	Result := '''' + SQLSafeString(GetAsString) + ''''
562	+	else
563	+	Result := TSQLXMLReader.FormatBlob(GetAsString,getSubType);
564	+
565	+	SQL_ARRAY:
566	+	Result := TSQLXMLReader.FormatArray(getAsArray);
567	+
568	+	SQL_VARYING,
569	+	SQL_TEXT,
570	+	SQL_TIMESTAMP,
571	+	SQL_TYPE_DATE,
572	+	SQL_TYPE_TIME,
573	+	SQL_TIMESTAMP_TZ_EX,
574	+	SQL_TIME_TZ_EX,
575	+	SQL_TIMESTAMP_TZ,
576	+	SQL_TIME_TZ:
577	+	Result := '''' + SQLSafeString(GetAsString) + '''';
578	+	else
579	+	Result := GetAsString;
580	+	end;
581	+	end;
582	+	end;
583	+
584	+	function TQueryProcessor.GetChar: AnsiChar;
585	+	begin
586	+	if FIndex <= Length(FInString) then
587	+	begin
588	+	Result := FInString[FIndex];
589	+	Inc(FIndex);
590	+	end
591	+	else
592	+	Result := #0;
593	+	end;
594	+
595	+	class function TQueryProcessor.Execute(Stmt: IStatement): AnsiString;
596	+	begin
597	+	if not Stmt.IsPrepared then
598	+	IBError(ibxeSQLClosed,[]);
599	+	with self.Create do
600	+	try
601	+	FStmt := Stmt;
602	+	FInString := Stmt.GetProcessedSQLText;
603	+	FIndex := 1;
604	+	Result := Trim(DoExecute);
605	+	finally
606	+	Free;
607	+	end;
608	+	end;
609	+
610	+	{ TFBJournaling }
611	+
612	+	function TFBJournaling.GetDateTimeFmt: AnsiString;
613	+	begin
614	+	{$IF declared(DefaultFormatSettings)}
615	+	with DefaultFormatSettings do
616	+	{$ELSE}
617	+	{$IF declared(FormatSettings)}
618	+	with FormatSettings do
619	+	{$IFEND}
620	+	{$IFEND}
621	+	Result := ShortDateFormat + ' ' + LongTimeFormat + '.zzzz'
622	+	end;
623	+
624	+	procedure TFBJournaling.EndSession(RetainJournal: boolean);
625	+	begin
626	+	if JournalingActive and (FJournalFilePath <> '') then
627	+	begin
628	+	FreeAndNil(FJournalFileStream);
629	+	if not (joNoServerTable in FOptions) and not RetainJournal then
630	+	try
631	+	GetAttachment.ExecuteSQL([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],
632	+	sqlCleanUpSession,[FSessionID]);
633	+	sysutils.DeleteFile(FJournalFilePath);
634	+	except On E: EIBInterBaseError do
635	+	if E.IBErrorCode <> isc_lost_db_connection then
636	+	raise;
637	+	{ignore - do not delete journal if database gone away}
638	+	end;
639	+	FSessionID := -1;
640	+	end;
641	+	end;
642	+
643	+	procedure TFBJournaling.Disconnect(Force: boolean);
644	+	begin
645	+	if JournalingActive then
646	+	EndSession(Force);
647	+	end;
648	+
649	+	procedure TFBJournaling.TransactionStart(Tr: ITransaction);
650	+	var LogEntry: AnsiString;
651	+	TPBText: AnsiString;
652	+	begin
653	+	if not (joNoServerTable in FOptions) then
654	+	try
655	+	FDoNotJournal := true;
656	+	GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,NULL]);
657	+	finally
658	+	FDoNotJournal := false;
659	+	end;
660	+	TPBText := Tr.getTPB.AsText;
661	+	LogEntry := Format(sTransStartJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
662	+	GetAttachment.GetAttachmentID,
663	+	FSessionID,
664	+	Tr.GetTransactionID,
665	+	Length(Tr.TransactionName),
666	+	Tr.TransactionName,
667	+	Length(TPBText),TPBText,
668	+	ord(tr.GetDefaultCompletion)]);
669	+	if assigned(FJournalFileStream) then
670	+	FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
671	+	end;
672	+
673	+	function TFBJournaling.TransactionEnd(TransactionID: integer;
674	+	Completion: TTrCompletionState): boolean;
675	+
676	+	var LogEntry: AnsiString;
677	+	begin
678	+	Result := false;
679	+	case Completion of
680	+	trRolledback:
681	+	begin
682	+	LogEntry := Format(sTransRollbackJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
683	+	GetAttachment.GetAttachmentID,
684	+	FSessionID,TransactionID]);
685	+	Result := true;
686	+	end;
687	+
688	+	trRollbackFailed:
689	+	begin
690	+	LogEntry := Format(sTransRollbackFailJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
691	+	GetAttachment.GetAttachmentID,
692	+	FSessionID,TransactionID]);
693	+	Result := true;
694	+	end;
695	+
696	+	trCommitted:
697	+	begin
698	+	LogEntry := Format(sTransCommitJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
699	+	GetAttachment.GetAttachmentID,
700	+	FSessionID,TransactionID]);
701	+	Result := true;
702	+	end;
703	+
704	+	trCommitFailed:
705	+	begin
706	+	LogEntry := Format(sTransCommitFailJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
707	+	GetAttachment.GetAttachmentID,
708	+	FSessionID,TransactionID]);
709	+	Result := true;
710	+	end;
711	+	end;
712	+	if assigned(FJournalFileStream) then
713	+	FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
714	+	end;
715	+
716	+	procedure TFBJournaling.TransactionRetained(Tr: ITransaction;
717	+	OldTransactionID: integer; Action: TTransactionAction);
718	+	var LogEntry: AnsiString;
719	+	begin
720	+	case Action of
721	+	TACommitRetaining:
722	+	LogEntry := Format(sTransCommitRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
723	+	GetAttachment.GetAttachmentID,
724	+	FSessionID,Tr.GetTransactionID,OldTransactionID]);
725	+	TARollbackRetaining:
726	+	LogEntry := Format(sTransRollbackRetJnl,[FBFormatDateTime(GetDateTimeFmt,Now),
727	+	GetAttachment.GetAttachmentID,
728	+	FSessionID,Tr.GetTransactionID,OldTransactionID]);
729	+	end;
730	+	if assigned(FJournalFileStream) then
731	+	FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
732	+
733	+	if not (joNoServerTable in FOptions) then
734	+	try
735	+	FDoNotJournal := true;
736	+	GetAttachment.ExecuteSQL(Tr,sqlRecordJournalEntry,[FSessionID,Tr.GetTransactionID,OldTransactionID]);
737	+	finally
738	+	FDoNotJournal := false;
739	+	end;
740	+	end;
741	+
742	+	procedure TFBJournaling.ExecQuery(Stmt: IStatement);
743	+	var SQL: AnsiString;
744	+	LogEntry: AnsiString;
745	+	begin
746	+	SQL := TQueryProcessor.Execute(Stmt);
747	+	LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
748	+	GetAttachment.GetAttachmentID,
749	+	FSessionID,
750	+	Stmt.GetTransaction.GetTransactionID,
751	+	Length(SQL),SQL]);
752	+	if assigned(FJournalFileStream) then
753	+	FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
754	+	end;
755	+
756	+	procedure TFBJournaling.ExecImmediateJnl(sql: AnsiString; tr: ITransaction);
757	+	var LogEntry: AnsiString;
758	+	begin
759	+	LogEntry := Format(sQueryJournal,[FBFormatDateTime(GetDateTimeFmt,Now),
760	+	GetAttachment.GetAttachmentID,
761	+	FSessionID,
762	+	tr.GetTransactionID,
763	+	Length(sql),sql]);
764	+	if assigned(FJournalFileStream) then
765	+	FJournalFileStream.Write(LogEntry[1],Length(LogEntry));
766	+	end;
767	+
768	+	function TFBJournaling.JournalingActive: boolean;
769	+	begin
770	+	Result := (FJournalFileStream <> nil) and not FDoNotJournal;
771	+	end;
772	+
773	+	function TFBJournaling.GetJournalOptions: TJournalOptions;
774	+	begin
775	+	Result := FOptions;
776	+	end;
777	+
778	+	function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString): integer;
779	+	begin
780	+	Result := StartJournaling(aJournalLogFile,[joReadWriteTransactions,joModifyQueries]);
781	+	end;
782	+
783	+	function TFBJournaling.StartJournaling(aJournalLogFile: AnsiString;
784	+	Options: TJournalOptions): integer;
785	+	begin
786	+	try
787	+	StartJournaling(TFileStream.Create(aJournalLogFile,fmCreate),Options);
788	+	finally
789	+	FJournalFilePath := aJournalLogFile;
790	+	end;
791	+	end;
792	+
793	+	function TFBJournaling.StartJournaling(S: TStream; Options: TJournalOptions
794	+	): integer;
795	+	begin
796	+	FOptions := Options;
797	+	if not (joNoServerTable in FOptions) then
798	+	with GetAttachment do
799	+	begin
800	+	if  not HasTable(sJournalTableName) then
801	+	begin
802	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateJournalTable);
803	+	ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateSequence);
804	+	end;
805	+	FSessionID := OpenCursorAtStart(sqlGetNextSessionID)[0].AsInteger;
806	+	end;
807	+	FJournalFileStream := S;
808	+	Result := FSessionID;
809	+	end;
810	+
811	+	procedure TFBJournaling.StopJournaling(RetainJournal: boolean);
812	+	begin
813	+	EndSession(RetainJournal);
814	+	end;
815
816		{ TFBAttachment }
817
818	<	procedure TFBAttachment.GetODSAndConnectionInfo;
819	<	var DBInfo: IDBInformation;
233	<	i: integer;
234	<	Stmt: IStatement;
818	>	procedure TFBAttachment.NeedConnectionInfo;
819	>	var Stmt: IStatement;
820		ResultSet: IResultSet;
821		Param: IDPBItem;
822		begin
823	<	if not IsConnected then Exit;
824	<	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
240	<	isc_info_db_SQL_Dialect]);
241	<	for i := 0 to DBInfo.GetCount - 1 do
242	<	with DBInfo[i] do
243	<	case getItemType of
244	<	isc_info_ods_minor_version:
245	<	FODSMinorVersion := getAsInteger;
246	<	isc_info_ods_version:
247	<	FODSMajorVersion := getAsInteger;
248	<	isc_info_db_SQL_Dialect:
249	<	FSQLDialect := getAsInteger;
250	<	end;
251	<
823	>	if not IsConnected or FHasConnectionInfo then Exit;
824	>	NeedDBInfo;
825		FCharSetID := 0;
826		FRemoteProtocol := '';
827		FAuthMethod := 'Legacy_Auth';
828	+	FSecDatabase := 'Default';
829		if FODSMajorVersion > 11 then
830		begin
831		Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
832	<	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD From MON$ATTACHMENTS '+
833	<	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
832	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
833	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION ');
834		ResultSet := Stmt.OpenCursor;
835		if ResultSet.FetchNext then
836		begin
837		FCharSetID := ResultSet[0].AsInteger;
838	<	FRemoteProtocol := ResultSet[1].AsString;
839	<	FAuthMethod := ResultSet[2].AsString;
838	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
839	>	FAuthMethod := Trim(ResultSet[2].AsString);
840	>	FSecDatabase := Trim(ResultSet[3].AsString);
841		end
842		end
843		else
#	Line 275 | Line 850 | begin
850		if ResultSet.FetchNext then
851		begin
852		FCharSetID := ResultSet[0].AsInteger;
853	<	FRemoteProtocol := ResultSet[1].AsString;
853	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
854		end
855		end
856		else
#	Line 292 | Line 867 | begin
867		end;
868		end;
869		FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
870	+	FHasConnectionInfo := true;
871		end;
872
873	<	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
874	<	RaiseExceptionOnConnectError: boolean);
873	>	procedure TFBAttachment.NeedDBInfo;
874	>	var DBInfo: IDBInformation;
875	>	i: integer;
876	>	begin
877	>	if not IsConnected or (FAttachmentID > 0) then Exit;
878	>	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
879	>	isc_info_db_SQL_Dialect, isc_info_attachment_id]);
880	>	for i := 0 to DBInfo.GetCount - 1 do
881	>	with DBInfo[i] do
882	>	case getItemType of
883	>	isc_info_ods_minor_version:
884	>	FODSMinorVersion := getAsInteger;
885	>	isc_info_ods_version:
886	>	FODSMajorVersion := getAsInteger;
887	>	isc_info_db_SQL_Dialect:
888	>	FSQLDialect := getAsInteger;
889	>	isc_info_attachment_id:
890	>	FAttachmentID := getAsInteger;
891	>	end;
892	>	end;
893	>
894	>	constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString;
895	>	DPB: IDPB; RaiseExceptionOnConnectError: boolean);
896		begin
897		inherited Create;
898	<	FFirebirdAPI := FirebirdAPI; {Keep reference to interface}
898	>	FFirebirdAPI := api.GetAPI; {Keep reference to interface}
899		FSQLDialect := 3;
900		FDatabaseName := DatabaseName;
304	–	FDPB := DPB;
901		SetLength(FUserCharSetMap,0);
902	+	ClearCachedInfo;
903	+	FInlineBlobLimit := DefaultMaxInlineBlobLimit;
904	+	FDPB := DPB;
905		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
906	+	end;
907	+
908	+	procedure TFBAttachment.ClearCachedInfo;
909	+	begin
910	+	FHasDefaultCharSet := false;
911	+	FAttachmentID := 0;
912		FODSMajorVersion := 0;
913		FODSMinorVersion := 0;
914	+	FCodePage := CP_NONE;
915	+	FCharSetID := 0;
916	+	FRemoteProtocol := '';
917	+	FAuthMethod := '';
918	+	FSecDatabase := '';
919	+	FHasConnectionInfo := false;
920		end;
921
922		function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
#	Line 439 | Line 1050 | begin
1050		end;
1051		end;
1052
1053	+	procedure TFBAttachment.SetSQLDialect(aValue: integer);
1054	+	begin
1055	+	FSQLDialect := aValue;
1056	+	end;
1057	+
1058	+	procedure TFBAttachment.UseServerICUChanged;
1059	+	begin
1060	+	// Do nothing by default
1061	+	end;
1062	+
1063		destructor TFBAttachment.Destroy;
1064		begin
1065		Disconnect(true);
1066		inherited Destroy;
1067		end;
1068
1069	+	procedure TFBAttachment.Disconnect(Force: boolean);
1070	+	begin
1071	+	inherited Disconnect(Force);
1072	+	ClearCachedInfo;
1073	+	end;
1074	+
1075	+	function TFBAttachment.getFirebirdAPI: IFirebirdAPI;
1076	+	begin
1077	+	Result := FFirebirdAPI;
1078	+	end;
1079	+
1080		function TFBAttachment.getDPB: IDPB;
1081		begin
1082		Result := FDPB;
#	Line 452 | Line 1084 | end;
1084
1085		function TFBAttachment.AllocateBPB: IBPB;
1086		begin
1087	<	Result := TBPB.Create;
1087	>	Result := TBPB.Create(FFirebirdAPI as TFBClientAPI);
1088		end;
1089
1090		function TFBAttachment.AllocateDIRB: IDIRB;
1091		begin
1092	<	Result := TDIRB.Create;
1092	>	Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI);
1093		end;
1094
1095		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
1096		aSQLDialect: integer);
1097	+	var tr: ITransaction;
1098		begin
1099	<	ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
1099	>	tr := StartTransaction(TPB,taCommit);
1100	>	try
1101	>	ExecImmediate(tr,sql,aSQLDialect);
1102	>	tr.Commit;
1103	>	except
1104	>	tr.Rollback(true);
1105	>	raise;
1106	>	end;
1107		end;
1108
1109		procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
#	Line 473 | Line 1113 | end;
1113
1114		procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
1115		begin
1116	<	ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
1116	>	ExecImmediate(TPB,sql,FSQLDialect);
1117		end;
1118
1119		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
1120		SQLDialect: integer; params: array of const): IResults;
1121	+	var tr: ITransaction;
1122		begin
1123	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
1123	>	tr := StartTransaction(TPB,taCommit);
1124	>	try
1125	>	Result := ExecuteSQL(tr,sql,SQLDialect,params);
1126	>	tr.Commit;
1127	>	except
1128	>	tr.Rollback(true);
1129	>	raise;
1130	>	end;
1131		end;
1132
1133		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
#	Line 495 | Line 1143 | end;
1143		function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
1144		params: array of const): IResults;
1145		begin
1146	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
1146	>	Result := ExecuteSQL(TPB,sql,FSQLDialect,params);
1147		end;
1148
1149		function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
1150		params: array of const): IResults;
1151		begin
1152	<	with Prepare(transaction,sql,FSQLDialect) do
505	<	begin
506	<	SetParameters(SQLParams,params);
507	<	Result := Execute;
508	<	end;
1152	>	Result := ExecuteSQL(transaction,sql,FSQLDialect,params);
1153		end;
1154
1155		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1156	<	aSQLDialect: integer): IResultSet;
1156	>	aSQLDialect: integer; Scrollable: boolean): IResultSet;
1157		begin
1158	<	Result := OpenCursor(transaction,sql,aSQLDialect,[]);
1158	>	Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
1159		end;
1160
1161		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1162		aSQLDialect: integer; params: array of const): IResultSet;
1163	<	var Statement: IStatement;
1163	>
1164		begin
1165	<	CheckHandle;
522	<	Statement := Prepare(transaction,sql,aSQLDialect);
523	<	SetParameters(Statement.SQLParams,params);
524	<	Result := Statement.OpenCursor;
1165	>	Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
1166		end;
1167
1168	<	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
1169	<	): IResultSet;
1168	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1169	>	Scrollable: boolean): IResultSet;
1170		begin
1171	<	Result := OpenCursor(transaction,sql,FSQLDialect,[]);
1171	>	Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,[]);
1172		end;
1173
1174		function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1175		params: array of const): IResultSet;
1176		begin
1177	<	Result := OpenCursor(transaction,sql,FSQLDialect,params);
1177	>	Result := OpenCursor(transaction,sql,FSQLDialect,false,params);
1178	>	end;
1179	>
1180	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1181	>	Scrollable: boolean; params: array of const): IResultSet;
1182	>	begin
1183	>	Result := OpenCursor(transaction,sql,FSQLDialect,Scrollable,params);
1184	>	end;
1185	>
1186	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
1187	>	aSQLDialect: integer; Scrollable: boolean;
1188	>	params: array of const): IResultSet;
1189	>	var Statement: IStatement;
1190	>	begin
1191	>	CheckHandle;
1192	>	Statement := Prepare(transaction,sql,aSQLDialect);
1193	>	SetParameters(Statement.SQLParams,params);
1194	>	Result := Statement.OpenCursor(Scrollable);
1195		end;
1196
1197		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1198	<	sql: AnsiString; aSQLDialect: integer): IResultSet;
1198	>	sql: AnsiString; aSQLDialect: integer; Scrollable: boolean): IResultSet;
1199		begin
1200	<	Result := OpenCursor(transaction,sql,aSQLDialect,[]);
1200	>	Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,[]);
1201		Result.FetchNext;
1202		end;
1203
#	Line 550 | Line 1208 | begin
1208		Result.FetchNext;
1209		end;
1210
1211	<	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
1212	<	): IResultSet;
1211	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1212	>	sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
1213	>	params: array of const): IResultSet;
1214	>	begin
1215	>	Result := OpenCursor(transaction,sql,aSQLDialect,Scrollable,params);
1216	>	Result.FetchNext;
1217	>	end;
1218	>
1219	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1220	>	sql: AnsiString; Scrollable: boolean): IResultSet;
1221		begin
1222	<	Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
1222	>	Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,[]);
1223		end;
1224
1225		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
#	Line 562 | Line 1228 | begin
1228		Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
1229		end;
1230
1231	<	function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
1231	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
1232	>	sql: AnsiString; Scrollable: boolean; params: array of const): IResultSet;
1233	>	begin
1234	>	Result := OpenCursorAtStart(transaction,sql,FSQLDialect,Scrollable,params);
1235	>	end;
1236	>
1237	>	function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean
1238	>	): IResultSet;
1239		begin
1240	<	Result := OpenCursorAtStart(sql,[]);
1240	>	Result := OpenCursorAtStart(sql,Scrollable,[]);
1241	>	end;
1242	>
1243	>	function TFBAttachment.OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
1244	>	params: array of const): IResultSet;
1245	>	var tr: ITransaction;
1246	>	begin
1247	>	tr := StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit);
1248	>	try
1249	>	Result := OpenCursorAtStart(tr,sql,FSQLDialect,Scrollable,params);
1250	>	tr.Commit;
1251	>	except
1252	>	tr.Rollback(true);
1253	>	raise;
1254	>	end;
1255		end;
1256
1257		function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
1258		params: array of const): IResultSet;
1259		begin
1260	<	Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
1260	>	Result := OpenCursorAtStart(sql,false,params);
1261		end;
1262
1263	<	function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
1264	<	): IStatement;
1263	>	function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString;
1264	>	CursorName: AnsiString): IStatement;
1265		begin
1266	<	Result := Prepare(transaction,sql,FSQLDialect);
1266	>	Result := Prepare(transaction,sql,FSQLDialect,CursorName);
1267		end;
1268
1269		function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
1270	<	sql: AnsiString; GenerateParamNames: boolean): IStatement;
1270	>	sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean;
1271	>	CursorName: AnsiString): IStatement;
1272		begin
1273	<	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
1273	>	Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams,CursorName);
1274		end;
1275
1276		function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
#	Line 599 | Line 1287 | end;
1287
1288		function TFBAttachment.GetSQLDialect: integer;
1289		begin
1290	+	NeedDBInfo;
1291		Result := FSQLDialect;
1292		end;
1293
1294	+	function TFBAttachment.GetAttachmentID: integer;
1295	+	begin
1296	+	NeedDBInfo;
1297	+	Result := FAttachmentID;
1298	+	end;
1299	+
1300	+	function TFBAttachment.CreateBlob(transaction: ITransaction; RelationName,
1301	+	ColumnName: AnsiString; BPB: IBPB): IBlob;
1302	+	begin
1303	+	Result := CreateBlob(transaction,GetBlobMetaData(Transaction,RelationName,ColumnName),BPB);
1304	+	end;
1305	+
1306	+	function TFBAttachment.OpenBlob(transaction: ITransaction; RelationName,
1307	+	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
1308	+	begin
1309	+	Result := OpenBlob(Transaction,
1310	+	GetBlobMetaData(Transaction,RelationName,ColumnName),
1311	+	BlobID,BPB);
1312	+	end;
1313	+
1314		function TFBAttachment.OpenBlob(transaction: ITransaction; Field: ISQLData;
1315		BPB: IBPB): IBlob;
1316		begin
1317		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
1318		end;
1319
1320	+	function TFBAttachment.CreateArray(transaction: ITransaction; RelationName,
1321	+	ColumnName: AnsiString): IArray;
1322	+	begin
1323	+	Result := CreateArray(transaction,GetArrayMetaData(transaction,RelationName,ColumnName));
1324	+	end;
1325	+
1326	+	function TFBAttachment.OpenArray(transaction: ITransaction; RelationName,
1327	+	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
1328	+	begin
1329	+	Result := OpenArray(transaction,
1330	+	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
1331	+	end;
1332	+
1333		function TFBAttachment.GetDBInformation(Requests: array of byte
1334		): IDBInformation;
1335		var ReqBuffer: PByte;
#	Line 651 | Line 1373 | end;
1373
1374		function TFBAttachment.GetRemoteProtocol: AnsiString;
1375		begin
1376	+	NeedConnectionInfo;
1377		Result := FRemoteProtocol;
1378		end;
1379
1380		function TFBAttachment.GetAuthenticationMethod: AnsiString;
1381		begin
1382	+	NeedConnectionInfo;
1383		Result := FAuthMethod;
1384		end;
1385
1386	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
1387	+	begin
1388	+	NeedConnectionInfo;
1389	+	Result := FSecDatabase;
1390	+	end;
1391	+
1392		function TFBAttachment.GetODSMajorVersion: integer;
1393		begin
1394	+	NeedDBInfo;
1395		Result := FODSMajorVersion;
1396		end;
1397
1398		function TFBAttachment.GetODSMinorVersion: integer;
1399		begin
1400	+	NeedDBInfo;
1401		Result := FODSMinorVersion;
1402		end;
1403
1404	+	function TFBAttachment.GetCharSetID: integer;
1405	+	begin
1406	+	NeedConnectionInfo;
1407	+	Result := FCharSetID;
1408	+	end;
1409	+
1410	+	function TFBAttachment.HasDecFloatSupport: boolean;
1411	+	begin
1412	+	Result := false;
1413	+	end;
1414	+
1415	+	function TFBAttachment.GetInlineBlobLimit: integer;
1416	+	begin
1417	+	Result := FInlineBlobLimit;
1418	+	end;
1419	+
1420	+	procedure TFBAttachment.SetInlineBlobLimit(limit: integer);
1421	+	begin
1422	+	if limit > 32*1024 then
1423	+	FInlineBlobLimit := 32*1024
1424	+	else
1425	+	FInlineBlobLimit := limit;
1426	+	end;
1427	+
1428	+	function TFBAttachment.HasBatchMode: boolean;
1429	+	begin
1430	+	Result := false;
1431	+	end;
1432	+
1433	+	function TFBAttachment.HasTable(aTableName: AnsiString): boolean;
1434	+	begin
1435	+	Result := OpenCursorAtStart(
1436	+	'Select count(*) From RDB$RELATIONS Where RDB$RELATION_NAME = ?',
1437	+	[aTableName])[0].AsInteger > 0;
1438	+	end;
1439	+
1440	+	function TFBAttachment.HasFunction(aFunctionName: AnsiString): boolean;
1441	+	begin
1442	+	Result := OpenCursorAtStart(
1443	+	'Select count(*) From RDB$FUNCTIONS Where RDB$FUNCTION_NAME = ?',
1444	+	[aFunctionName])[0].AsInteger > 0;
1445	+	end;
1446	+
1447	+	function TFBAttachment.HasProcedure(aProcName: AnsiString): boolean;
1448	+	begin
1449	+	Result := OpenCursorAtStart(
1450	+	'Select count(*) From RDB$PROCEDURES Where RDB$PROCEDURE_NAME = ?',
1451	+	[aProcName])[0].AsInteger > 0;
1452	+	end;
1453	+
1454		function TFBAttachment.HasDefaultCharSet: boolean;
1455		begin
1456	+	NeedConnectionInfo;
1457		Result := FHasDefaultCharSet
1458		end;
1459
1460		function TFBAttachment.GetDefaultCharSetID: integer;
1461		begin
1462	+	NeedConnectionInfo;
1463		Result := FCharsetID;
1464		end;
1465
#	Line 748 | Line 1532 | var i: integer;
1532		begin
1533		Result := false;
1534		for i := Low(CharSetMap) to High(CharSetMap) do
1535	<	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
1535	>	if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then
1536		begin
1537		CharSetID := CharSetMap[i].CharSetID;
1538		Result := true;
#	Line 756 | Line 1540 | begin
1540		end;
1541
1542		for i := 0 to Length(FUserCharSetMap) - 1 do
1543	<	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
1543	>	if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
1544		begin
1545		CharSetID := FUserCharSetMap[i].CharSetID;
1546		Result := true;
#	Line 813 | Line 1597 | begin
1597		CharSetID := CharSets[0].AsInteger;
1598		end;
1599
1600	+	function TFBAttachment.GetTimeZoneServices: ITimeZoneServices;
1601	+	begin
1602	+	IBError(ibxeNotSupported,[]);
1603	+	end;
1604	+
1605	+	function TFBAttachment.HasTimeZoneSupport: boolean;
1606	+	begin
1607	+	Result := false;
1608	+	end;
1609	+
1610	+	{ TDPBItem }
1611	+
1612	+	function TDPBItem.getParamTypeName: AnsiString;
1613	+	begin
1614	+	Result := DPBPrefix + DPBConstantNames[getParamType];
1615	+	end;
1616	+
1617	+	{ TDPB }
1618	+
1619	+	constructor TDPB.Create(api: TFBClientAPI);
1620	+	begin
1621	+	inherited Create(api);
1622	+	FDataLength := 1;
1623	+	FBuffer^ := isc_dpb_version1;
1624	+	end;
1625	+
1626	+	function TDPB.GetParamTypeName(ParamType: byte): Ansistring;
1627	+	begin
1628	+	if ParamType <= isc_dpb_last_dpb_constant then
1629	+	Result := DPBConstantNames[ParamType]
1630	+	else
1631	+	Result := '';
1632	+	end;
1633	+
1634	+	{$IFNDEF FPC}
1635	+	function TDPB.GetDPBParamTypeName(ParamType: byte): Ansistring;
1636	+	begin
1637	+	Result := GetParamTypeName(ParamType);
1638	+	end;
1639	+	{$ENDIF}
1640	+
1641	+	function TDPB.LookupItemType(ParamTypeName: AnsiString): byte;
1642	+	var i: byte;
1643	+	begin
1644	+	Result := 0;
1645	+	ParamTypeName := LowerCase(ParamTypeName);
1646	+	if (Pos(DPBPrefix, ParamTypeName) = 1) then
1647	+	Delete(ParamTypeName, 1, Length(DPBPrefix));
1648	+
1649	+	for i := 1 to isc_dpb_last_dpb_constant do
1650	+	if (ParamTypeName = DPBConstantNames[i]) then
1651	+	begin
1652	+	Result := i;
1653	+	break;
1654	+	end;
1655	+	end;
1656	+
1657		end.
1658

Comparing:
ibx/trunk/fbintf/client/FBAttachment.pas (property svn:eol-style), Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
ibx/branches/udr/client/FBAttachment.pas (property svn:eol-style), Revision 388 by tony, Wed Jan 19 13:58:37 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines