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 111 by tony, Thu Jan 18 14:37:53 2018 UTC vs.
Revision 359 by tony, Tue Dec 7 09:37:32 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 87 | Line 86 | type
86		TIBXSQLVAR = class(TSQLVarData)
87		private
88		FStatement: TFB30Statement;
89	+	FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob;             {Cache references}
91		FArray: IArray;
92		FNullIndicator: short;
#	Line 100 | Line 100 | type
100		FSQLData: PByte; {Address of SQL Data in Message Buffer}
101		FSQLNullIndicator: PShort; {Address of null indicator}
102		FDataLength: integer;
103	+	FMetadataSize: integer;
104		FNullable: boolean;
105		FScale: integer;
106		FCharSetID: cardinal;
#	Line 107 | Line 108 | type
108		FFieldName: AnsiString;
109
110		protected
111	+	function CanChangeSQLType: boolean;
112		function GetSQLType: cardinal; override;
113		function GetSubtype: integer; override;
114		function GetAliasName: AnsiString;  override;
#	Line 116 | Line 118 | type
118		function GetScale: integer; override;
119		function GetCharSetID: cardinal; override;
120		function GetCodePage: TSystemCodePage; override;
121	+	function GetCharSetWidth: integer; override;
122		function GetIsNull: Boolean;   override;
123		function GetIsNullable: boolean; override;
124		function GetSQLData: PByte;  override;
125		function GetDataLength: cardinal; override;
126	+	function GetSize: cardinal; override;
127	+	function GetAttachment: IAttachment; override;
128	+	function GetDefaultTextSQLType: cardinal; override;
129		procedure SetIsNull(Value: Boolean); override;
130		procedure SetIsNullable(Value: Boolean);  override;
131		procedure SetSQLData(AValue: PByte; len: cardinal); override;
#	Line 127 | Line 133 | type
133		procedure SetDataLength(len: cardinal); override;
134		procedure SetSQLType(aValue: cardinal); override;
135		procedure SetCharSetID(aValue: cardinal); override;
136	<
136	>	procedure SetMetaSize(aValue: cardinal); override;
137		public
138		constructor Create(aParent: TIBXSQLDA; aIndex: integer);
139		procedure Changed; override;
140	+	procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
141	+	procedure ColumnSQLDataInit;
142		procedure RowChange; override;
143		procedure FreeSQLData;
144		function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
#	Line 148 | Line 156 | type
156		FSize: Integer;  {Number of TIBXSQLVARs in column list}
157		FMetaData: Firebird.IMessageMetadata;
158		FTransactionSeqNo: integer;
159	<	protected
159	>	protected
160		FStatement: TFB30Statement;
161	+	FFirebird30ClientAPI: TFB30ClientAPI;
162		function GetTransactionSeqNo: integer; override;
163		procedure FreeXSQLDA; virtual;
164		function GetStatement: IStatement; override;
#	Line 164 | Line 173 | type
173		function GetTransaction: TFB30Transaction; virtual;
174		procedure Initialize; override;
175		function StateChanged(var ChangeSeqNo: integer): boolean; override;
176	+	function CanChangeMetaData: boolean; override;
177		property MetaData: Firebird.IMessageMetadata read FMetaData;
178		property Count: Integer read FCount write SetCount;
179		property Statement: TFB30Statement read FStatement;
#	Line 177 | Line 187 | type
187		FMsgLength: integer; {Message Buffer length}
188		FCurMetaData: Firebird.IMessageMetadata;
189		procedure FreeMessageBuffer;
190	+	procedure FreeCurMetaData;
191		function GetMessageBuffer: PByte;
192		function GetMetaData: Firebird.IMessageMetadata;
193		function GetModified: Boolean;
#	Line 190 | Line 201 | type
201		destructor Destroy; override;
202		procedure Bind(aMetaData: Firebird.IMessageMetadata);
203		procedure Changed; override;
204	+	procedure ReInitialise;
205		function IsInputDataArea: boolean; override;
206		property MetaData: Firebird.IMessageMetadata read GetMetaData;
207		property MessageBuffer: PByte read GetMessageBuffer;
#	Line 220 | Line 232 | type
232		private
233		FResults: TIBXOUTPUTSQLDA;
234		FCursorSeqNo: integer;
235	+	procedure RowChange;
236		public
237		constructor Create(aResults: TIBXOUTPUTSQLDA);
238		destructor Destroy; override;
239		{IResultSet}
240	<	function FetchNext: boolean;
240	>	function FetchNext: boolean; {fetch next record}
241	>	function FetchPrior: boolean; {fetch previous record}
242	>	function FetchFirst:boolean; {fetch first record}
243	>	function FetchLast: boolean; {fetch last record}
244	>	function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
245	>	function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
246		function GetCursorName: AnsiString;
247		function GetTransaction: ITransaction; override;
248	+	function IsBof: boolean;
249		function IsEof: boolean;
250		procedure Close;
251		end;
252
253	+	{ TBatchCompletion }
254	+
255	+	TBatchCompletion = class(TInterfaceOwner,IBatchCompletion)
256	+	private
257	+	FCompletionState: Firebird.IBatchCompletionState;
258	+	FFirebird30ClientAPI: TFB30ClientAPI;
259	+	public
260	+	constructor Create(api: TFB30ClientAPI; cs: IBatchCompletionState);
261	+	destructor Destroy; override;
262	+	{IBatchCompletion}
263	+	function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
264	+	function getTotalProcessed: cardinal;
265	+	function getState(updateNo: cardinal): TBatchCompletionState;
266	+	function getStatusMessage(updateNo: cardinal): AnsiString;
267	+	function getUpdated: integer;
268	+	end;
269	+
270	+	TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
271	+
272		{ TFB30Statement }
273
274		TFB30Statement = class(TFBStatement,IStatement)
275		private
276		FStatementIntf: Firebird.IStatement;
277	+	FFirebird30ClientAPI: TFB30ClientAPI;
278		FSQLParams: TIBXINPUTSQLDA;
279		FSQLRecord: TIBXOUTPUTSQLDA;
280		FResultSet: Firebird.IResultSet;
281		FCursorSeqNo: integer;
282	+	FCursor: AnsiString;
283	+	FBatch: Firebird.IBatch;
284	+	FBatchCompletion: IBatchCompletion;
285	+	FBatchRowCount: integer;
286	+	FBatchBufferSize: integer;
287	+	FBatchBufferUsed: integer;
288		protected
289	+	procedure CheckChangeBatchRowLimit; override;
290		procedure CheckHandle; override;
291	+	procedure CheckBatchModeAvailable;
292		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
293	<	procedure InternalPrepare; 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;
#	Line 531 | Line 806 | end;
806
807		{ TResultSet }
808
809	+	procedure TResultSet.RowChange;
810	+	var i: integer;
811	+	begin
812	+	for i := 0 to getCount - 1 do
813	+	FResults.Column[i].RowChange;
814	+	end;
815	+
816		constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
817		begin
818		inherited Create(aResults);
#	Line 545 | Line 827 | begin
827		end;
828
829		function TResultSet.FetchNext: boolean;
548	–	var i: integer;
830		begin
831		CheckActive;
832	<	Result := FResults.FStatement.FetchNext;
832	>	Result := FResults.FStatement.Fetch(ftNext);
833	>	if Result then
834	>	RowChange;
835	>	end;
836	>
837	>	function TResultSet.FetchPrior: boolean;
838	>	begin
839	>	CheckActive;
840	>	Result := FResults.FStatement.Fetch(ftPrior);
841	>	if Result then
842	>	RowChange;
843	>	end;
844	>
845	>	function TResultSet.FetchFirst: boolean;
846	>	begin
847	>	CheckActive;
848	>	Result := FResults.FStatement.Fetch(ftFirst);
849	>	if Result then
850	>	RowChange;
851	>	end;
852	>
853	>	function TResultSet.FetchLast: boolean;
854	>	begin
855	>	CheckActive;
856	>	Result := FResults.FStatement.Fetch(ftLast);
857	>	if Result then
858	>	RowChange;
859	>	end;
860	>
861	>	function TResultSet.FetchAbsolute(position: Integer): boolean;
862	>	begin
863	>	CheckActive;
864	>	Result := FResults.FStatement.Fetch(ftAbsolute,position);
865	>	if Result then
866	>	RowChange;
867	>	end;
868	>
869	>	function TResultSet.FetchRelative(offset: Integer): boolean;
870	>	begin
871	>	CheckActive;
872	>	Result := FResults.FStatement.Fetch(ftRelative,offset);
873		if Result then
874	<	for i := 0 to getCount - 1 do
554	<	FResults.Column[i].RowChange;
874	>	RowChange;
875		end;
876
877		function TResultSet.GetCursorName: AnsiString;
878		begin
879	<	IBError(ibxeNotSupported,[nil]);
560	<	Result := '';
879	>	Result := FResults.FStatement.FCursor;
880		end;
881
882		function TResultSet.GetTransaction: ITransaction;
#	Line 565 | Line 884 | begin
884		Result := FResults.FTransaction;
885		end;
886
887	+	function TResultSet.IsBof: boolean;
888	+	begin
889	+	Result := FResults.FStatement.FBof;
890	+	end;
891	+
892		function TResultSet.IsEof: boolean;
893		begin
894		Result := FResults.FStatement.FEof;
#	Line 593 | Line 917 | end;
917
918		procedure TIBXINPUTSQLDA.FreeMessageBuffer;
919		begin
596	–	if FCurMetaData <> nil then
597	–	begin
598	–	FCurMetaData.release;
599	–	FCurMetaData := nil;
600	–	end;
920		if FMessageBuffer <> nil then
921		begin
922		FreeMem(FMessageBuffer);
#	Line 606 | Line 925 | begin
925		FMsgLength := 0;
926		end;
927
928	+	procedure TIBXINPUTSQLDA.FreeCurMetaData;
929	+	begin
930	+	if FCurMetaData <> nil then
931	+	begin
932	+	FCurMetaData.release;
933	+	FCurMetaData := nil;
934	+	end;
935	+	end;
936	+
937		function TIBXINPUTSQLDA.GetMessageBuffer: PByte;
938		begin
939		PackBuffer;
#	Line 628 | Line 956 | procedure TIBXINPUTSQLDA.BuildMetadata;
956		var Builder: Firebird.IMetadataBuilder;
957		i: integer;
958		begin
959	<	if FCurMetaData = nil then
960	<	with Firebird30ClientAPI do
959	>	if (FCurMetaData = nil) and (Count > 0) then
960	>	with FFirebird30ClientAPI do
961		begin
962	<	Builder := inherited MetaData.getBuilder(StatusIntf);
962	>	Builder := FFirebird30ClientAPI.MasterIntf.getMetadataBuilder(StatusIntf,Count);
963		Check4DataBaseError;
964		try
965		for i := 0 to Count - 1 do
966		with TIBXSQLVar(Column[i]) do
967		begin
968	<	Builder.setType(StatusIntf,i,FSQLType);
968	>	Builder.setType(StatusIntf,i,FSQLType+1);
969		Check4DataBaseError;
970		Builder.setSubType(StatusIntf,i,FSQLSubType);
971		Check4DataBaseError;
972	<	Builder.setLength(StatusIntf,i,FDataLength);
972	>	//        writeln('Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
973	>	if FSQLType = SQL_VARYING then
974	>	begin
975	>	{The datalength can be greater than the metadata size when SQLType has been overridden to text}
976	>	if (GetDataLength > GetSize) and CanChangeMetaData then
977	>	Builder.setLength(StatusIntf,i,GetDataLength)
978	>	else
979	>	Builder.setLength(StatusIntf,i,GetSize)
980	>	end
981	>	else
982	>	Builder.setLength(StatusIntf,i,GetDataLength);
983		Check4DataBaseError;
984		Builder.setCharSet(StatusIntf,i,GetCharSetID);
985		Check4DataBaseError;
#	Line 658 | Line 996 | end;
996
997		procedure TIBXINPUTSQLDA.PackBuffer;
998		var i: integer;
999	+	P: PByte;
1000		begin
1001		BuildMetadata;
1002
1003	<	if FMsgLength = 0 then
1004	<	with Firebird30ClientAPI do
1003	>	if (FMsgLength = 0) and (FCurMetaData <> nil) then
1004	>	with FFirebird30ClientAPI do
1005		begin
1006		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
1007		Check4DataBaseError;
#	Line 672 | Line 1011 | begin
1011		for i := 0 to Count - 1 do
1012		with TIBXSQLVar(Column[i]) do
1013		begin
1014	+	P := FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i);
1015	+	//     writeln('Packbuffer: Column ',Name,' Type = ',TSQLDataItem.GetSQLTypeName(FSQLType),' Size = ',GetSize,' DataLength = ',GetDataLength);
1016		if not Modified then
1017		IBError(ibxeUninitializedInputParameter,[i,Name]);
677	–
1018		if IsNull then
1019	<	FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1019	>	FillChar(P^,FDataLength,0)
1020		else
1021		if FSQLData <> nil then
1022	<	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1023	<	Check4DataBaseError;
1022	>	begin
1023	>	if SQLType = SQL_VARYING then
1024	>	begin
1025	>	EncodeInteger(FDataLength,2,P);
1026	>	Inc(P,2);
1027	>	end
1028	>	else
1029	>	if (SQLType = SQL_BLOB) and (FStatement.FBatch <> nil) then
1030	>	begin
1031	>	FStatement.FBatch.registerBlob(Statusintf,ISC_QUADPtr(FSQLData),ISC_QUADPtr(FSQLData));
1032	>	Check4DatabaseError;
1033	>	end;
1034	>	Move(FSQLData^,P^,FDataLength);
1035	>	end;
1036		if IsNullable then
1037		begin
1038		Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
#	Line 693 | Line 1045 | end;
1045		procedure TIBXINPUTSQLDA.FreeXSQLDA;
1046		begin
1047		inherited FreeXSQLDA;
1048	+	FreeCurMetaData;
1049		FreeMessageBuffer;
1050		end;
1051
#	Line 704 | Line 1057 | end;
1057
1058		destructor TIBXINPUTSQLDA.Destroy;
1059		begin
1060	<	FreeMessageBuffer;
1060	>	FreeXSQLDA;
1061		inherited Destroy;
1062		end;
1063
#	Line 712 | Line 1065 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1065		var i: integer;
1066		begin
1067		FMetaData := aMetaData;
1068	<	with Firebird30ClientAPI do
1068	>	with FFirebird30ClientAPI do
1069		begin
1070	<	Count := metadata.getCount(StatusIntf);
1070	>	Count := aMetadata.getCount(StatusIntf);
1071		Check4DataBaseError;
1072		Initialize;
1073
1074		for i := 0 to Count - 1 do
1075		with TIBXSQLVar(Column[i]) do
1076		begin
1077	<	FSQLType := aMetaData.getType(StatusIntf,i);
1078	<	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;
1077	>	InitColumnMetaData(aMetaData);
1078	>	SaveMetaData;
1079		if FNullable then
1080		FSQLNullIndicator := @FNullIndicator
1081		else
1082		FSQLNullIndicator := nil;
1083	<	FScale := aMetaData.getScale(StatusIntf,i);
761	<	Check4DataBaseError;
762	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
763	<	Check4DataBaseError;
1083	>	ColumnSQLDataInit;
1084		end;
1085		end;
1086		end;
#	Line 768 | Line 1088 | end;
1088		procedure TIBXINPUTSQLDA.Changed;
1089		begin
1090		inherited Changed;
1091	+	FreeCurMetaData;
1092		FreeMessageBuffer;
1093		end;
1094
1095	+	procedure TIBXINPUTSQLDA.ReInitialise;
1096	+	var i: integer;
1097	+	begin
1098	+	FreeMessageBuffer;
1099	+	for i := 0 to Count - 1 do
1100	+	TIBXSQLVar(Column[i]).ColumnSQLDataInit;
1101	+	end;
1102	+
1103		function TIBXINPUTSQLDA.IsInputDataArea: boolean;
1104		begin
1105		Result := true;
#	Line 790 | Line 1119 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData
1119		var i: integer;
1120		begin
1121		FMetaData := aMetaData;
1122	<	with Firebird30ClientAPI do
1122	>	with FFirebird30ClientAPI do
1123		begin
1124		Count := metadata.getCount(StatusIntf);
1125		Check4DataBaseError;
#	Line 803 | Line 1132 | begin
1132		for i := 0 to Count - 1 do
1133		with TIBXSQLVar(Column[i]) do
1134		begin
1135	<	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;
1135	>	InitColumnMetaData(aMetaData);
1136		FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1137		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;
1138		if FNullable then
1139		begin
1140		FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
#	Line 831 | Line 1142 | begin
1142		end
1143		else
1144		FSQLNullIndicator := nil;
1145	<	FScale := aMetaData.getScale(StatusIntf,i);
1146	<	Check4DataBaseError;
836	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
837	<	Check4DataBaseError;
1145	>	FBlob := nil;
1146	>	FArray := nil;
1147		end;
1148		end;
1149		SetUniqueRelationName;
#	Line 850 | Line 1159 | begin
1159		len := FDataLength;
1160		if not IsNull and (FSQLType = SQL_VARYING) then
1161		begin
1162	<	with Firebird30ClientAPI do
1162	>	with FFirebird30ClientAPI do
1163		len := DecodeInteger(data,2);
1164		Inc(Data,2);
1165		end;
#	Line 867 | Line 1176 | constructor TIBXSQLDA.Create(aStatement:
1176		begin
1177		inherited Create;
1178		FStatement := aStatement;
1179	+	FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
1180		FSize := 0;
1181		//  writeln('Creating ',ClassName);
1182		end;
#	Line 927 | Line 1237 | begin
1237		ChangeSeqNo := FStatement.ChangeSeqNo;
1238		end;
1239
1240	+	function TIBXSQLDA.CanChangeMetaData: boolean;
1241	+	begin
1242	+	Result := FStatement.FBatch = nil;
1243	+	end;
1244	+
1245		procedure TIBXSQLDA.SetCount(Value: Integer);
1246		var
1247		i: Integer;
#	Line 958 | Line 1273 | begin
1273		TIBXSQLVAR(Column[i]).FreeSQLData;
1274		for i := 0 to FSize - 1  do
1275		TIBXSQLVAR(Column[i]).Free;
1276	+	FCount := 0;
1277		SetLength(FColumnList,0);
1278		FSize := 0;
1279		end;
#	Line 974 | Line 1290 | end;
1290
1291		{ TFB30Statement }
1292
1293	+	procedure TFB30Statement.CheckChangeBatchRowLimit;
1294	+	begin
1295	+	if IsInBatchMode then
1296	+	IBError(ibxeInBatchMode,[nil]);
1297	+	end;
1298	+
1299		procedure TFB30Statement.CheckHandle;
1300		begin
1301		if FStatementIntf = nil then
1302		IBError(ibxeInvalidStatementHandle,[nil]);
1303		end;
1304
1305	+	procedure TFB30Statement.CheckBatchModeAvailable;
1306	+	begin
1307	+	if not HasBatchMode then
1308	+	IBError(ibxeBatchModeNotSupported,[nil]);
1309	+	case SQLStatementType of
1310	+	SQLInsert,
1311	+	SQLUpdate: {OK};
1312	+	else
1313	+	IBError(ibxeInvalidBatchQuery,[GetSQLStatementTypeName]);
1314	+	end;
1315	+	end;
1316	+
1317		procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1318		);
1319		begin
1320	<	with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1320	>	with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1321		begin
1322		StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1323		GetBufSize, BytePtr(Buffer));
#	Line 991 | Line 1325 | begin
1325		end;
1326		end;
1327
1328	<	procedure TFB30Statement.InternalPrepare;
1328	>	procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1329	>	var GUID : TGUID;
1330		begin
1331		if FPrepared then
1332		Exit;
1333	+
1334	+	FCursor := CursorName;
1335		if (FSQL = '') then
1336		IBError(ibxeEmptyQuery, [nil]);
1337		try
1338		CheckTransaction(FTransactionIntf);
1339	<	with Firebird30ClientAPI do
1339	>	with FFirebird30ClientAPI do
1340		begin
1341	+	if FCursor = '' then
1342	+	begin
1343	+	CreateGuid(GUID);
1344	+	FCursor := GUIDToString(GUID);
1345	+	end;
1346	+
1347		if FHasParamNames then
1348		begin
1349		if FProcessedSQL = '' then
1350	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1350	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1351		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1352		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1353		Length(FProcessedSQL),
#	Line 1023 | Line 1366 | begin
1366		FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1367		Check4DataBaseError;
1368
1369	+	if FSQLStatementType = SQLSelect then
1370	+	begin
1371	+	FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1372	+	Check4DataBaseError;
1373	+	end;
1374		{ Done getting the type }
1375		case FSQLStatementType of
1376		SQLGetSegment,
#	Line 1055 | Line 1403 | begin
1403		if (FStatementIntf <> nil) then
1404		FreeHandle;
1405		if E is EIBInterBaseError then
1406	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1407	<	EIBInterBaseError(E).IBErrorCode,
1060	<	EIBInterBaseError(E).Message +
1061	<	sSQLErrorSeparator + FSQL)
1062	<	else
1063	<	raise;
1406	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1407	>	raise;
1408		end;
1409		end;
1410		FPrepared := true;
1411	+
1412		FSingleResults := false;
1413		if RetainInterfaces then
1414		begin
#	Line 1081 | Line 1426 | begin
1426		end;
1427
1428		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1429	+
1430	+	procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1431	+	begin
1432	+	with FFirebird30ClientAPI do
1433	+	begin
1434	+	SavePerfStats(FBeforeStats);
1435	+	FStatementIntf.execute(StatusIntf,
1436	+	(aTransaction as TFB30Transaction).TransactionIntf,
1437	+	FSQLParams.MetaData,
1438	+	FSQLParams.MessageBuffer,
1439	+	outMetaData,
1440	+	outBuffer);
1441	+	Check4DataBaseError;
1442	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1443	+	end;
1444	+	end;
1445	+
1446	+	var Cursor: IResultSet;
1447	+
1448		begin
1449		Result := nil;
1450	+	FBatchCompletion := nil;
1451		FBOF := false;
1452		FEOF := false;
1453		FSingleResults := false;
1454	+	FStatisticsAvailable := false;
1455	+	if IsInBatchMode then
1456	+	IBerror(ibxeInBatchMode,[]);
1457		CheckTransaction(aTransaction);
1458		if not FPrepared then
1459		InternalPrepare;
1460		CheckHandle;
1461		if aTransaction <> FTransactionIntf then
1462		AddMonitor(aTransaction as TFB30Transaction);
1463	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1463	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1464		IBError(ibxeInterfaceOutofDate,[nil]);
1465
1466	+
1467		try
1468	<	with Firebird30ClientAPI do
1468	>	with FFirebird30ClientAPI do
1469		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	–
1470		case FSQLStatementType of
1471		SQLSelect:
1472	<	IBError(ibxeIsAExecuteProcedure,[]);
1472	>	{e.g. Update...returning with a single row in Firebird 5 and later}
1473	>	begin
1474	>	Cursor := InternalOpenCursor(aTransaction,false);
1475	>	if not Cursor.IsEof then
1476	>	Cursor.FetchNext;
1477	>	Result := Cursor; {note only first row}
1478	>	FSingleResults := true;
1479	>	end;
1480
1481		SQLExecProcedure:
1482		begin
1483	<	FStatementIntf.execute(StatusIntf,
1116	<	(aTransaction as TFB30Transaction).TransactionIntf,
1117	<	FSQLParams.MetaData,
1118	<	FSQLParams.MessageBuffer,
1119	<	FSQLRecord.MetaData,
1120	<	FSQLRecord.MessageBuffer);
1121	<	Check4DataBaseError;
1122	<
1483	>	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1484		Result := TResults.Create(FSQLRecord);
1485		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;
1486		end;
1487	<	if FCollectStatistics then
1488	<	begin
1489	<	UtilIntf.getPerfCounters(StatusIntf,
1138	<	(GetAttachment as TFB30Attachment).AttachmentIntf,
1139	<	ISQL_COUNTERS, @FAfterStats);
1140	<	Check4DataBaseError;
1141	<	FStatisticsAvailable := true;
1487	>
1488	>	else
1489	>	ExecuteQuery;
1490		end;
1491		end;
1492		finally
#	Line 1152 | Line 1500 | begin
1500		Inc(FChangeSeqNo);
1501		end;
1502
1503	<	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1504	<	): IResultSet;
1503	>	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1504	>	Scrollable: boolean): IResultSet;
1505	>	var flags: cardinal;
1506		begin
1507	<	if FSQLStatementType <> SQLSelect then
1507	>	flags := 0;
1508	>	if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1509		IBError(ibxeIsASelectStatement,[]);
1510
1511	<	CheckTransaction(aTransaction);
1511	>	FBatchCompletion := nil;
1512	>	CheckTransaction(aTransaction);
1513		if not FPrepared then
1514		InternalPrepare;
1515		CheckHandle;
1516		if aTransaction <> FTransactionIntf then
1517		AddMonitor(aTransaction as TFB30Transaction);
1518	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1518	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1519		IBError(ibxeInterfaceOutofDate,[nil]);
1520
1521	<	with Firebird30ClientAPI do
1521	>	if Scrollable then
1522	>	flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1523	>
1524	>	with FFirebird30ClientAPI do
1525		begin
1526		if FCollectStatistics then
1527		begin
#	Line 1182 | Line 1536 | begin
1536		FSQLParams.MetaData,
1537		FSQLParams.MessageBuffer,
1538		FSQLRecord.MetaData,
1539	<	0);
1539	>	flags);
1540		Check4DataBaseError;
1541
1542		if FCollectStatistics then
#	Line 1207 | Line 1561 | begin
1561		Inc(FChangeSeqNo);
1562		end;
1563
1564	+	procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1565	+	var processedSQL: AnsiString);
1566	+	begin
1567	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1568	+	end;
1569	+
1570		procedure TFB30Statement.FreeHandle;
1571		begin
1572		Close;
1573		ReleaseInterfaces;
1574	+	if FBatch <> nil then
1575	+	begin
1576	+	FBatch.release;
1577	+	FBatch := nil;
1578	+	end;
1579		if FStatementIntf <> nil then
1580		begin
1581		FStatementIntf.release;
1582		FStatementIntf := nil;
1583		FPrepared := false;
1584		end;
1585	+	FCursor := '';
1586		end;
1587
1588		procedure TFB30Statement.InternalClose(Force: boolean);
1589		begin
1590		if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1591		try
1592	<	with Firebird30ClientAPI do
1592	>	with FFirebird30ClientAPI do
1593		begin
1594		if FResultSet <> nil then
1595		begin
#	Line 1247 | Line 1613 | begin
1613		Inc(FChangeSeqNo);
1614		end;
1615
1616	+	function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1617	+	begin
1618	+	Result := false;
1619	+	if FCollectStatistics then
1620	+	with FFirebird30ClientAPI do
1621	+	begin
1622	+	UtilIntf.getPerfCounters(StatusIntf,
1623	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1624	+	ISQL_COUNTERS, @Stats);
1625	+	Check4DataBaseError;
1626	+	Result := true;
1627	+	end;
1628	+	end;
1629	+
1630		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1631	<	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1631	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1632	>	CursorName: AnsiString);
1633		begin
1634		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1635	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1636		FSQLParams := TIBXINPUTSQLDA.Create(self);
1637		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1638	<	InternalPrepare;
1638	>	InternalPrepare(CursorName);
1639		end;
1640
1641		constructor TFB30Statement.CreateWithParameterNames(
1642		Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1643	<	aSQLDialect: integer; GenerateParamNames: boolean);
1643	>	aSQLDialect: integer; GenerateParamNames: boolean;
1644	>	CaseSensitiveParams: boolean; CursorName: AnsiString);
1645		begin
1646		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1647	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1648		FSQLParams := TIBXINPUTSQLDA.Create(self);
1649	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1650		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1651	<	InternalPrepare;
1651	>	InternalPrepare(CursorName);
1652		end;
1653
1654		destructor TFB30Statement.Destroy;
#	Line 1273 | Line 1658 | begin
1658		if assigned(FSQLRecord) then FSQLRecord.Free;
1659		end;
1660
1661	<	function TFB30Statement.FetchNext: boolean;
1661	>	function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1662	>	): boolean;
1663		var fetchResult: integer;
1664		begin
1665		result := false;
1666		if not FOpen then
1667		IBError(ibxeSQLClosed, [nil]);
1282	–	if FEOF then
1283	–	IBError(ibxeEOF,[nil]);
1668
1669	<	with Firebird30ClientAPI do
1669	>	with FFirebird30ClientAPI do
1670		begin
1671	<	{ Go to the next record... }
1672	<	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1673	<	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1674	<	begin
1675	<	FBOF := false;
1676	<	FEOF := true;
1677	<	Exit; {End of File}
1678	<	end
1679	<	else
1680	<	if fetchResult <> Firebird.IStatus.RESULT_OK then
1681	<	begin
1682	<	try
1683	<	IBDataBaseError;
1300	<	except
1301	<	Close;
1302	<	raise;
1671	>	case FetchType of
1672	>	ftNext:
1673	>	begin
1674	>	if FEOF then
1675	>	IBError(ibxeEOF,[nil]);
1676	>	{ Go to the next record... }
1677	>	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1678	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1679	>	begin
1680	>	FBOF := false;
1681	>	FEOF := true;
1682	>	Exit; {End of File}
1683	>	end
1684		end;
1685	<	end
1686	<	else
1685	>
1686	>	ftPrior:
1687	>	begin
1688	>	if FBOF then
1689	>	IBError(ibxeBOF,[nil]);
1690	>	{ Go to the next record... }
1691	>	fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1692	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1693	>	begin
1694	>	FBOF := true;
1695	>	FEOF := false;
1696	>	Exit; {Top of File}
1697	>	end
1698	>	end;
1699	>
1700	>	ftFirst:
1701	>	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1702	>
1703	>	ftLast:
1704	>	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1705	>
1706	>	ftAbsolute:
1707	>	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1708	>
1709	>	ftRelative:
1710	>	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1711	>	end;
1712	>
1713	>	Check4DataBaseError;
1714	>	if fetchResult <> Firebird.IStatus.RESULT_OK then
1715	>	exit; {result = false}
1716	>
1717	>	{Result OK}
1718	>	FBOF := false;
1719	>	FEOF := false;
1720	>	result := true;
1721	>
1722	>	if FCollectStatistics then
1723		begin
1724	<	FBOF := false;
1725	<	result := true;
1724	>	UtilIntf.getPerfCounters(StatusIntf,
1725	>	(GetAttachment as TFB30Attachment).AttachmentIntf,
1726	>	ISQL_COUNTERS,@FAfterStats);
1727	>	Check4DataBaseError;
1728	>	FStatisticsAvailable := true;
1729		end;
1730		end;
1731		FSQLRecord.RowChange;
#	Line 1338 | Line 1758 | begin
1758		SQLUpdate, SQLDelete])) then
1759		result := ''
1760		else
1761	<	with Firebird30ClientAPI do
1761	>	with FFirebird30ClientAPI do
1762		begin
1763		Result := FStatementIntf.getPlan(StatusIntf,true);
1764		Check4DataBaseError;
#	Line 1372 | Line 1792 | begin
1792		TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1793		end;
1794
1795	+	function TFB30Statement.IsInBatchMode: boolean;
1796	+	begin
1797	+	Result := FBatch <> nil;
1798	+	end;
1799	+
1800	+	function TFB30Statement.HasBatchMode: boolean;
1801	+	begin
1802	+	Result := GetAttachment.HasBatchMode;
1803	+	end;
1804	+
1805	+	procedure TFB30Statement.AddToBatch;
1806	+	var BatchPB: TXPBParameterBlock;
1807	+
1808	+	const SixteenMB = 16 * 1024 * 1024;
1809	+	begin
1810	+	FBatchCompletion := nil;
1811	+	if not FPrepared then
1812	+	InternalPrepare;
1813	+	CheckHandle;
1814	+	CheckBatchModeAvailable;
1815	+	with FFirebird30ClientAPI do
1816	+	begin
1817	+	if FBatch = nil then
1818	+	begin
1819	+	{Start Batch}
1820	+	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1821	+	with FFirebird30ClientAPI do
1822	+	try
1823	+	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1824	+	Check4DatabaseError;
1825	+	if FBatchBufferSize < SixteenMB then
1826	+	FBatchBufferSize := SixteenMB;
1827	+	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1828	+	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1829	+
1830	+	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1831	+	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1832	+	FBatch := FStatementIntf.createBatch(StatusIntf,
1833	+	FSQLParams.MetaData,
1834	+	BatchPB.getDataLength,
1835	+	BatchPB.getBuffer);
1836	+	Check4DataBaseError;
1837	+
1838	+	finally
1839	+	BatchPB.Free;
1840	+	end;
1841	+	FBatchRowCount := 0;
1842	+	FBatchBufferUsed := 0;
1843	+	end;
1844	+
1845	+	Inc(FBatchRowCount);
1846	+	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1847	+	Check4DataBaseError;
1848	+	if FBatchBufferUsed > FBatchBufferSize then
1849	+	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1850	+	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1851	+	[FBatchRowCount,FBatchBufferSize]));
1852	+
1853	+	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1854	+	Check4DataBaseError
1855	+	end;
1856	+	end;
1857	+
1858	+	function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1859	+	): IBatchCompletion;
1860	+
1861	+	procedure Check4BatchCompletionError(bc: IBatchCompletion);
1862	+	var status: IStatus;
1863	+	RowNo: integer;
1864	+	begin
1865	+	status := nil;
1866	+	{Raise an exception if there was an error reported in the BatchCompletion}
1867	+	if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1868	+	raise EIBInterbaseError.Create(status);
1869	+	end;
1870	+
1871	+	var cs: Firebird.IBatchCompletionState;
1872	+
1873	+	begin
1874	+	Result := nil;
1875	+	if FBatch = nil then
1876	+	IBError(ibxeNotInBatchMode,[]);
1877	+
1878	+	with FFirebird30ClientAPI do
1879	+	begin
1880	+	SavePerfStats(FBeforeStats);
1881	+	if aTransaction = nil then
1882	+	cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1883	+	else
1884	+	cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1885	+	Check4DataBaseError;
1886	+	FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1887	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1888	+	FBatch.release;
1889	+	FBatch := nil;
1890	+	Check4BatchCompletionError(FBatchCompletion);
1891	+	Result := FBatchCompletion;
1892	+	end;
1893	+	end;
1894	+
1895	+	procedure TFB30Statement.CancelBatch;
1896	+	begin
1897	+	if FBatch = nil then
1898	+	IBError(ibxeNotInBatchMode,[]);
1899	+	FBatch.release;
1900	+	FBatch := nil;
1901	+	end;
1902	+
1903	+	function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1904	+	begin
1905	+	Result := FBatchCompletion;
1906	+	end;
1907	+
1908		function TFB30Statement.IsPrepared: boolean;
1909		begin
1910		Result := FStatementIntf <> nil;
1911		end;
1912
1913	+	function TFB30Statement.GetFlags: TStatementFlags;
1914	+	var flags: cardinal;
1915	+	begin
1916	+	CheckHandle;
1917	+	Result := [];
1918	+	with FFirebird30ClientAPI do
1919	+	begin
1920	+	flags := FStatementIntf.getFlags(StatusIntf);
1921	+	Check4DataBaseError;
1922	+	end;
1923	+	if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
1924	+	Result := Result + [stHasCursor];
1925	+	if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
1926	+	Result := Result + [stRepeatExecute];
1927	+	if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
1928	+	Result := Result + [stScrollable];
1929	+	end;
1930	+
1931		end.
1932

Diff Legend

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