ViewVC Help

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

root/public/ibx/branches/udr/client/3.0/FB30Statement.pas

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Statement.pas (file contents), Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

#	Line 78 | Line 78 | uses
78		FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79
80		type
81	–
81		TFB30Statement = class;
82		TIBXSQLDA = class;
83
#	Line 87 | Line 86 | type
86		TIBXSQLVAR = class(TSQLVarData)
87		private
88		FStatement: TFB30Statement;
89	+	FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob;             {Cache references}
91	–	FArray: IArray;
91		FNullIndicator: short;
92		FOwnsSQLData: boolean;
93		FBlobMetaData: IBlobMetaData;
#	Line 100 | Line 99 | type
99		FSQLData: PByte; {Address of SQL Data in Message Buffer}
100		FSQLNullIndicator: PShort; {Address of null indicator}
101		FDataLength: integer;
102	+	FMetadataSize: integer;
103		FNullable: boolean;
104		FScale: integer;
105		FCharSetID: cardinal;
#	Line 107 | Line 107 | type
107		FFieldName: AnsiString;
108
109		protected
110	+	function CanChangeSQLType: boolean;
111		function GetSQLType: cardinal; override;
112		function GetSubtype: integer; override;
113		function GetAliasName: AnsiString;  override;
#	Line 116 | Line 117 | type
117		function GetScale: integer; override;
118		function GetCharSetID: cardinal; override;
119		function GetCodePage: TSystemCodePage; override;
120	+	function GetCharSetWidth: integer; override;
121		function GetIsNull: Boolean;   override;
122		function GetIsNullable: boolean; override;
123		function GetSQLData: PByte;  override;
124		function GetDataLength: cardinal; override;
125	+	function GetSize: cardinal; override;
126	+	function GetAttachment: IAttachment; override;
127	+	function GetDefaultTextSQLType: cardinal; override;
128		procedure SetIsNull(Value: Boolean); override;
129		procedure SetIsNullable(Value: Boolean);  override;
130		procedure SetSQLData(AValue: PByte; len: cardinal); override;
#	Line 127 | Line 132 | type
132		procedure SetDataLength(len: cardinal); override;
133		procedure SetSQLType(aValue: cardinal); override;
134		procedure SetCharSetID(aValue: cardinal); override;
135	<
135	>	procedure SetMetaSize(aValue: cardinal); override;
136		public
137		constructor Create(aParent: TIBXSQLDA; aIndex: integer);
138		procedure Changed; override;
139	+	procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
140	+	procedure ColumnSQLDataInit;
141		procedure RowChange; override;
142		procedure FreeSQLData;
143	<	function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
143	>	function GetAsArray: IArray; override;
144		function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
145		function GetArrayMetaData: IArrayMetaData; override;
146		function GetBlobMetaData: IBlobMetaData; override;
#	Line 148 | 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 164 | 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 177 | Line 186 | type
186		FMsgLength: integer; {Message Buffer length}
187		FCurMetaData: Firebird.IMessageMetadata;
188		procedure FreeMessageBuffer;
189	+	procedure FreeCurMetaData;
190		function GetMessageBuffer: PByte;
191		function GetMetaData: Firebird.IMessageMetadata;
192		function GetModified: Boolean;
#	Line 190 | 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: PByte read GetMessageBuffer;
#	Line 220 | Line 231 | type
231		private
232		FResults: TIBXOUTPUTSQLDA;
233		FCursorSeqNo: integer;
234	+	procedure RowChange;
235		public
236		constructor Create(aResults: TIBXOUTPUTSQLDA);
237		destructor Destroy; override;
238		{IResultSet}
239	<	function FetchNext: boolean;
239	>	function FetchNext: boolean; {fetch next record}
240	>	function FetchPrior: boolean; {fetch previous record}
241	>	function FetchFirst:boolean; {fetch first record}
242	>	function FetchLast: boolean; {fetch last record}
243	>	function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
244	>	function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
245		function GetCursorName: AnsiString;
246		function GetTransaction: ITransaction; override;
247	+	function IsBof: boolean;
248		function IsEof: boolean;
249		procedure Close;
250		end;
251
252	+	{ TBatchCompletion }
253	+
254	+	TBatchCompletion = class(TInterfaceOwner,IBatchCompletion)
255	+	private
256	+	FCompletionState: Firebird.IBatchCompletionState;
257	+	FFirebird30ClientAPI: TFB30ClientAPI;
258	+	public
259	+	constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
260	+	destructor Destroy; override;
261	+	{IBatchCompletion}
262	+	function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
263	+	function getTotalProcessed: cardinal;
264	+	function getState(updateNo: cardinal): TBatchCompletionState;
265	+	function getStatusMessage(updateNo: cardinal): AnsiString;
266	+	function getUpdated: integer;
267	+	end;
268	+
269	+	TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
270	+
271		{ TFB30Statement }
272
273		TFB30Statement = class(TFBStatement,IStatement)
274		private
275		FStatementIntf: Firebird.IStatement;
276	+	FFirebird30ClientAPI: TFB30ClientAPI;
277		FSQLParams: TIBXINPUTSQLDA;
278		FSQLRecord: TIBXOUTPUTSQLDA;
279		FResultSet: Firebird.IResultSet;
280		FCursorSeqNo: integer;
281	+	FCursor: AnsiString;
282	+	FBatch: Firebird.IBatch;
283	+	FBatchCompletion: IBatchCompletion;
284	+	FBatchRowCount: integer;
285	+	FBatchBufferSize: integer;
286	+	FBatchBufferUsed: integer;
287		protected
288	+	procedure CheckChangeBatchRowLimit; override;
289		procedure CheckHandle; override;
290	+	procedure CheckBatchModeAvailable;
291		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
292	<	procedure InternalPrepare; override;
292	>	function GetStatementIntf: IStatement; override;
293	>	procedure InternalPrepare(CursorName: AnsiString=''); override;
294		function InternalExecute(aTransaction: ITransaction): IResults; override;
295	<	function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
295	>	function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
296	>	): IResultSet; override;
297	>	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
298		procedure FreeHandle; override;
299		procedure InternalClose(Force: boolean); override;
300	+	function SavePerfStats(var Stats: TPerfStatistics): boolean;
301		public
302		constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
303	<	sql: AnsiString; aSQLDialect: integer);
303	>	sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
304		constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
305	<	sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false);
305	>	sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
306	>	CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
307		destructor Destroy; override;
308	<	function FetchNext: boolean;
308	>	function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
309		property StatementIntf: Firebird.IStatement read FStatementIntf;
310
311		public
#	Line 263 | Line 314 | type
314		function GetMetaData: IMetaData; override;
315		function GetPlan: AnsiString;
316		function IsPrepared: boolean;
317	+	function GetFlags: TStatementFlags; override;
318		function CreateBlob(column: TColumnMetaData): IBlob; override;
319		function CreateArray(column: TColumnMetaData): IArray; override;
320		procedure SetRetainInterfaces(aValue: boolean); override;
321	<
321	>	function IsInBatchMode: boolean; override;
322	>	function HasBatchMode: boolean; override;
323	>	procedure AddToBatch; override;
324	>	function ExecuteBatch(aTransaction: ITransaction
325	>	): IBatchCompletion; override;
326	>	procedure CancelBatch; override;
327	>	function GetBatchCompletion: IBatchCompletion; override;
328		end;
329
330		implementation
#	Line 276 | Line 334 | uses IBUtils, FBMessages, FBBlob, FB30Bl
334		const
335		ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
336
337	+	{ EIBBatchCompletionError }
338	+
339	+	{ TBatchCompletion }
340	+
341	+	constructor TBatchCompletion.Create(api: TFB30ClientAPI;
342	+	cs: IBatchCompletionState);
343	+	begin
344	+	inherited Create;
345	+	FFirebird30ClientAPI := api;
346	+	FCompletionState := cs;
347	+	end;
348	+
349	+	destructor TBatchCompletion.Destroy;
350	+	begin
351	+	if FCompletionState <> nil then
352	+	begin
353	+	FCompletionState.dispose;
354	+	FCompletionState := nil;
355	+	end;
356	+	inherited Destroy;
357	+	end;
358	+
359	+	function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus
360	+	): boolean;
361	+	var i: integer;
362	+	upcount: cardinal;
363	+	state: integer;
364	+	FBStatus: Firebird.IStatus;
365	+	begin
366	+	Result := false;
367	+	RowNo := -1;
368	+	FBStatus := nil;
369	+	with FFirebird30ClientAPI do
370	+	begin
371	+	upcount := FCompletionState.getSize(StatusIntf);
372	+	Check4DataBaseError;
373	+	for i := 0 to upcount - 1 do
374	+	begin
375	+	state := FCompletionState.getState(StatusIntf,i);
376	+	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
377	+	begin
378	+	RowNo := i+1;
379	+	FBStatus := MasterIntf.getStatus;
380	+	try
381	+	FCompletionState.getStatus(StatusIntf,FBStatus,i);
382	+	Check4DataBaseError;
383	+	except
384	+	FBStatus.dispose;
385	+	raise
386	+	end;
387	+	status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
388	+	Format(SBatchCompletionError,[RowNo]));
389	+	status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
390	+	Result := true;
391	+	break;
392	+	end;
393	+	end;
394	+	end;
395	+	end;
396	+
397	+	function TBatchCompletion.getTotalProcessed: cardinal;
398	+	begin
399	+	with FFirebird30ClientAPI do
400	+	begin
401	+	Result := FCompletionState.getsize(StatusIntf);
402	+	Check4DataBaseError;
403	+	end;
404	+	end;
405	+
406	+	function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState;
407	+	var state: integer;
408	+	begin
409	+	with FFirebird30ClientAPI do
410	+	begin
411	+	state := FCompletionState.getState(StatusIntf,updateNo);
412	+	Check4DataBaseError;
413	+	case state of
414	+	Firebird.IBatchCompletionState.EXECUTE_FAILED:
415	+	Result := bcExecuteFailed;
416	+
417	+	Firebird.IBatchCompletionState.SUCCESS_NO_INFO:
418	+	Result := bcSuccessNoInfo;
419	+
420	+	else
421	+	Result := bcNoMoreErrors;
422	+	end;
423	+	end;
424	+	end;
425	+
426	+	function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString;
427	+	var status: Firebird.IStatus;
428	+	begin
429	+	with FFirebird30ClientAPI do
430	+	begin
431	+	status := MasterIntf.getStatus;
432	+	FCompletionState.getStatus(StatusIntf,status,updateNo);
433	+	Check4DataBaseError;
434	+	Result := FormatFBStatus(status);
435	+	end;
436	+	end;
437	+
438	+	function TBatchCompletion.getUpdated: integer;
439	+	var i: integer;
440	+	upcount: cardinal;
441	+	state: integer;
442	+	begin
443	+	Result := 0;
444	+	with FFirebird30ClientAPI do
445	+	begin
446	+	upcount := FCompletionState.getSize(StatusIntf);
447	+	Check4DataBaseError;
448	+	for i := 0 to upcount -1  do
449	+	begin
450	+	state := FCompletionState.getState(StatusIntf,i);
451	+	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
452	+	break;
453	+	Inc(Result);
454	+	end;
455	+	end;
456	+	end;
457	+
458		{ TIBXSQLVAR }
459
460		procedure TIBXSQLVAR.Changed;
#	Line 284 | Line 463 | begin
463		TIBXSQLDA(Parent).Changed;
464		end;
465
466	+	procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
467	+	begin
468	+	with FFirebird30ClientAPI do
469	+	begin
470	+	FSQLType := aMetaData.getType(StatusIntf,Index);
471	+	Check4DataBaseError;
472	+	if FSQLType = SQL_BLOB then
473	+	begin
474	+	FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
475	+	Check4DataBaseError;
476	+	end
477	+	else
478	+	FSQLSubType := 0;
479	+	FDataLength := aMetaData.getLength(StatusIntf,Index);
480	+	Check4DataBaseError;
481	+	FMetadataSize := FDataLength;
482	+	FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
483	+	Check4DataBaseError;
484	+	FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
485	+	Check4DataBaseError;
486	+	FNullable := aMetaData.isNullable(StatusIntf,Index);
487	+	Check4DataBaseError;
488	+	FScale := aMetaData.getScale(StatusIntf,Index);
489	+	Check4DataBaseError;
490	+	FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
491	+	Check4DataBaseError;
492	+	end;
493	+	end;
494	+
495	+	procedure TIBXSQLVAR.ColumnSQLDataInit;
496	+	begin
497	+	FreeSQLData;
498	+	with FFirebird30ClientAPI do
499	+	begin
500	+	case SQLType of
501	+	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
502	+	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
503	+	SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
504	+	SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
505	+	SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
506	+	begin
507	+	if (FDataLength = 0) then
508	+	{ Make sure you get a valid pointer anyway
509	+	select '' from foo }
510	+	IBAlloc(FSQLData, 0, 1)
511	+	else
512	+	IBAlloc(FSQLData, 0, FDataLength)
513	+	end;
514	+	SQL_VARYING:
515	+	IBAlloc(FSQLData, 0, FDataLength + 2);
516	+	else
517	+	IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)])
518	+	end;
519	+	FOwnsSQLData := true;
520	+	FNullIndicator := -1;
521	+	end;
522	+	end;
523	+
524	+	function TIBXSQLVAR.CanChangeSQLType: boolean;
525	+	begin
526	+	Result := Parent.CanChangeMetaData;
527	+	end;
528	+
529		function TIBXSQLVAR.GetSQLType: cardinal;
530		begin
531		Result := FSQLType;
#	Line 296 | Line 538 | end;
538
539		function TIBXSQLVAR.GetAliasName: AnsiString;
540		begin
541	<	with Firebird30ClientAPI do
541	>	with FFirebird30ClientAPI do
542		begin
543		result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
544		Check4DataBaseError;
#	Line 310 | Line 552 | end;
552
553		function TIBXSQLVAR.GetOwnerName: AnsiString;
554		begin
555	<	with Firebird30ClientAPI do
555	>	with FFirebird30ClientAPI do
556		begin
557		result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
558		Check4DataBaseError;
#	Line 329 | Line 571 | end;
571
572		function TIBXSQLVAR.GetCharSetID: cardinal;
573		begin
574	<	result := 0;
574	>	result := 0; {NONE}
575		case SQLType of
576		SQL_VARYING, SQL_TEXT:
577		result := FCharSetID;
578
579		SQL_BLOB:
580		if (SQLSubType = 1) then
581	<	result := FCharSetID;
581	>	result := FCharSetID
582	>	else
583	>	result := 1; {OCTETS}
584
585		SQL_ARRAY:
586		if (FRelationName <> '') and (FFieldName <> '') then
#	Line 344 | Line 588 | begin
588		else
589		result := FCharSetID;
590		end;
347	–	result := result;
591		end;
592
593		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
#	Line 354 | Line 597 | begin
597		CharSetID2CodePage(GetCharSetID,result);
598		end;
599
600	+	function TIBXSQLVAR.GetCharSetWidth: integer;
601	+	begin
602	+	result := 1;
603	+	with Statement.GetAttachment DO
604	+	CharSetWidth(GetCharSetID,result);
605	+	end;
606	+
607		function TIBXSQLVAR.GetIsNull: Boolean;
608		begin
609		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 374 | Line 624 | begin
624		Result := FDataLength;
625		end;
626
627	+	function TIBXSQLVAR.GetSize: cardinal;
628	+	begin
629	+	Result := FMetadataSize;
630	+	end;
631	+
632	+	function TIBXSQLVAR.GetAttachment: IAttachment;
633	+	begin
634	+	Result := FStatement.GetAttachment;
635	+	end;
636	+
637		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
638		begin
639		if GetSQLType <> SQL_ARRAY then
#	Line 447 | Line 707 | begin
707		if not FOwnsSQLData then
708		FSQLData := nil;
709		FDataLength := len;
710	<	with Firebird30ClientAPI do
710	>	with FFirebird30ClientAPI do
711		IBAlloc(FSQLData, 0, FDataLength);
712		FOwnsSQLData := true;
713		Changed;
#	Line 455 | Line 715 | end;
715
716		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
717		begin
718	+	if (FSQLType <> aValue) and not CanChangeSQLType then
719	+	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
720		FSQLType := aValue;
721		Changed;
722		end;
#	Line 465 | Line 727 | begin
727		Changed;
728		end;
729
730	+	procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal);
731	+	begin
732	+	if (aValue > FMetaDataSize) and not CanChangeSQLType then
733	+	IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]);
734	+	FMetaDataSize := aValue;
735	+	end;
736	+
737	+	function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
738	+	begin
739	+	Result := SQL_VARYING;
740	+	end;
741	+
742		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
743		begin
744		inherited Create(aParent,aIndex);
745		FStatement := aParent.Statement;
746	+	FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
747		end;
748
749		procedure TIBXSQLVAR.RowChange;
750		begin
751		inherited;
752		FBlob := nil;
478	–	FArray := nil;
753		end;
754
755		procedure TIBXSQLVAR.FreeSQLData;
#	Line 486 | Line 760 | begin
760		FOwnsSQLData := true;
761		end;
762
763	<	function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
763	>	function TIBXSQLVAR.GetAsArray: IArray;
764		begin
765		if SQLType <> SQL_ARRAY then
766		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 495 | Line 769 | begin
769		Result := nil
770		else
771		begin
772	<	if FArray = nil then
773	<	FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
772	>	if FArrayIntf = nil then
773	>	FArrayIntf := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
774		TIBXSQLDA(Parent).GetTransaction,
775	<	GetArrayMetaData,Array_ID);
776	<	Result := FArray;
775	>	GetArrayMetaData,PISC_QUAD(SQLData)^);
776	>	Result := FArrayIntf;
777		end;
778		end;
779
#	Line 531 | Line 805 | end;
805
806		{ TResultSet }
807
808	+	procedure TResultSet.RowChange;
809	+	var i: integer;
810	+	begin
811	+	for i := 0 to getCount - 1 do
812	+	FResults.Column[i].RowChange;
813	+	end;
814	+
815		constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
816		begin
817		inherited Create(aResults);
#	Line 545 | Line 826 | begin
826		end;
827
828		function TResultSet.FetchNext: boolean;
548	–	var i: integer;
829		begin
830		CheckActive;
831	<	Result := FResults.FStatement.FetchNext;
831	>	Result := FResults.FStatement.Fetch(ftNext);
832	>	if Result then
833	>	RowChange;
834	>	end;
835	>
836	>	function TResultSet.FetchPrior: boolean;
837	>	begin
838	>	CheckActive;
839	>	Result := FResults.FStatement.Fetch(ftPrior);
840	>	if Result then
841	>	RowChange;
842	>	end;
843	>
844	>	function TResultSet.FetchFirst: boolean;
845	>	begin
846	>	CheckActive;
847	>	Result := FResults.FStatement.Fetch(ftFirst);
848	>	if Result then
849	>	RowChange;
850	>	end;
851	>
852	>	function TResultSet.FetchLast: boolean;
853	>	begin
854	>	CheckActive;
855	>	Result := FResults.FStatement.Fetch(ftLast);
856	>	if Result then
857	>	RowChange;
858	>	end;
859	>
860	>	function TResultSet.FetchAbsolute(position: Integer): boolean;
861	>	begin
862	>	CheckActive;
863	>	Result := FResults.FStatement.Fetch(ftAbsolute,position);
864	>	if Result then
865	>	RowChange;
866	>	end;
867	>
868	>	function TResultSet.FetchRelative(offset: Integer): boolean;
869	>	begin
870	>	CheckActive;
871	>	Result := FResults.FStatement.Fetch(ftRelative,offset);
872		if Result then
873	<	for i := 0 to getCount - 1 do
554	<	FResults.Column[i].RowChange;
873	>	RowChange;
874		end;
875
876		function TResultSet.GetCursorName: AnsiString;
877		begin
878	<	IBError(ibxeNotSupported,[nil]);
560	<	Result := '';
878	>	Result := FResults.FStatement.FCursor;
879		end;
880
881		function TResultSet.GetTransaction: ITransaction;
#	Line 565 | Line 883 | begin
883		Result := FResults.FTransaction;
884		end;
885
886	+	function TResultSet.IsBof: boolean;
887	+	begin
888	+	Result := FResults.FStatement.FBof;
889	+	end;
890	+
891		function TResultSet.IsEof: boolean;
892		begin
893		Result := FResults.FStatement.FEof;
#	Line 593 | Line 916 | end;
916
917		procedure TIBXINPUTSQLDA.FreeMessageBuffer;
918		begin
596	–	if FCurMetaData <> nil then
597	–	begin
598	–	FCurMetaData.release;
599	–	FCurMetaData := nil;
600	–	end;
919		if FMessageBuffer <> nil then
920		begin
921		FreeMem(FMessageBuffer);
#	Line 606 | Line 924 | begin
924		FMsgLength := 0;
925		end;
926
927	+	procedure TIBXINPUTSQLDA.FreeCurMetaData;
928	+	begin
929	+	if FCurMetaData <> nil then
930	+	begin
931	+	FCurMetaData.release;
932	+	FCurMetaData := nil;
933	+	end;
934	+	end;
935	+
936		function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
937		begin
938		PackBuffer;
#	Line 628 | Line 955 | procedure TIBXINPUTSQLDA.BuildMetadata;
955		var Builder: Firebird.IMetadataBuilder;
956		i: integer;
957		begin
958	<	if FCurMetaData = nil then
959	<	with Firebird30ClientAPI do
958	>	if (FCurMetaData = nil) and (Count > 0) then
959	>	with FFirebird30ClientAPI do
960		begin
961	<	Builder := inherited MetaData.getBuilder(StatusIntf);
961	>	Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count);
962		Check4DataBaseError;
963		try
964		for i := 0 to Count - 1 do
965		with TIBXSQLVar(Column[i]) do
966		begin
967	<	Builder.setType(StatusIntf,i,FSQLType);
967	>	Builder.setType(StatusIntf,i,FSQLType+1);
968		Check4DataBaseError;
969		Builder.setSubType(StatusIntf,i,FSQLSubType);
970		Check4DataBaseError;
971	<	Builder.setLength(StatusIntf,i,FDataLength);
971	>	//        writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
972	>	if FSQLType = SQL_VARYING then
973	>	begin
974	>	{The datalength can be greater than the metadata size when SQLType has been overridden to text}
975	>	if (GetDataLength > GetSize) and CanChangeMetaData then
976	>	Builder.setLength(StatusIntf,i,GetDataLength)
977	>	else
978	>	Builder.setLength(StatusIntf,i,GetSize)
979	>	end
980	>	else
981	>	Builder.setLength(StatusIntf,i,GetDataLength);
982		Check4DataBaseError;
983		Builder.setCharSet(StatusIntf,i,GetCharSetID);
984		Check4DataBaseError;
#	Line 658 | Line 995 | end;
995
996		procedure TIBXINPUTSQLDA.PackBuffer;
997		var i: integer;
998	+	P: PByte;
999		begin
1000		BuildMetadata;
1001
1002	<	if FMsgLength = 0 then
1003	<	with Firebird30ClientAPI do
1002	>	if (FMsgLength = 0) and (FCurMetaData <> nil) then
1003	>	with FFirebird30ClientAPI do
1004		begin
1005		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
1006		Check4DataBaseError;
#	Line 672 | Line 1010 | begin
1010		for i := 0 to Count - 1 do
1011		with TIBXSQLVar(Column[i]) do
1012		begin
1013	+	P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
1014	+	//     writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
1015		if not Modified then
1016		IBError(ibxeUninitializedInputParameter,[i,Name]);
677	–
1017		if IsNull then
1018	<	FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1018	>	FillChar(P^,FDataLength,0)
1019		else
1020		if FSQLData <> nil then
1021	<	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1022	<	Check4DataBaseError;
1021	>	begin
1022	>	if SQLType = SQL_VARYING then
1023	>	begin
1024	>	EncodeInteger(FDataLength,2,P);
1025	>	Inc(P,2);
1026	>	end
1027	>	else
1028	>	if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
1029	>	begin
1030	>	FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
1031	>	Check4DatabaseError;
1032	>	end;
1033	>	Move(FSQLData^,P^,FDataLength);
1034	>	end;
1035		if IsNullable then
1036		begin
1037		Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
#	Line 693 | Line 1044 | end;
1044		procedure TIBXINPUTSQLDA.FreeXSQLDA;
1045		begin
1046		inherited FreeXSQLDA;
1047	+	FreeCurMetaData;
1048		FreeMessageBuffer;
1049		end;
1050
#	Line 704 | Line 1056 | end;
1056
1057		destructor TIBXINPUTSQLDA.Destroy;
1058		begin
1059	<	FreeMessageBuffer;
1059	>	FreeXSQLDA;
1060		inherited Destroy;
1061		end;
1062
#	Line 712 | Line 1064 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1064		var i: integer;
1065		begin
1066		FMetaData := aMetaData;
1067	<	with Firebird30ClientAPI do
1067	>	with FFirebird30ClientAPI do
1068		begin
1069	<	Count := metadata.getCount(StatusIntf);
1069	>	Count := aMetadata.getCount(StatusIntf);
1070		Check4DataBaseError;
1071		Initialize;
1072
1073		for i := 0 to Count - 1 do
1074		with TIBXSQLVar(Column[i]) do
1075		begin
1076	<	FSQLType := aMetaData.getType(StatusIntf,i);
1077	<	Check4DataBaseError;
726	<	if FSQLType = SQL_BLOB then
727	<	begin
728	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
729	<	Check4DataBaseError;
730	<	end
731	<	else
732	<	FSQLSubType := 0;
733	<	FDataLength := aMetaData.getLength(StatusIntf,i);
734	<	Check4DataBaseError;
735	<	case SQLType of
736	<	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
737	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
738	<	SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
739	<	begin
740	<	if (FDataLength = 0) then
741	<	{ Make sure you get a valid pointer anyway
742	<	select '' from foo }
743	<	IBAlloc(FSQLData, 0, 1)
744	<	else
745	<	IBAlloc(FSQLData, 0, FDataLength)
746	<	end;
747	<	SQL_VARYING:
748	<	IBAlloc(FSQLData, 0, FDataLength + 2);
749	<	else
750	<	IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
751	<	end;
752	<	FNullable := aMetaData.isNullable(StatusIntf,i);
753	<	FOwnsSQLData := true;
754	<	Check4DataBaseError;
755	<	FNullIndicator := -1;
1076	>	InitColumnMetaData(aMetaData);
1077	>	SaveMetaData;
1078		if FNullable then
1079		FSQLNullIndicator := @FNullIndicator
1080		else
1081		FSQLNullIndicator := nil;
1082	<	FScale := aMetaData.getScale(StatusIntf,i);
761	<	Check4DataBaseError;
762	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
763	<	Check4DataBaseError;
1082	>	ColumnSQLDataInit;
1083		end;
1084		end;
1085		end;
#	Line 768 | Line 1087 | end;
1087		procedure TIBXINPUTSQLDA.Changed;
1088		begin
1089		inherited Changed;
1090	+	FreeCurMetaData;
1091		FreeMessageBuffer;
1092		end;
1093
1094	+	procedure TIBXINPUTSQLDA.ReInitialise;
1095	+	var i: integer;
1096	+	begin
1097	+	FreeMessageBuffer;
1098	+	for i := 0 to Count - 1 do
1099	+	TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1100	+	end;
1101	+
1102		function TIBXINPUTSQLDA.IsInputDataArea: boolean;
1103		begin
1104		Result := true;
#	Line 790 | Line 1118 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData
1118		var i: integer;
1119		begin
1120		FMetaData := aMetaData;
1121	<	with Firebird30ClientAPI do
1121	>	with FFirebird30ClientAPI do
1122		begin
1123		Count := metadata.getCount(StatusIntf);
1124		Check4DataBaseError;
#	Line 803 | Line 1131 | begin
1131		for i := 0 to Count - 1 do
1132		with TIBXSQLVar(Column[i]) do
1133		begin
1134	<	FSQLType := aMetaData.getType(StatusIntf,i);
807	<	Check4DataBaseError;
808	<	if FSQLType = SQL_BLOB then
809	<	begin
810	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
811	<	Check4DataBaseError;
812	<	end
813	<	else
814	<	FSQLSubType := 0;
815	<	FBlob := nil;
816	<	FArray := nil;
1134	>	InitColumnMetaData(aMetaData);
1135		FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1136		Check4DataBaseError;
819	–	FDataLength := aMetaData.getLength(StatusIntf,i);
820	–	Check4DataBaseError;
821	–	FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
822	–	Check4DataBaseError;
823	–	FFieldName := strpas(aMetaData.getField(StatusIntf,i));
824	–	Check4DataBaseError;
825	–	FNullable := aMetaData.isNullable(StatusIntf,i);
826	–	Check4DataBaseError;
1137		if FNullable then
1138		begin
1139		FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
#	Line 831 | Line 1141 | begin
1141		end
1142		else
1143		FSQLNullIndicator := nil;
1144	<	FScale := aMetaData.getScale(StatusIntf,i);
1145	<	Check4DataBaseError;
836	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
837	<	Check4DataBaseError;
1144	>	FBlob := nil;
1145	>	FArrayIntf := nil;
1146		end;
1147		end;
1148		SetUniqueRelationName;
#	Line 850 | Line 1158 | begin
1158		len := FDataLength;
1159		if not IsNull and (FSQLType = SQL_VARYING) then
1160		begin
1161	<	with Firebird30ClientAPI do
1161	>	with FFirebird30ClientAPI do
1162		len := DecodeInteger(data,2);
1163		Inc(Data,2);
1164		end;
#	Line 867 | Line 1175 | constructor TIBXSQLDA.Create(aStatement:
1175		begin
1176		inherited Create;
1177		FStatement := aStatement;
1178	+	FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
1179		FSize := 0;
1180		//  writeln('Creating ',ClassName);
1181		end;
#	Line 927 | Line 1236 | begin
1236		ChangeSeqNo := FStatement.ChangeSeqNo;
1237		end;
1238
1239	+	function TIBXSQLDA.CanChangeMetaData: boolean;
1240	+	begin
1241	+	Result := FStatement.FBatch = nil;
1242	+	end;
1243	+
1244		procedure TIBXSQLDA.SetCount(Value: Integer);
1245		var
1246		i: Integer;
#	Line 958 | Line 1272 | begin
1272		TIBXSQLVAR(Column[i]).FreeSQLData;
1273		for i := 0 to FSize - 1  do
1274		TIBXSQLVAR(Column[i]).Free;
1275	+	FCount := 0;
1276		SetLength(FColumnList,0);
1277		FSize := 0;
1278		end;
#	Line 974 | Line 1289 | end;
1289
1290		{ TFB30Statement }
1291
1292	+	procedure TFB30Statement.CheckChangeBatchRowLimit;
1293	+	begin
1294	+	if IsInBatchMode then
1295	+	IBError(ibxeInBatchMode,[nil]);
1296	+	end;
1297	+
1298		procedure TFB30Statement.CheckHandle;
1299		begin
1300		if FStatementIntf = nil then
1301		IBError(ibxeInvalidStatementHandle,[nil]);
1302		end;
1303
1304	+	procedure TFB30Statement.CheckBatchModeAvailable;
1305	+	begin
1306	+	if not HasBatchMode then
1307	+	IBError(ibxeBatchModeNotSupported,[nil]);
1308	+	case SQLStatementType of
1309	+	SQLInsert,
1310	+	SQLUpdate: {OK};
1311	+	else
1312	+	IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1313	+	end;
1314	+	end;
1315	+
1316		procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1317		);
1318		begin
1319	<	with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1319	>	with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1320		begin
1321		StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1322		GetBufSize, BytePtr(Buffer));
#	Line 991 | Line 1324 | begin
1324		end;
1325		end;
1326
1327	<	procedure TFB30Statement.InternalPrepare;
1327	>	function TFB30Statement.GetStatementIntf: IStatement;
1328	>	begin
1329	>	Result := self;
1330	>	end;
1331	>
1332	>	procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1333	>	var GUID : TGUID;
1334		begin
1335		if FPrepared then
1336		Exit;
1337	+
1338	+	FCursor := CursorName;
1339		if (FSQL = '') then
1340		IBError(ibxeEmptyQuery, [nil]);
1341		try
1342		CheckTransaction(FTransactionIntf);
1343	<	with Firebird30ClientAPI do
1343	>	with FFirebird30ClientAPI do
1344		begin
1345	+	if FCursor = '' then
1346	+	begin
1347	+	CreateGuid(GUID);
1348	+	FCursor := GUIDToString(GUID);
1349	+	end;
1350	+
1351		if FHasParamNames then
1352		begin
1353		if FProcessedSQL = '' then
1354	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1354	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1355		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1356		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1357		Length(FProcessedSQL),
#	Line 1023 | Line 1370 | begin
1370		FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1371		Check4DataBaseError;
1372
1373	+	if FSQLStatementType = SQLSelect then
1374	+	begin
1375	+	FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1376	+	Check4DataBaseError;
1377	+	end;
1378		{ Done getting the type }
1379		case FSQLStatementType of
1380		SQLGetSegment,
#	Line 1055 | Line 1407 | begin
1407		if (FStatementIntf <> nil) then
1408		FreeHandle;
1409		if E is EIBInterBaseError then
1410	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1411	<	EIBInterBaseError(E).IBErrorCode,
1060	<	EIBInterBaseError(E).Message +
1061	<	sSQLErrorSeparator + FSQL)
1062	<	else
1063	<	raise;
1410	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1411	>	raise;
1412		end;
1413		end;
1414		FPrepared := true;
1415	+
1416		FSingleResults := false;
1417		if RetainInterfaces then
1418		begin
#	Line 1081 | Line 1430 | begin
1430		end;
1431
1432		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1433	+
1434	+	procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1435	+	begin
1436	+	with FFirebird30ClientAPI do
1437	+	begin
1438	+	SavePerfStats(FBeforeStats);
1439	+	FStatementIntf.execute(StatusIntf,
1440	+	(aTransaction as TFB30Transaction).TransactionIntf,
1441	+	FSQLParams.MetaData,
1442	+	FSQLParams.MessageBuffer,
1443	+	outMetaData,
1444	+	outBuffer);
1445	+	Check4DataBaseError;
1446	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1447	+	end;
1448	+	end;
1449	+
1450	+	var Cursor: IResultSet;
1451	+
1452		begin
1453		Result := nil;
1454	+	FBatchCompletion := nil;
1455		FBOF := false;
1456		FEOF := false;
1457		FSingleResults := false;
1458	+	FStatisticsAvailable := false;
1459	+	if IsInBatchMode then
1460	+	IBerror(ibxeInBatchMode,[]);
1461		CheckTransaction(aTransaction);
1462		if not FPrepared then
1463		InternalPrepare;
1464		CheckHandle;
1465		if aTransaction <> FTransactionIntf then
1466		AddMonitor(aTransaction as TFB30Transaction);
1467	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1467	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1468		IBError(ibxeInterfaceOutofDate,[nil]);
1469
1470	+
1471		try
1472	<	with Firebird30ClientAPI do
1472	>	with FFirebird30ClientAPI do
1473		begin
1101	–	if FCollectStatistics then
1102	–	begin
1103	–	UtilIntf.getPerfCounters(StatusIntf,
1104	–	(GetAttachment as TFB30Attachment).AttachmentIntf,
1105	–	ISQL_COUNTERS,@FBeforeStats);
1106	–	Check4DataBaseError;
1107	–	end;
1108	–
1474		case FSQLStatementType of
1475		SQLSelect:
1476	<	IBError(ibxeIsAExecuteProcedure,[]);
1476	>	{e.g. Update...returning with a single row in Firebird 5 and later}
1477	>	begin
1478	>	Cursor := InternalOpenCursor(aTransaction,false);
1479	>	if not Cursor.IsEof then
1480	>	Cursor.FetchNext;
1481	>	Result := Cursor; {note only first row}
1482	>	FSingleResults := true;
1483	>	end;
1484
1485		SQLExecProcedure:
1486		begin
1487	<	FStatementIntf.execute(StatusIntf,
1116	<	(aTransaction as TFB30Transaction).TransactionIntf,
1117	<	FSQLParams.MetaData,
1118	<	FSQLParams.MessageBuffer,
1119	<	FSQLRecord.MetaData,
1120	<	FSQLRecord.MessageBuffer);
1121	<	Check4DataBaseError;
1122	<
1487	>	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1488		Result := TResults.Create(FSQLRecord);
1489		FSingleResults := true;
1125	–	end
1126	–	else
1127	–	FStatementIntf.execute(StatusIntf,
1128	–	(aTransaction as TFB30Transaction).TransactionIntf,
1129	–	FSQLParams.MetaData,
1130	–	FSQLParams.MessageBuffer,
1131	–	nil,
1132	–	nil);
1133	–	Check4DataBaseError;
1490		end;
1491	<	if FCollectStatistics then
1492	<	begin
1493	<	UtilIntf.getPerfCounters(StatusIntf,
1138	<	(GetAttachment as TFB30Attachment).AttachmentIntf,
1139	<	ISQL_COUNTERS, @FAfterStats);
1140	<	Check4DataBaseError;
1141	<	FStatisticsAvailable := true;
1491	>
1492	>	else
1493	>	ExecuteQuery;
1494		end;
1495		end;
1496		finally
#	Line 1152 | Line 1504 | begin
1504		Inc(FChangeSeqNo);
1505		end;
1506
1507	<	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1508	<	): IResultSet;
1507	>	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1508	>	Scrollable: boolean): IResultSet;
1509	>	var flags: cardinal;
1510		begin
1511	<	if FSQLStatementType <> SQLSelect then
1511	>	flags := 0;
1512	>	if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1513		IBError(ibxeIsASelectStatement,[]);
1514
1515	<	CheckTransaction(aTransaction);
1515	>	FBatchCompletion := nil;
1516	>	CheckTransaction(aTransaction);
1517		if not FPrepared then
1518		InternalPrepare;
1519		CheckHandle;
1520		if aTransaction <> FTransactionIntf then
1521		AddMonitor(aTransaction as TFB30Transaction);
1522	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1522	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1523		IBError(ibxeInterfaceOutofDate,[nil]);
1524
1525	<	with Firebird30ClientAPI do
1525	>	if Scrollable then
1526	>	flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1527	>
1528	>	with FFirebird30ClientAPI do
1529		begin
1530		if FCollectStatistics then
1531		begin
#	Line 1182 | Line 1540 | begin
1540		FSQLParams.MetaData,
1541		FSQLParams.MessageBuffer,
1542		FSQLRecord.MetaData,
1543	<	0);
1543	>	flags);
1544		Check4DataBaseError;
1545
1546		if FCollectStatistics then
#	Line 1207 | Line 1565 | begin
1565		Inc(FChangeSeqNo);
1566		end;
1567
1568	+	procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1569	+	var processedSQL: AnsiString);
1570	+	begin
1571	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1572	+	end;
1573	+
1574		procedure TFB30Statement.FreeHandle;
1575		begin
1576		Close;
1577		ReleaseInterfaces;
1578	+	if FBatch <> nil then
1579	+	begin
1580	+	FBatch.release;
1581	+	FBatch := nil;
1582	+	end;
1583		if FStatementIntf <> nil then
1584		begin
1585		FStatementIntf.release;
1586		FStatementIntf := nil;
1587		FPrepared := false;
1588		end;
1589	+	FCursor := '';
1590		end;
1591
1592		procedure TFB30Statement.InternalClose(Force: boolean);
1593		begin
1594		if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1595		try
1596	<	with Firebird30ClientAPI do
1596	>	with FFirebird30ClientAPI do
1597		begin
1598		if FResultSet <> nil then
1599		begin
#	Line 1247 | Line 1617 | begin
1617		Inc(FChangeSeqNo);
1618		end;
1619
1620	+	function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1621	+	begin
1622	+	Result := false;
1623	+	if FCollectStatistics then
1624	+	with FFirebird30ClientAPI do
1625	+	begin
1626	+	UtilIntf.getPerfCounters(StatusIntf,
1627	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1628	+	ISQL_COUNTERS, @Stats);
1629	+	Check4DataBaseError;
1630	+	Result := true;
1631	+	end;
1632	+	end;
1633	+
1634		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1635	<	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1635	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1636	>	CursorName: AnsiString);
1637		begin
1638		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1639	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1640		FSQLParams := TIBXINPUTSQLDA.Create(self);
1641		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1642	<	InternalPrepare;
1642	>	InternalPrepare(CursorName);
1643		end;
1644
1645		constructor TFB30Statement.CreateWithParameterNames(
1646		Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1647	<	aSQLDialect: integer; GenerateParamNames: boolean);
1647	>	aSQLDialect: integer; GenerateParamNames: boolean;
1648	>	CaseSensitiveParams: boolean; CursorName: AnsiString);
1649		begin
1650		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1651	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1652		FSQLParams := TIBXINPUTSQLDA.Create(self);
1653	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1654		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1655	<	InternalPrepare;
1655	>	InternalPrepare(CursorName);
1656		end;
1657
1658		destructor TFB30Statement.Destroy;
#	Line 1273 | Line 1662 | begin
1662		if assigned(FSQLRecord) then FSQLRecord.Free;
1663		end;
1664
1665	<	function TFB30Statement.FetchNext: boolean;
1665	>	function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1666	>	): boolean;
1667		var fetchResult: integer;
1668		begin
1669		result := false;
1670		if not FOpen then
1671		IBError(ibxeSQLClosed, [nil]);
1282	–	if FEOF then
1283	–	IBError(ibxeEOF,[nil]);
1672
1673	<	with Firebird30ClientAPI do
1673	>	with FFirebird30ClientAPI do
1674		begin
1675	<	{ Go to the next record... }
1676	<	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1677	<	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1678	<	begin
1679	<	FBOF := false;
1680	<	FEOF := true;
1681	<	Exit; {End of File}
1682	<	end
1683	<	else
1684	<	if fetchResult <> Firebird.IStatus.RESULT_OK then
1685	<	begin
1686	<	try
1687	<	IBDataBaseError;
1300	<	except
1301	<	Close;
1302	<	raise;
1675	>	case FetchType of
1676	>	ftNext:
1677	>	begin
1678	>	if FEOF then
1679	>	IBError(ibxeEOF,[nil]);
1680	>	{ Go to the next record... }
1681	>	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1682	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1683	>	begin
1684	>	FBOF := false;
1685	>	FEOF := true;
1686	>	Exit; {End of File}
1687	>	end
1688		end;
1689	<	end
1690	<	else
1691	<	begin
1692	<	FBOF := false;
1693	<	result := true;
1689	>
1690	>	ftPrior:
1691	>	begin
1692	>	if FBOF then
1693	>	IBError(ibxeBOF,[nil]);
1694	>	{ Go to the next record... }
1695	>	fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1696	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1697	>	begin
1698	>	FBOF := true;
1699	>	FEOF := false;
1700	>	Exit; {Top of File}
1701	>	end
1702	>	end;
1703	>
1704	>	ftFirst:
1705	>	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1706	>
1707	>	ftLast:
1708	>	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1709	>
1710	>	ftAbsolute:
1711	>	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1712	>
1713	>	ftRelative:
1714	>	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1715		end;
1716	+
1717	+	Check4DataBaseError;
1718	+	if fetchResult <> Firebird.IStatus.RESULT_OK then
1719	+	exit; {result = false}
1720	+
1721	+	{Result OK}
1722	+	FBOF := false;
1723	+	FEOF := false;
1724	+	result := true;
1725	+
1726		if FCollectStatistics then
1727		begin
1728		UtilIntf.getPerfCounters(StatusIntf,
#	Line 1346 | Line 1762 | begin
1762		SQLUpdate, SQLDelete])) then
1763		result := ''
1764		else
1765	<	with Firebird30ClientAPI do
1765	>	with FFirebird30ClientAPI do
1766		begin
1767		Result := FStatementIntf.getPlan(StatusIntf,true);
1768		Check4DataBaseError;
#	Line 1380 | Line 1796 | begin
1796		TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1797		end;
1798
1799	+	function TFB30Statement.IsInBatchMode: boolean;
1800	+	begin
1801	+	Result := FBatch <> nil;
1802	+	end;
1803	+
1804	+	function TFB30Statement.HasBatchMode: boolean;
1805	+	begin
1806	+	Result := GetAttachment.HasBatchMode;
1807	+	end;
1808	+
1809	+	procedure TFB30Statement.AddToBatch;
1810	+	var BatchPB: TXPBParameterBlock;
1811	+
1812	+	const SixteenMB = 16 * 1024 * 1024;
1813	+	begin
1814	+	FBatchCompletion := nil;
1815	+	if not FPrepared then
1816	+	InternalPrepare;
1817	+	CheckHandle;
1818	+	CheckBatchModeAvailable;
1819	+	with FFirebird30ClientAPI do
1820	+	begin
1821	+	if FBatch = nil then
1822	+	begin
1823	+	{Start Batch}
1824	+	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1825	+	with FFirebird30ClientAPI do
1826	+	try
1827	+	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1828	+	Check4DatabaseError;
1829	+	if FBatchBufferSize < SixteenMB then
1830	+	FBatchBufferSize := SixteenMB;
1831	+	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1832	+	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1833	+
1834	+	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1835	+	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1836	+	FBatch := FStatementIntf.createBatch(StatusIntf,
1837	+	FSQLParams.MetaData,
1838	+	BatchPB.getDataLength,
1839	+	BatchPB.getBuffer);
1840	+	Check4DataBaseError;
1841	+
1842	+	finally
1843	+	BatchPB.Free;
1844	+	end;
1845	+	FBatchRowCount := 0;
1846	+	FBatchBufferUsed := 0;
1847	+	end;
1848	+
1849	+	Inc(FBatchRowCount);
1850	+	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1851	+	Check4DataBaseError;
1852	+	if FBatchBufferUsed > FBatchBufferSize then
1853	+	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1854	+	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1855	+	[FBatchRowCount,FBatchBufferSize]));
1856	+
1857	+	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1858	+	Check4DataBaseError
1859	+	end;
1860	+	end;
1861	+
1862	+	function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1863	+	): IBatchCompletion;
1864	+
1865	+	procedure Check4BatchCompletionError(bc: IBatchCompletion);
1866	+	var status: IStatus;
1867	+	RowNo: integer;
1868	+	begin
1869	+	status := nil;
1870	+	{Raise an exception if there was an error reported in the BatchCompletion}
1871	+	if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1872	+	raise EIBInterbaseError.Create(status);
1873	+	end;
1874	+
1875	+	var cs: Firebird.IBatchCompletionState;
1876	+
1877	+	begin
1878	+	Result := nil;
1879	+	if FBatch = nil then
1880	+	IBError(ibxeNotInBatchMode,[]);
1881	+
1882	+	with FFirebird30ClientAPI do
1883	+	begin
1884	+	SavePerfStats(FBeforeStats);
1885	+	if aTransaction = nil then
1886	+	cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1887	+	else
1888	+	cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1889	+	Check4DataBaseError;
1890	+	FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1891	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1892	+	FBatch.release;
1893	+	FBatch := nil;
1894	+	Check4BatchCompletionError(FBatchCompletion);
1895	+	Result := FBatchCompletion;
1896	+	end;
1897	+	end;
1898	+
1899	+	procedure TFB30Statement.CancelBatch;
1900	+	begin
1901	+	if FBatch = nil then
1902	+	IBError(ibxeNotInBatchMode,[]);
1903	+	FBatch.release;
1904	+	FBatch := nil;
1905	+	end;
1906	+
1907	+	function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1908	+	begin
1909	+	Result := FBatchCompletion;
1910	+	end;
1911	+
1912		function TFB30Statement.IsPrepared: boolean;
1913		begin
1914		Result := FStatementIntf <> nil;
1915		end;
1916
1917	+	function TFB30Statement.GetFlags: TStatementFlags;
1918	+	var flags: cardinal;
1919	+	begin
1920	+	CheckHandle;
1921	+	Result := [];
1922	+	with FFirebird30ClientAPI do
1923	+	begin
1924	+	flags := FStatementIntf.getFlags(StatusIntf);
1925	+	Check4DataBaseError;
1926	+	end;
1927	+	if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
1928	+	Result := Result + [stHasCursor];
1929	+	if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
1930	+	Result := Result + [stRepeatExecute];
1931	+	if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
1932	+	Result := Result + [stScrollable];
1933	+	end;
1934	+
1935		end.
1936

Diff Legend

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