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 309 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
ibx/branches/journaling/fbintf/client/3.0/FB30Statement.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC

#	Line 78 | Line 78 | uses
78		FB30Attachment,IBExternals, FBSQLData, FBOutputBlock, FBActivityMonitor;
79
80		type
81	–
81		TFB30Statement = class;
82		TIBXSQLDA = class;
83
#	Line 89 | Line 88 | type
88		FStatement: TFB30Statement;
89		FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob;             {Cache references}
92	–	FArray: IArray;
91		FNullIndicator: short;
92		FOwnsSQLData: boolean;
93		FBlobMetaData: IBlobMetaData;
#	Line 101 | 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 108 | 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 122 | Line 122 | type
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 129 | 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 167 | 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 180 | 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 193 | 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 223 | 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)
#	Line 244 | Line 278 | type
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;
306	<	CaseSensitiveParams: 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 269 | 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 282 | 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 290 | 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 335 | 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 350 | Line 588 | begin
588		else
589		result := FCharSetID;
590		end;
353	–	result := result;
591		end;
592
593		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
#	Line 387 | 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 468 | 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 478 | 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);
#	Line 489 | Line 750 | procedure TIBXSQLVAR.RowChange;
750		begin
751		inherited;
752		FBlob := nil;
492	–	FArray := nil;
753		end;
754
755		procedure TIBXSQLVAR.FreeSQLData;
#	Line 500 | 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 509 | 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 545 | 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 559 | Line 826 | begin
826		end;
827
828		function TResultSet.FetchNext: boolean;
562	–	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	<	for i := 0 to getCount - 1 do
850	<	FResults.Column[i].RowChange;
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	>	RowChange;
874		end;
875
876		function TResultSet.GetCursorName: AnsiString;
877		begin
878	<	IBError(ibxeNotSupported,[nil]);
574	<	Result := '';
878	>	Result := FResults.FStatement.FCursor;
879		end;
880
881		function TResultSet.GetTransaction: ITransaction;
#	Line 579 | 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 607 | Line 916 | end;
916
917		procedure TIBXINPUTSQLDA.FreeMessageBuffer;
918		begin
610	–	if FCurMetaData <> nil then
611	–	begin
612	–	FCurMetaData.release;
613	–	FCurMetaData := nil;
614	–	end;
919		if FMessageBuffer <> nil then
920		begin
921		FreeMem(FMessageBuffer);
#	Line 620 | 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 642 | Line 955 | procedure TIBXINPUTSQLDA.BuildMetadata;
955		var Builder: Firebird.IMetadataBuilder;
956		i: integer;
957		begin
958	<	if FCurMetaData = nil then
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 672 | 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
1002	>	if (FMsgLength = 0) and (FCurMetaData <> nil) then
1003		with FFirebird30ClientAPI do
1004		begin
1005		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
#	Line 686 | 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]);
691	–
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 707 | Line 1044 | end;
1044		procedure TIBXINPUTSQLDA.FreeXSQLDA;
1045		begin
1046		inherited FreeXSQLDA;
1047	+	FreeCurMetaData;
1048		FreeMessageBuffer;
1049		end;
1050
#	Line 718 | Line 1056 | end;
1056
1057		destructor TIBXINPUTSQLDA.Destroy;
1058		begin
1059	<	FreeMessageBuffer;
1059	>	FreeXSQLDA;
1060		inherited Destroy;
1061		end;
1062
#	Line 728 | Line 1066 | begin
1066		FMetaData := aMetaData;
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;
740	<	if FSQLType = SQL_BLOB then
741	<	begin
742	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
743	<	Check4DataBaseError;
744	<	end
745	<	else
746	<	FSQLSubType := 0;
747	<	FDataLength := aMetaData.getLength(StatusIntf,i);
748	<	Check4DataBaseError;
749	<	case SQLType of
750	<	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
751	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
752	<	SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
753	<	begin
754	<	if (FDataLength = 0) then
755	<	{ Make sure you get a valid pointer anyway
756	<	select '' from foo }
757	<	IBAlloc(FSQLData, 0, 1)
758	<	else
759	<	IBAlloc(FSQLData, 0, FDataLength)
760	<	end;
761	<	SQL_VARYING:
762	<	IBAlloc(FSQLData, 0, FDataLength + 2);
763	<	else
764	<	IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
765	<	end;
766	<	FNullable := aMetaData.isNullable(StatusIntf,i);
767	<	FOwnsSQLData := true;
768	<	Check4DataBaseError;
769	<	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);
775	<	Check4DataBaseError;
776	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
777	<	Check4DataBaseError;
1082	>	ColumnSQLDataInit;
1083		end;
1084		end;
1085		end;
#	Line 782 | 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 817 | 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);
821	<	Check4DataBaseError;
822	<	if FSQLType = SQL_BLOB then
823	<	begin
824	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
825	<	Check4DataBaseError;
826	<	end
827	<	else
828	<	FSQLSubType := 0;
829	<	FBlob := nil;
830	<	FArray := nil;
1134	>	InitColumnMetaData(aMetaData);
1135		FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1136		Check4DataBaseError;
833	–	FDataLength := aMetaData.getLength(StatusIntf,i);
834	–	Check4DataBaseError;
835	–	FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
836	–	Check4DataBaseError;
837	–	FFieldName := strpas(aMetaData.getField(StatusIntf,i));
838	–	Check4DataBaseError;
839	–	FNullable := aMetaData.isNullable(StatusIntf,i);
840	–	Check4DataBaseError;
1137		if FNullable then
1138		begin
1139		FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
#	Line 845 | Line 1141 | begin
1141		end
1142		else
1143		FSQLNullIndicator := nil;
1144	<	FScale := aMetaData.getScale(StatusIntf,i);
1145	<	Check4DataBaseError;
850	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
851	<	Check4DataBaseError;
1144	>	FBlob := nil;
1145	>	FArrayIntf := nil;
1146		end;
1147		end;
1148		SetUniqueRelationName;
#	Line 942 | 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 973 | 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 989 | 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
#	Line 1006 | 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 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
#	Line 1038 | 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 1070 | 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,
1075	<	EIBInterBaseError(E).Message +
1076	<	sSQLErrorSeparator + FSQL)
1077	<	else
1078	<	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 1096 | 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 FFirebird30ClientAPI do
1473		begin
1116	–	if FCollectStatistics then
1117	–	begin
1118	–	UtilIntf.getPerfCounters(StatusIntf,
1119	–	(GetAttachment as TFB30Attachment).AttachmentIntf,
1120	–	ISQL_COUNTERS,@FBeforeStats);
1121	–	Check4DataBaseError;
1122	–	end;
1123	–
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,
1131	<	(aTransaction as TFB30Transaction).TransactionIntf,
1132	<	FSQLParams.MetaData,
1133	<	FSQLParams.MessageBuffer,
1134	<	FSQLRecord.MetaData,
1135	<	FSQLRecord.MessageBuffer);
1136	<	Check4DataBaseError;
1137	<
1487	>	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1488		Result := TResults.Create(FSQLRecord);
1489		FSingleResults := true;
1140	–	end
1141	–	else
1142	–	FStatementIntf.execute(StatusIntf,
1143	–	(aTransaction as TFB30Transaction).TransactionIntf,
1144	–	FSQLParams.MetaData,
1145	–	FSQLParams.MessageBuffer,
1146	–	nil,
1147	–	nil);
1148	–	Check4DataBaseError;
1490		end;
1491	<	if FCollectStatistics then
1492	<	begin
1493	<	UtilIntf.getPerfCounters(StatusIntf,
1153	<	(GetAttachment as TFB30Attachment).AttachmentIntf,
1154	<	ISQL_COUNTERS, @FAfterStats);
1155	<	Check4DataBaseError;
1156	<	FStatisticsAvailable := true;
1491	>
1492	>	else
1493	>	ExecuteQuery;
1494		end;
1495		end;
1496		finally
#	Line 1167 | 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	+	if Scrollable then
1526	+	flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1527	+
1528		with FFirebird30ClientAPI do
1529		begin
1530		if FCollectStatistics then
#	Line 1197 | Line 1540 | begin
1540		FSQLParams.MetaData,
1541		FSQLParams.MessageBuffer,
1542		FSQLRecord.MetaData,
1543	<	0);
1543	>	flags);
1544		Check4DataBaseError;
1545
1546		if FCollectStatistics then
#	Line 1232 | Line 1575 | 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);
#	Line 1268 | 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;
1648	<	CaseSensitiveParams: 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 1298 | 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]);
1307	–	if FEOF then
1308	–	IBError(ibxeEOF,[nil]);
1672
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;
1325	<	except
1326	<	Close;
1327	<	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 1405 | 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