[ViewVC] Diff of: public/ibx/branches/udr/client/3.0/FB30Statement.pas

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC

#	Line 25 \| Line 25
25		*
26		*)
27		unit FB30Statement;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$codepage UTF8}
35		{$interfaces COM}
36		{$ENDIF}
#	Line 75 \| Line 78 \| uses
78		FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79
80		type
78	–
81		TFB30Statement = class;
82		TIBXSQLDA = class;
83
#	Line 84 \| Line 86 \| type
86		TIBXSQLVAR = class(TSQLVarData)
87		private
88		FStatement: TFB30Statement;
89	+	FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob; {Cache references}
91		FArray: IArray;
92		FNullIndicator: short;
#	Line 94 \| Line 97 \| type
97		{SQL Var Type Data}
98		FSQLType: cardinal;
99		FSQLSubType: integer;
100	<	FSQLData: PChar; {Address of SQL Data in Message Buffer}
100	>	FSQLData: PByte; {Address of SQL Data in Message Buffer}
101		FSQLNullIndicator: PShort; {Address of null indicator}
102		FDataLength: integer;
103	+	FMetadataSize: integer;
104		FNullable: boolean;
105		FScale: integer;
106		FCharSetID: cardinal;
107	<	FRelationName: string;
108	<	FFieldName: string;
107	>	FRelationName: AnsiString;
108	>	FFieldName: AnsiString;
109
110		protected
111	+	function CanChangeSQLType: boolean;
112		function GetSQLType: cardinal; override;
113		function GetSubtype: integer; override;
114	<	function GetAliasName: string; override;
115	<	function GetFieldName: string; override;
116	<	function GetOwnerName: string; override;
117	<	function GetRelationName: string; override;
114	>	function GetAliasName: AnsiString; override;
115	>	function GetFieldName: AnsiString; override;
116	>	function GetOwnerName: AnsiString; override;
117	>	function GetRelationName: AnsiString; override;
118		function GetScale: integer; override;
119		function GetCharSetID: cardinal; override;
120		function GetCodePage: TSystemCodePage; override;
121	+	function GetCharSetWidth: integer; override;
122		function GetIsNull: Boolean; override;
123		function GetIsNullable: boolean; override;
124	<	function GetSQLData: PChar; override;
124	>	function GetSQLData: PByte; override;
125		function GetDataLength: cardinal; override;
126	+	function GetSize: cardinal; override;
127	+	function GetAttachment: IAttachment; override;
128	+	function GetDefaultTextSQLType: cardinal; override;
129		procedure SetIsNull(Value: Boolean); override;
130		procedure SetIsNullable(Value: Boolean); override;
131	<	procedure SetSQLData(AValue: PChar; len: cardinal); override;
131	>	procedure SetSQLData(AValue: PByte; len: cardinal); override;
132		procedure SetScale(aValue: integer); override;
133		procedure SetDataLength(len: cardinal); override;
134		procedure SetSQLType(aValue: cardinal); override;
135		procedure SetCharSetID(aValue: cardinal); override;
136	<
136	>	procedure SetMetaSize(aValue: cardinal); override;
137		public
138		constructor Create(aParent: TIBXSQLDA; aIndex: integer);
139		procedure Changed; override;
140	+	procedure ColumnSQLDataInit;
141		procedure RowChange; override;
142		procedure FreeSQLData;
143		function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
#	Line 145 \| Line 155 \| type
155		FSize: Integer; {Number of TIBXSQLVARs in column list}
156		FMetaData: Firebird.IMessageMetadata;
157		FTransactionSeqNo: integer;
158	<	protected
158	>	protected
159		FStatement: TFB30Statement;
160	+	FFirebird30ClientAPI: TFB30ClientAPI;
161		function GetTransactionSeqNo: integer; override;
162		procedure FreeXSQLDA; virtual;
163		function GetStatement: IStatement; override;
#	Line 161 \| Line 172 \| type
172		function GetTransaction: TFB30Transaction; virtual;
173		procedure Initialize; override;
174		function StateChanged(var ChangeSeqNo: integer): boolean; override;
175	+	function CanChangeMetaData: boolean; override;
176		property MetaData: Firebird.IMessageMetadata read FMetaData;
177		property Count: Integer read FCount write SetCount;
178		property Statement: TFB30Statement read FStatement;
#	Line 170 \| Line 182 \| type
182
183		TIBXINPUTSQLDA = class(TIBXSQLDA)
184		private
185	<	FMessageBuffer: PChar; {Message Buffer}
185	>	FMessageBuffer: PByte; {Message Buffer}
186		FMsgLength: integer; {Message Buffer length}
187		FCurMetaData: Firebird.IMessageMetadata;
188		procedure FreeMessageBuffer;
189	<	function GetMessageBuffer: PChar;
189	>	procedure FreeCurMetaData;
190	>	function GetMessageBuffer: PByte;
191		function GetMetaData: Firebird.IMessageMetadata;
192		function GetModified: Boolean;
193		function GetMsgLength: integer;
194	+	procedure BuildMetadata;
195		procedure PackBuffer;
196		protected
197		procedure FreeXSQLDA; override;
#	Line 186 \| Line 200 \| type
200		destructor Destroy; override;
201		procedure Bind(aMetaData: Firebird.IMessageMetadata);
202		procedure Changed; override;
203	+	procedure ReInitialise;
204		function IsInputDataArea: boolean; override;
205		property MetaData: Firebird.IMessageMetadata read GetMetaData;
206	<	property MessageBuffer: PChar read GetMessageBuffer;
206	>	property MessageBuffer: PByte read GetMessageBuffer;
207		property MsgLength: integer read GetMsgLength;
208		end;
209
#	Line 197 \| Line 212 \| type
212		TIBXOUTPUTSQLDA = class(TIBXSQLDA)
213		private
214		FTransaction: TFB30Transaction; {transaction used to execute the statement}
215	<	FMessageBuffer: PChar; {Message Buffer}
215	>	FMessageBuffer: PByte; {Message Buffer}
216		FMsgLength: integer; {Message Buffer length}
217		protected
218		procedure FreeXSQLDA; override;
219		public
220		procedure Bind(aMetaData: Firebird.IMessageMetadata);
221		procedure GetData(index: integer; var aIsNull: boolean; var len: short;
222	<	var data: PChar); override;
222	>	var data: PByte); override;
223		function IsInputDataArea: boolean; override;
224	<	property MessageBuffer: PChar read FMessageBuffer;
224	>	property MessageBuffer: PByte read FMessageBuffer;
225		property MsgLength: integer read FMsgLength;
226		end;
227
#	Line 221 \| Line 236 \| type
236		destructor Destroy; override;
237		{IResultSet}
238		function FetchNext: boolean;
239	<	function GetCursorName: string;
239	>	function GetCursorName: AnsiString;
240		function GetTransaction: ITransaction; override;
241		function IsEof: boolean;
242		procedure Close;
243		end;
244
245	+	{ TBatchCompletion }
246	+
247	+	TBatchCompletion = class(TInterfaceOwner,IBatchCompletion)
248	+	private
249	+	FCompletionState: Firebird.IBatchCompletionState;
250	+	FFirebird30ClientAPI: TFB30ClientAPI;
251	+	public
252	+	constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
253	+	destructor Destroy; override;
254	+	{IBatchCompletion}
255	+	function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
256	+	function getTotalProcessed: cardinal;
257	+	function getState(updateNo: cardinal): TBatchCompletionState;
258	+	function getStatusMessage(updateNo: cardinal): AnsiString;
259	+	function getUpdated: integer;
260	+	end;
261	+
262		{ TFB30Statement }
263
264		TFB30Statement = class(TFBStatement,IStatement)
265		private
266		FStatementIntf: Firebird.IStatement;
267	+	FFirebird30ClientAPI: TFB30ClientAPI;
268		FSQLParams: TIBXINPUTSQLDA;
269		FSQLRecord: TIBXOUTPUTSQLDA;
270		FResultSet: Firebird.IResultSet;
271		FCursorSeqNo: integer;
272	+	FBatch: Firebird.IBatch;
273	+	FBatchCompletion: IBatchCompletion;
274	+	FBatchRowCount: integer;
275	+	FBatchBufferSize: integer;
276	+	FBatchBufferUsed: integer;
277		protected
278	+	procedure CheckChangeBatchRowLimit; override;
279		procedure CheckHandle; override;
280	+	procedure CheckBatchModeAvailable;
281		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
282		procedure InternalPrepare; override;
283		function InternalExecute(aTransaction: ITransaction): IResults; override;
284		function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
285	+	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
286		procedure FreeHandle; override;
287		procedure InternalClose(Force: boolean); override;
288	+	function SavePerfStats(var Stats: TPerfStatistics): boolean;
289		public
290		constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
291	<	sql: string; aSQLDialect: integer);
291	>	sql: AnsiString; aSQLDialect: integer);
292		constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
293	<	sql: string; aSQLDialect: integer; GenerateParamNames: boolean =false);
293	>	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean =false;
294	>	CaseSensitiveParams: boolean=false);
295		destructor Destroy; override;
296		function FetchNext: boolean;
297		property StatementIntf: Firebird.IStatement read FStatementIntf;
#	Line 257 \| Line 300 \| type
300		{IStatement}
301		function GetSQLParams: ISQLParams; override;
302		function GetMetaData: IMetaData; override;
303	<	function GetPlan: String;
303	>	function GetPlan: AnsiString;
304		function IsPrepared: boolean;
305		function CreateBlob(column: TColumnMetaData): IBlob; override;
306		function CreateArray(column: TColumnMetaData): IArray; override;
307		procedure SetRetainInterfaces(aValue: boolean); override;
308	<
308	>	function IsInBatchMode: boolean; override;
309	>	function HasBatchMode: boolean; override;
310	>	procedure AddToBatch; override;
311	>	function ExecuteBatch(aTransaction: ITransaction
312	>	): IBatchCompletion; override;
313	>	procedure CancelBatch; override;
314	>	function GetBatchCompletion: IBatchCompletion; override;
315		end;
316
317		implementation
318
319	<	uses IBUtils, FBMessages, FB30Blob, variants, FBArray, FB30Array;
319	>	uses IBUtils, FBMessages, FBBlob, FB30Blob, variants, FBArray, FB30Array;
320	>
321	>	const
322	>	ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
323	>
324	>	{ EIBBatchCompletionError }
325	>
326	>	{ TBatchCompletion }
327	>
328	>	constructor TBatchCompletion.Create(api: TFB30ClientAPI;
329	>	cs: IBatchCompletionState);
330	>	begin
331	>	inherited Create;
332	>	FFirebird30ClientAPI := api;
333	>	FCompletionState := cs;
334	>	end;
335	>
336	>	destructor TBatchCompletion.Destroy;
337	>	begin
338	>	if FCompletionState <> nil then
339	>	begin
340	>	FCompletionState.dispose;
341	>	FCompletionState := nil;
342	>	end;
343	>	inherited Destroy;
344	>	end;
345	>
346	>	function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus
347	>	): boolean;
348	>	var i: integer;
349	>	upcount: cardinal;
350	>	state: integer;
351	>	FBStatus: Firebird.IStatus;
352	>	begin
353	>	Result := false;
354	>	RowNo := -1;
355	>	FBStatus := nil;
356	>	with FFirebird30ClientAPI do
357	>	begin
358	>	upcount := FCompletionState.getSize(StatusIntf);
359	>	Check4DataBaseError;
360	>	for i := 0 to upcount - 1 do
361	>	begin
362	>	state := FCompletionState.getState(StatusIntf,i);
363	>	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
364	>	begin
365	>	RowNo := i+1;
366	>	FBStatus := MasterIntf.getStatus;
367	>	try
368	>	FCompletionState.getStatus(StatusIntf,FBStatus,i);
369	>	Check4DataBaseError;
370	>	except
371	>	FBStatus.dispose;
372	>	raise
373	>	end;
374	>	status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
375	>	Format(SBatchCompletionError,[RowNo]));
376	>	status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
377	>	Result := true;
378	>	break;
379	>	end;
380	>	end;
381	>	end;
382	>	end;
383	>
384	>	function TBatchCompletion.getTotalProcessed: cardinal;
385	>	begin
386	>	with FFirebird30ClientAPI do
387	>	begin
388	>	Result := FCompletionState.getsize(StatusIntf);
389	>	Check4DataBaseError;
390	>	end;
391	>	end;
392	>
393	>	function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState;
394	>	var state: integer;
395	>	begin
396	>	with FFirebird30ClientAPI do
397	>	begin
398	>	state := FCompletionState.getState(StatusIntf,updateNo);
399	>	Check4DataBaseError;
400	>	case state of
401	>	Firebird.IBatchCompletionState.EXECUTE_FAILED:
402	>	Result := bcExecuteFailed;
403	>
404	>	Firebird.IBatchCompletionState.SUCCESS_NO_INFO:
405	>	Result := bcSuccessNoInfo;
406	>
407	>	else
408	>	Result := bcNoMoreErrors;
409	>	end;
410	>	end;
411	>	end;
412	>
413	>	function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString;
414	>	var status: Firebird.IStatus;
415	>	begin
416	>	with FFirebird30ClientAPI do
417	>	begin
418	>	status := MasterIntf.getStatus;
419	>	FCompletionState.getStatus(StatusIntf,status,updateNo);
420	>	Check4DataBaseError;
421	>	Result := FormatFBStatus(status);
422	>	end;
423	>	end;
424	>
425	>	function TBatchCompletion.getUpdated: integer;
426	>	var i: integer;
427	>	upcount: cardinal;
428	>	state: integer;
429	>	begin
430	>	Result := 0;
431	>	with FFirebird30ClientAPI do
432	>	begin
433	>	upcount := FCompletionState.getSize(StatusIntf);
434	>	Check4DataBaseError;
435	>	for i := 0 to upcount -1 do
436	>	begin
437	>	state := FCompletionState.getState(StatusIntf,i);
438	>	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
439	>	break;
440	>	Inc(Result);
441	>	end;
442	>	end;
443	>	end;
444
445		{ TIBXSQLVAR }
446
#	Line 277 \| Line 450 \| begin
450		TIBXSQLDA(Parent).Changed;
451		end;
452
453	+	procedure TIBXSQLVAR.ColumnSQLDataInit;
454	+	begin
455	+	FreeSQLData;
456	+	with FFirebird30ClientAPI do
457	+	begin
458	+	case SQLType of
459	+	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
460	+	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
461	+	SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
462	+	SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
463	+	SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
464	+	begin
465	+	if (FDataLength = 0) then
466	+	{ Make sure you get a valid pointer anyway
467	+	select '' from foo }
468	+	IBAlloc(FSQLData, 0, 1)
469	+	else
470	+	IBAlloc(FSQLData, 0, FDataLength)
471	+	end;
472	+	SQL_VARYING:
473	+	IBAlloc(FSQLData, 0, FDataLength + 2);
474	+	else
475	+	IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)])
476	+	end;
477	+	FOwnsSQLData := true;
478	+	FNullIndicator := -1;
479	+	end;
480	+	end;
481	+
482	+	function TIBXSQLVAR.CanChangeSQLType: boolean;
483	+	begin
484	+	Result := Parent.CanChangeMetaData;
485	+	end;
486	+
487		function TIBXSQLVAR.GetSQLType: cardinal;
488		begin
489		Result := FSQLType;
#	Line 287 \| Line 494 \| begin
494		Result := FSQLSubType;
495		end;
496
497	<	function TIBXSQLVAR.GetAliasName: string;
497	>	function TIBXSQLVAR.GetAliasName: AnsiString;
498		begin
499	<	with Firebird30ClientAPI do
499	>	with FFirebird30ClientAPI do
500		begin
501		result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
502		Check4DataBaseError;
503		end;
504		end;
505
506	<	function TIBXSQLVAR.GetFieldName: string;
506	>	function TIBXSQLVAR.GetFieldName: AnsiString;
507		begin
508		Result := FFieldName;
509		end;
510
511	<	function TIBXSQLVAR.GetOwnerName: string;
511	>	function TIBXSQLVAR.GetOwnerName: AnsiString;
512		begin
513	<	with Firebird30ClientAPI do
513	>	with FFirebird30ClientAPI do
514		begin
515		result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
516		Check4DataBaseError;
517		end;
518		end;
519
520	<	function TIBXSQLVAR.GetRelationName: string;
520	>	function TIBXSQLVAR.GetRelationName: AnsiString;
521		begin
522		Result := FRelationName;
523		end;
#	Line 322 \| Line 529 \| end;
529
530		function TIBXSQLVAR.GetCharSetID: cardinal;
531		begin
532	<	result := 0;
532	>	result := 0; {NONE}
533		case SQLType of
534		SQL_VARYING, SQL_TEXT:
535		result := FCharSetID;
536
537		SQL_BLOB:
538		if (SQLSubType = 1) then
539	<	result := FCharSetID;
539	>	result := FCharSetID
540	>	else
541	>	result := 1; {OCTETS}
542
543		SQL_ARRAY:
544		if (FRelationName <> '') and (FFieldName <> '') then
#	Line 342 \| Line 551 \| end;
551		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
552		begin
553		result := CP_NONE;
554	<	with Firebird30ClientAPI do
554	>	with Statement.GetAttachment do
555		CharSetID2CodePage(GetCharSetID,result);
556		end;
557
558	+	function TIBXSQLVAR.GetCharSetWidth: integer;
559	+	begin
560	+	result := 1;
561	+	with Statement.GetAttachment DO
562	+	CharSetWidth(GetCharSetID,result);
563	+	end;
564	+
565		function TIBXSQLVAR.GetIsNull: Boolean;
566		begin
567		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 356 \| Line 572 \| begin
572		Result := FSQLNullIndicator <> nil;
573		end;
574
575	<	function TIBXSQLVAR.GetSQLData: PChar;
575	>	function TIBXSQLVAR.GetSQLData: PByte;
576		begin
577		Result := FSQLData;
578		end;
#	Line 366 \| Line 582 \| begin
582		Result := FDataLength;
583		end;
584
585	+	function TIBXSQLVAR.GetSize: cardinal;
586	+	begin
587	+	Result := FMetadataSize;
588	+	end;
589	+
590	+	function TIBXSQLVAR.GetAttachment: IAttachment;
591	+	begin
592	+	Result := FStatement.GetAttachment;
593	+	end;
594	+
595		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
596		begin
597		if GetSQLType <> SQL_ARRAY then
#	Line 388 \| Line 614 \| begin
614		FStatement.GetTransaction as TFB30Transaction,
615		GetRelationName,GetFieldName,
616		GetSubType);
617	+	(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
618		Result := FBlobMetaData;
619		end;
620
#	Line 401 \| Line 628 \| begin
628		else
629		if IsNullable then
630		FNullIndicator := 0;
631	+	Changed;
632		end;
633
634		procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
#	Line 413 \| Line 641 \| begin
641		end
642		else
643		FSQLNullIndicator := nil;
644	+	Changed;
645		end;
646
647	<	procedure TIBXSQLVAR.SetSQLData(AValue: PChar; len: cardinal);
647	>	procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
648		begin
649		if FOwnsSQLData then
650		FreeMem(FSQLData);
651		FSQLData := AValue;
652		FDataLength := len;
653		FOwnsSQLData := false;
654	+	Changed;
655		end;
656
657		procedure TIBXSQLVAR.SetScale(aValue: integer);
658		begin
659		FScale := aValue;
660	+	Changed;
661		end;
662
663		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 434 \| Line 665 \| begin
665		if not FOwnsSQLData then
666		FSQLData := nil;
667		FDataLength := len;
668	<	with Firebird30ClientAPI do
668	>	with FFirebird30ClientAPI do
669		IBAlloc(FSQLData, 0, FDataLength);
670		FOwnsSQLData := true;
671	+	Changed;
672		end;
673
674		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
675		begin
676	+	if (FSQLType <> aValue) and not CanChangeSQLType then
677	+	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
678		FSQLType := aValue;
679	+	Changed;
680		end;
681
682		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
683		begin
684		FCharSetID := aValue;
685	+	Changed;
686	+	end;
687	+
688	+	procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal);
689	+	begin
690	+	if (aValue > FMetaDataSize) and not CanChangeSQLType then
691	+	IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]);
692	+	FMetaDataSize := aValue;
693	+	end;
694	+
695	+	function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
696	+	begin
697	+	Result := SQL_VARYING;
698		end;
699
700		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
701		begin
702		inherited Create(aParent,aIndex);
703		FStatement := aParent.Statement;
704	+	FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
705		end;
706
707		procedure TIBXSQLVAR.RowChange;
#	Line 538 \| Line 787 \| begin
787		FResults.Column[i].RowChange;
788		end;
789
790	<	function TResultSet.GetCursorName: string;
790	>	function TResultSet.GetCursorName: AnsiString;
791		begin
792		IBError(ibxeNotSupported,[nil]);
793		Result := '';
#	Line 577 \| Line 826 \| end;
826
827		procedure TIBXINPUTSQLDA.FreeMessageBuffer;
828		begin
580	–	if FCurMetaData <> nil then
581	–	begin
582	–	FCurMetaData.release;
583	–	FCurMetaData := nil;
584	–	end;
829		if FMessageBuffer <> nil then
830		begin
831		FreeMem(FMessageBuffer);
#	Line 590 \| Line 834 \| begin
834		FMsgLength := 0;
835		end;
836
837	<	function TIBXINPUTSQLDA.GetMessageBuffer: PChar;
837	>	procedure TIBXINPUTSQLDA.FreeCurMetaData;
838	>	begin
839	>	if FCurMetaData <> nil then
840	>	begin
841	>	FCurMetaData.release;
842	>	FCurMetaData := nil;
843	>	end;
844	>	end;
845	>
846	>	function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
847		begin
848		PackBuffer;
849		Result := FMessageBuffer;
#	Line 598 \| Line 851 \| end;
851
852		function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
853		begin
854	<	PackBuffer;
854	>	BuildMetadata;
855		Result := FCurMetaData;
856		end;
857
#	Line 608 \| Line 861 \| begin
861		Result := FMsgLength;
862		end;
863
864	<	procedure TIBXINPUTSQLDA.PackBuffer;
864	>	procedure TIBXINPUTSQLDA.BuildMetadata;
865		var Builder: Firebird.IMetadataBuilder;
866		i: integer;
867		begin
868	<	if FMsgLength > 0 then Exit;
869	<
617	<	with Firebird30ClientAPI do
868	>	if (FCurMetaData = nil) and (Count > 0) then
869	>	with FFirebird30ClientAPI do
870		begin
871	<	Builder := inherited MetaData.getBuilder(StatusIntf);
871	>	Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count);
872		Check4DataBaseError;
873		try
874		for i := 0 to Count - 1 do
875		with TIBXSQLVar(Column[i]) do
876		begin
877	<	Builder.setType(StatusIntf,i,FSQLType);
877	>	Builder.setType(StatusIntf,i,FSQLType+1);
878		Check4DataBaseError;
879		Builder.setSubType(StatusIntf,i,FSQLSubType);
880		Check4DataBaseError;
881	<	Builder.setLength(StatusIntf,i,FDataLength);
881	>	// writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
882	>	if FSQLType = SQL_VARYING then
883	>	begin
884	>	{The datalength can be greater than the metadata size when SQLType has been overridden to text}
885	>	if (GetDataLength > GetSize) and CanChangeMetaData then
886	>	Builder.setLength(StatusIntf,i,GetDataLength)
887	>	else
888	>	Builder.setLength(StatusIntf,i,GetSize)
889	>	end
890	>	else
891	>	Builder.setLength(StatusIntf,i,GetDataLength);
892		Check4DataBaseError;
893		Builder.setCharSet(StatusIntf,i,GetCharSetID);
894		Check4DataBaseError;
#	Line 638 \| Line 900 \| begin
900		finally
901		Builder.release;
902		end;
903	+	end;
904	+	end;
905
906	+	procedure TIBXINPUTSQLDA.PackBuffer;
907	+	var i: integer;
908	+	P: PByte;
909	+	begin
910	+	BuildMetadata;
911	+
912	+	if (FMsgLength = 0) and (FCurMetaData <> nil) then
913	+	with FFirebird30ClientAPI do
914	+	begin
915		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
916		Check4DataBaseError;
917
#	Line 647 \| Line 920 \| begin
920		for i := 0 to Count - 1 do
921		with TIBXSQLVar(Column[i]) do
922		begin
923	<	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
924	<	Check4DataBaseError;
923	>	P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
924	>	// writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
925	>	if not Modified then
926	>	IBError(ibxeUninitializedInputParameter,[i,Name]);
927	>	if IsNull then
928	>	FillChar(P^,FDataLength,0)
929	>	else
930	>	if FSQLData <> nil then
931	>	begin
932	>	if SQLType = SQL_VARYING then
933	>	begin
934	>	EncodeInteger(FDataLength,2,P);
935	>	Inc(P,2);
936	>	end
937	>	else
938	>	if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
939	>	begin
940	>	FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
941	>	Check4DatabaseError;
942	>	end;
943	>	Move(FSQLData^,P^,FDataLength);
944	>	end;
945		if IsNullable then
946		begin
947		Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
#	Line 661 \| Line 954 \| end;
954		procedure TIBXINPUTSQLDA.FreeXSQLDA;
955		begin
956		inherited FreeXSQLDA;
957	+	FreeCurMetaData;
958		FreeMessageBuffer;
959		end;
960
#	Line 672 \| Line 966 \| end;
966
967		destructor TIBXINPUTSQLDA.Destroy;
968		begin
969	<	FreeMessageBuffer;
969	>	FreeXSQLDA;
970		inherited Destroy;
971		end;
972
#	Line 680 \| Line 974 \| procedure TIBXINPUTSQLDA.Bind(aMetaData:
974		var i: integer;
975		begin
976		FMetaData := aMetaData;
977	<	with Firebird30ClientAPI do
977	>	with FFirebird30ClientAPI do
978		begin
979	<	Count := metadata.getCount(StatusIntf);
979	>	Count := aMetadata.getCount(StatusIntf);
980		Check4DataBaseError;
981		Initialize;
982
#	Line 700 \| Line 994 \| begin
994		FSQLSubType := 0;
995		FDataLength := aMetaData.getLength(StatusIntf,i);
996		Check4DataBaseError;
997	<	case SQLType of
704	<	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
705	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
706	<	SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
707	<	begin
708	<	if (FDataLength = 0) then
709	<	{ Make sure you get a valid pointer anyway
710	<	select '' from foo }
711	<	IBAlloc(FSQLData, 0, 1)
712	<	else
713	<	IBAlloc(FSQLData, 0, FDataLength)
714	<	end;
715	<	SQL_VARYING: begin
716	<	IBAlloc(FSQLData, 0, FDataLength + 2);
717	<	end;
718	<	else
719	<	IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
720	<	end;
997	>	FMetadataSize := FDataLength;
998		FNullable := aMetaData.isNullable(StatusIntf,i);
722	–	FOwnsSQLData := true;
999		Check4DataBaseError;
724	–	FNullIndicator := -1;
1000		if FNullable then
1001		FSQLNullIndicator := @FNullIndicator
1002		else
1003		FSQLNullIndicator := nil;
1004		FScale := aMetaData.getScale(StatusIntf,i);
1005		Check4DataBaseError;
1006	<	FCharSetID := aMetaData.getCharSet(StatusIntf,i);
1006	>	FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF;
1007		Check4DataBaseError;
1008	+	ColumnSQLDataInit;
1009		end;
1010		end;
1011		end;
#	Line 737 \| Line 1013 \| end;
1013		procedure TIBXINPUTSQLDA.Changed;
1014		begin
1015		inherited Changed;
1016	+	FreeCurMetaData;
1017	+	FreeMessageBuffer;
1018	+	end;
1019	+
1020	+	procedure TIBXINPUTSQLDA.ReInitialise;
1021	+	var i: integer;
1022	+	begin
1023		FreeMessageBuffer;
1024	+	for i := 0 to Count - 1 do
1025	+	TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1026		end;
1027
1028		function TIBXINPUTSQLDA.IsInputDataArea: boolean;
#	Line 759 \| Line 1044 \| procedure TIBXOUTPUTSQLDA.Bind(aMetaData
1044		var i: integer;
1045		begin
1046		FMetaData := aMetaData;
1047	<	with Firebird30ClientAPI do
1047	>	with FFirebird30ClientAPI do
1048		begin
1049		Count := metadata.getCount(StatusIntf);
1050		Check4DataBaseError;
#	Line 787 \| Line 1072 \| begin
1072		Check4DataBaseError;
1073		FDataLength := aMetaData.getLength(StatusIntf,i);
1074		Check4DataBaseError;
1075	+	FMetadataSize := FDataLength;
1076		FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
1077		Check4DataBaseError;
1078		FFieldName := strpas(aMetaData.getField(StatusIntf,i));
#	Line 802 \| Line 1088 \| begin
1088		FSQLNullIndicator := nil;
1089		FScale := aMetaData.getScale(StatusIntf,i);
1090		Check4DataBaseError;
1091	<	FCharSetID := aMetaData.getCharSet(StatusIntf,i);
1091	>	FCharSetID := aMetaData.getCharSet(StatusIntf,i) and $FF;
1092		Check4DataBaseError;
1093		end;
1094		end;
#	Line 810 \| Line 1096 \| begin
1096		end;
1097
1098		procedure TIBXOUTPUTSQLDA.GetData(index: integer; var aIsNull: boolean;
1099	<	var len: short; var data: PChar);
1099	>	var len: short; var data: PByte);
1100		begin
1101		with TIBXSQLVAR(Column[index]) do
1102		begin
#	Line 819 \| Line 1105 \| begin
1105		len := FDataLength;
1106		if not IsNull and (FSQLType = SQL_VARYING) then
1107		begin
1108	<	with Firebird30ClientAPI do
1108	>	with FFirebird30ClientAPI do
1109		len := DecodeInteger(data,2);
1110		Inc(Data,2);
1111		end;
#	Line 836 \| Line 1122 \| constructor TIBXSQLDA.Create(aStatement:
1122		begin
1123		inherited Create;
1124		FStatement := aStatement;
1125	+	FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
1126		FSize := 0;
1127		// writeln('Creating ',ClassName);
1128		end;
#	Line 896 \| Line 1183 \| begin
1183		ChangeSeqNo := FStatement.ChangeSeqNo;
1184		end;
1185
1186	+	function TIBXSQLDA.CanChangeMetaData: boolean;
1187	+	begin
1188	+	Result := FStatement.FBatch = nil;
1189	+	end;
1190	+
1191		procedure TIBXSQLDA.SetCount(Value: Integer);
1192		var
1193		i: Integer;
#	Line 927 \| Line 1219 \| begin
1219		TIBXSQLVAR(Column[i]).FreeSQLData;
1220		for i := 0 to FSize - 1 do
1221		TIBXSQLVAR(Column[i]).Free;
1222	+	FCount := 0;
1223		SetLength(FColumnList,0);
1224		FSize := 0;
1225		end;
#	Line 943 \| Line 1236 \| end;
1236
1237		{ TFB30Statement }
1238
1239	+	procedure TFB30Statement.CheckChangeBatchRowLimit;
1240	+	begin
1241	+	if IsInBatchMode then
1242	+	IBError(ibxeInBatchMode,[nil]);
1243	+	end;
1244	+
1245		procedure TFB30Statement.CheckHandle;
1246		begin
1247		if FStatementIntf = nil then
1248		IBError(ibxeInvalidStatementHandle,[nil]);
1249		end;
1250
1251	+	procedure TFB30Statement.CheckBatchModeAvailable;
1252	+	begin
1253	+	if not HasBatchMode then
1254	+	IBError(ibxeBatchModeNotSupported,[nil]);
1255	+	case SQLStatementType of
1256	+	SQLInsert,
1257	+	SQLUpdate: {OK};
1258	+	else
1259	+	IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1260	+	end;
1261	+	end;
1262	+
1263		procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1264		);
1265		begin
1266	<	with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1266	>	with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1267		begin
1268		StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1269		GetBufSize, BytePtr(Buffer));
#	Line 968 \| Line 1279 \| begin
1279		IBError(ibxeEmptyQuery, [nil]);
1280		try
1281		CheckTransaction(FTransactionIntf);
1282	<	with Firebird30ClientAPI do
1282	>	with FFirebird30ClientAPI do
1283		begin
1284		if FHasParamNames then
1285		begin
1286		if FProcessedSQL = '' then
1287	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1287	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1288		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1289		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1290		Length(FProcessedSQL),
1291	<	PChar(FProcessedSQL),
1291	>	PAnsiChar(FProcessedSQL),
1292		FSQLDialect,
1293		Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1294		end
#	Line 985 \| Line 1296 \| begin
1296		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1297		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1298		Length(FSQL),
1299	<	PChar(FSQL),
1299	>	PAnsiChar(FSQL),
1300		FSQLDialect,
1301		Firebird.IStatement.PREPARE_PREFETCH_METADATA);
1302		Check4DataBaseError;
#	Line 1024 \| Line 1335 \| begin
1335		if (FStatementIntf <> nil) then
1336		FreeHandle;
1337		if E is EIBInterBaseError then
1338	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1339	<	EIBInterBaseError(E).IBErrorCode,
1029	<	EIBInterBaseError(E).Message +
1030	<	sSQLErrorSeparator + FSQL)
1031	<	else
1032	<	raise;
1338	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1339	>	raise;
1340		end;
1341		end;
1342		FPrepared := true;
#	Line 1050 \| Line 1357 \| begin
1357		end;
1358
1359		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1360	+
1361	+	procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1362	+	begin
1363	+	with FFirebird30ClientAPI do
1364	+	begin
1365	+	SavePerfStats(FBeforeStats);
1366	+	FStatementIntf.execute(StatusIntf,
1367	+	(aTransaction as TFB30Transaction).TransactionIntf,
1368	+	FSQLParams.MetaData,
1369	+	FSQLParams.MessageBuffer,
1370	+	outMetaData,
1371	+	outBuffer);
1372	+	Check4DataBaseError;
1373	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1374	+	end;
1375	+	end;
1376	+
1377	+
1378		begin
1379		Result := nil;
1380	+	FBatchCompletion := nil;
1381		FBOF := false;
1382		FEOF := false;
1383		FSingleResults := false;
1384	+	FStatisticsAvailable := false;
1385	+	if IsInBatchMode then
1386	+	IBerror(ibxeInBatchMode,[]);
1387		CheckTransaction(aTransaction);
1388		if not FPrepared then
1389		InternalPrepare;
1390		CheckHandle;
1391		if aTransaction <> FTransactionIntf then
1392		AddMonitor(aTransaction as TFB30Transaction);
1393	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1393	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1394		IBError(ibxeInterfaceOutofDate,[nil]);
1395
1067	–	try
1068	–	with Firebird30ClientAPI do
1069	–	case FSQLStatementType of
1070	–	SQLSelect:
1071	–	IBError(ibxeIsAExecuteProcedure,[]);
1396
1397	<	SQLExecProcedure:
1397	>	try
1398	>	with FFirebird30ClientAPI do
1399		begin
1400	<	FStatementIntf.execute(StatusIntf,
1401	<	(aTransaction as TFB30Transaction).TransactionIntf,
1402	<	FSQLParams.MetaData,
1078	<	FSQLParams.MessageBuffer,
1079	<	FSQLRecord.MetaData,
1080	<	FSQLRecord.MessageBuffer);
1081	<	Check4DataBaseError;
1400	>	case FSQLStatementType of
1401	>	SQLSelect:
1402	>	IBError(ibxeIsAExecuteProcedure,[]);
1403
1404	<	Result := TResults.Create(FSQLRecord);
1405	<	FSingleResults := true;
1406	<	end
1407	<	else
1408	<	FStatementIntf.execute(StatusIntf,
1409	<	(aTransaction as TFB30Transaction).TransactionIntf,
1410	<	FSQLParams.MetaData,
1411	<	FSQLParams.MessageBuffer,
1412	<	nil,
1413	<	nil);
1093	<	Check4DataBaseError;
1404	>	SQLExecProcedure:
1405	>	begin
1406	>	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1407	>	Result := TResults.Create(FSQLRecord);
1408	>	FSingleResults := true;
1409	>	end;
1410	>
1411	>	else
1412	>	ExecuteQuery;
1413	>	end;
1414		end;
1415		finally
1416		if aTransaction <> FTransactionIntf then
1417		RemoveMonitor(aTransaction as TFB30Transaction);
1418		end;
1419		FExecTransactionIntf := aTransaction;
1420	+	FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1421	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1422		SignalActivity;
1423		Inc(FChangeSeqNo);
1424		end;
#	Line 1107 \| Line 1429 \| begin
1429		if FSQLStatementType <> SQLSelect then
1430		IBError(ibxeIsASelectStatement,[]);
1431
1432	<	CheckTransaction(aTransaction);
1432	>	FBatchCompletion := nil;
1433	>	CheckTransaction(aTransaction);
1434		if not FPrepared then
1435		InternalPrepare;
1436		CheckHandle;
1437		if aTransaction <> FTransactionIntf then
1438		AddMonitor(aTransaction as TFB30Transaction);
1439	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1439	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1440		IBError(ibxeInterfaceOutofDate,[nil]);
1441
1442	<	with Firebird30ClientAPI do
1442	>	with FFirebird30ClientAPI do
1443		begin
1444	+	if FCollectStatistics then
1445	+	begin
1446	+	UtilIntf.getPerfCounters(StatusIntf,
1447	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1448	+	ISQL_COUNTERS, @FBeforeStats);
1449	+	Check4DataBaseError;
1450	+	end;
1451	+
1452		FResultSet := FStatementIntf.openCursor(StatusIntf,
1453		(aTransaction as TFB30Transaction).TransactionIntf,
1454		FSQLParams.MetaData,
#	Line 1125 \| Line 1456 \| begin
1456		FSQLRecord.MetaData,
1457		0);
1458		Check4DataBaseError;
1459	+
1460	+	if FCollectStatistics then
1461	+	begin
1462	+	UtilIntf.getPerfCounters(StatusIntf,
1463	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1464	+	ISQL_COUNTERS,@FAfterStats);
1465	+	Check4DataBaseError;
1466	+	FStatisticsAvailable := true;
1467	+	end;
1468		end;
1469		Inc(FCursorSeqNo);
1470		FSingleResults := false;
#	Line 1139 \| Line 1479 \| begin
1479		Inc(FChangeSeqNo);
1480		end;
1481
1482	+	procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1483	+	var processedSQL: AnsiString);
1484	+	begin
1485	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1486	+	end;
1487	+
1488		procedure TFB30Statement.FreeHandle;
1489		begin
1490		Close;
1491		ReleaseInterfaces;
1492	+	if FBatch <> nil then
1493	+	begin
1494	+	FBatch.release;
1495	+	FBatch := nil;
1496	+	end;
1497		if FStatementIntf <> nil then
1498		begin
1499		FStatementIntf.release;
#	Line 1155 \| Line 1506 \| procedure TFB30Statement.InternalClose(F
1506		begin
1507		if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1508		try
1509	<	with Firebird30ClientAPI do
1509	>	with FFirebird30ClientAPI do
1510		begin
1511		if FResultSet <> nil then
1512		begin
#	Line 1169 \| Line 1520 \| begin
1520		if not Force then Check4DataBaseError;
1521		end;
1522		finally
1523	<	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> FTransactionIntf) then
1523	>	if (FSQLRecord.FTransaction <> nil) and (FSQLRecord.FTransaction <> (FTransactionIntf as TFB30Transaction)) then
1524		RemoveMonitor(FSQLRecord.FTransaction);
1525		FOpen := False;
1526		FExecTransactionIntf := nil;
#	Line 1179 \| Line 1530 \| begin
1530		Inc(FChangeSeqNo);
1531		end;
1532
1533	+	function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1534	+	begin
1535	+	Result := false;
1536	+	if FCollectStatistics then
1537	+	with FFirebird30ClientAPI do
1538	+	begin
1539	+	UtilIntf.getPerfCounters(StatusIntf,
1540	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1541	+	ISQL_COUNTERS, @Stats);
1542	+	Check4DataBaseError;
1543	+	Result := true;
1544	+	end;
1545	+	end;
1546	+
1547		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1548	<	Transaction: ITransaction; sql: string; aSQLDialect: integer);
1548	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1549		begin
1550		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1551	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1552		FSQLParams := TIBXINPUTSQLDA.Create(self);
1553		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1554		InternalPrepare;
1555		end;
1556
1557		constructor TFB30Statement.CreateWithParameterNames(
1558	<	Attachment: TFB30Attachment; Transaction: ITransaction; sql: string;
1559	<	aSQLDialect: integer; GenerateParamNames: boolean);
1558	>	Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1559	>	aSQLDialect: integer; GenerateParamNames: boolean;
1560	>	CaseSensitiveParams: boolean);
1561		begin
1562		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1563	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1564		FSQLParams := TIBXINPUTSQLDA.Create(self);
1565	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1566		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1567		InternalPrepare;
1568		end;
#	Line 1214 \| Line 1583 \| begin
1583		if FEOF then
1584		IBError(ibxeEOF,[nil]);
1585
1586	<	with Firebird30ClientAPI do
1586	>	with FFirebird30ClientAPI do
1587		begin
1588		{ Go to the next record... }
1589		fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
#	Line 1239 \| Line 1608 \| begin
1608		FBOF := false;
1609		result := true;
1610		end;
1611	+	if FCollectStatistics then
1612	+	begin
1613	+	UtilIntf.getPerfCounters(StatusIntf,
1614	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1615	+	ISQL_COUNTERS,@FAfterStats);
1616	+	Check4DataBaseError;
1617	+	FStatisticsAvailable := true;
1618	+	end;
1619		end;
1620		FSQLRecord.RowChange;
1621		SignalActivity;
#	Line 1262 \| Line 1639 \| begin
1639		Result := TMetaData(GetInterface(1));
1640		end;
1641
1642	<	function TFB30Statement.GetPlan: String;
1642	>	function TFB30Statement.GetPlan: AnsiString;
1643		begin
1644		CheckHandle;
1645		if (not (FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
#	Line 1270 \| Line 1647 \| begin
1647		SQLUpdate, SQLDelete])) then
1648		result := ''
1649		else
1650	<	with Firebird30ClientAPI do
1650	>	with FFirebird30ClientAPI do
1651		begin
1652		Result := FStatementIntf.getPlan(StatusIntf,true);
1653		Check4DataBaseError;
#	Line 1304 \| Line 1681 \| begin
1681		TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1682		end;
1683
1684	+	function TFB30Statement.IsInBatchMode: boolean;
1685	+	begin
1686	+	Result := FBatch <> nil;
1687	+	end;
1688	+
1689	+	function TFB30Statement.HasBatchMode: boolean;
1690	+	begin
1691	+	Result := GetAttachment.HasBatchMode;
1692	+	end;
1693	+
1694	+	procedure TFB30Statement.AddToBatch;
1695	+	var BatchPB: TXPBParameterBlock;
1696	+
1697	+	const SixteenMB = 16 * 1024 * 1024;
1698	+	begin
1699	+	FBatchCompletion := nil;
1700	+	if not FPrepared then
1701	+	InternalPrepare;
1702	+	CheckHandle;
1703	+	CheckBatchModeAvailable;
1704	+	with FFirebird30ClientAPI do
1705	+	begin
1706	+	if FBatch = nil then
1707	+	begin
1708	+	{Start Batch}
1709	+	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1710	+	with FFirebird30ClientAPI do
1711	+	try
1712	+	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1713	+	Check4DatabaseError;
1714	+	if FBatchBufferSize < SixteenMB then
1715	+	FBatchBufferSize := SixteenMB;
1716	+	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1717	+	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1718	+
1719	+	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1720	+	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1721	+	FBatch := FStatementIntf.createBatch(StatusIntf,
1722	+	FSQLParams.MetaData,
1723	+	BatchPB.getDataLength,
1724	+	BatchPB.getBuffer);
1725	+	Check4DataBaseError;
1726	+
1727	+	finally
1728	+	BatchPB.Free;
1729	+	end;
1730	+	FBatchRowCount := 0;
1731	+	FBatchBufferUsed := 0;
1732	+	end;
1733	+
1734	+	Inc(FBatchRowCount);
1735	+	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1736	+	Check4DataBaseError;
1737	+	if FBatchBufferUsed > FBatchBufferSize then
1738	+	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1739	+	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1740	+	[FBatchRowCount,FBatchBufferSize]));
1741	+
1742	+	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1743	+	Check4DataBaseError
1744	+	end;
1745	+	end;
1746	+
1747	+	function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1748	+	): IBatchCompletion;
1749	+
1750	+	procedure Check4BatchCompletionError(bc: IBatchCompletion);
1751	+	var status: IStatus;
1752	+	RowNo: integer;
1753	+	begin
1754	+	status := nil;
1755	+	{Raise an exception if there was an error reported in the BatchCompletion}
1756	+	if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1757	+	raise EIBInterbaseError.Create(status);
1758	+	end;
1759	+
1760	+	var cs: Firebird.IBatchCompletionState;
1761	+
1762	+	begin
1763	+	Result := nil;
1764	+	if FBatch = nil then
1765	+	IBError(ibxeNotInBatchMode,[]);
1766	+
1767	+	with FFirebird30ClientAPI do
1768	+	begin
1769	+	SavePerfStats(FBeforeStats);
1770	+	if aTransaction = nil then
1771	+	cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1772	+	else
1773	+	cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1774	+	Check4DataBaseError;
1775	+	FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1776	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1777	+	FBatch.release;
1778	+	FBatch := nil;
1779	+	Check4BatchCompletionError(FBatchCompletion);
1780	+	Result := FBatchCompletion;
1781	+	end;
1782	+	end;
1783	+
1784	+	procedure TFB30Statement.CancelBatch;
1785	+	begin
1786	+	if FBatch = nil then
1787	+	IBError(ibxeNotInBatchMode,[]);
1788	+	FBatch.release;
1789	+	FBatch := nil;
1790	+	end;
1791	+
1792	+	function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1793	+	begin
1794	+	Result := FBatchCompletion;
1795	+	end;
1796	+
1797		function TFB30Statement.IsPrepared: boolean;
1798		begin
1799		Result := FStatementIntf <> nil;

Diff Legend

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

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents): Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs. Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC

Diff Legend

Comparing ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC