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 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 350 by tony, Wed Oct 20 14:58:56 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;
194		function GetMsgLength: integer;
195	+	procedure BuildMetadata;
196		procedure PackBuffer;
197		protected
198		procedure FreeXSQLDA; override;
#	Line 189 | 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 219 | 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 265 | Line 317 | type
317		function CreateBlob(column: TColumnMetaData): IBlob; override;
318		function CreateArray(column: TColumnMetaData): IArray; override;
319		procedure SetRetainInterfaces(aValue: boolean); override;
320	<
320	>	function IsInBatchMode: boolean; override;
321	>	function HasBatchMode: boolean; override;
322	>	procedure AddToBatch; override;
323	>	function ExecuteBatch(aTransaction: ITransaction
324	>	): IBatchCompletion; override;
325	>	procedure CancelBatch; override;
326	>	function GetBatchCompletion: IBatchCompletion; override;
327		end;
328
329		implementation
330
331	<	uses IBUtils, FBMessages, FBBLob, FB30Blob, variants,  FBArray, FB30Array;
331	>	uses IBUtils, FBMessages, FBBlob, FB30Blob, variants,  FBArray, FB30Array;
332
333		const
334		ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
335
336	+	{ EIBBatchCompletionError }
337	+
338	+	{ TBatchCompletion }
339	+
340	+	constructor TBatchCompletion.Create(api: TFB30ClientAPI;
341	+	cs: IBatchCompletionState);
342	+	begin
343	+	inherited Create;
344	+	FFirebird30ClientAPI := api;
345	+	FCompletionState := cs;
346	+	end;
347	+
348	+	destructor TBatchCompletion.Destroy;
349	+	begin
350	+	if FCompletionState <> nil then
351	+	begin
352	+	FCompletionState.dispose;
353	+	FCompletionState := nil;
354	+	end;
355	+	inherited Destroy;
356	+	end;
357	+
358	+	function TBatchCompletion.getErrorStatus(var RowNo: integer; var status: IStatus
359	+	): boolean;
360	+	var i: integer;
361	+	upcount: cardinal;
362	+	state: integer;
363	+	FBStatus: Firebird.IStatus;
364	+	begin
365	+	Result := false;
366	+	RowNo := -1;
367	+	FBStatus := nil;
368	+	with FFirebird30ClientAPI do
369	+	begin
370	+	upcount := FCompletionState.getSize(StatusIntf);
371	+	Check4DataBaseError;
372	+	for i := 0 to upcount - 1 do
373	+	begin
374	+	state := FCompletionState.getState(StatusIntf,i);
375	+	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
376	+	begin
377	+	RowNo := i+1;
378	+	FBStatus := MasterIntf.getStatus;
379	+	try
380	+	FCompletionState.getStatus(StatusIntf,FBStatus,i);
381	+	Check4DataBaseError;
382	+	except
383	+	FBStatus.dispose;
384	+	raise
385	+	end;
386	+	status := TFB30StatusObject.Create(FFirebird30ClientAPI,FBStatus,
387	+	Format(SBatchCompletionError,[RowNo]));
388	+	status.SetIBDataBaseErrorMessages(GetStatus.GetIBDataBaseErrorMessages);
389	+	Result := true;
390	+	break;
391	+	end;
392	+	end;
393	+	end;
394	+	end;
395	+
396	+	function TBatchCompletion.getTotalProcessed: cardinal;
397	+	begin
398	+	with FFirebird30ClientAPI do
399	+	begin
400	+	Result := FCompletionState.getsize(StatusIntf);
401	+	Check4DataBaseError;
402	+	end;
403	+	end;
404	+
405	+	function TBatchCompletion.getState(updateNo: cardinal): TBatchCompletionState;
406	+	var state: integer;
407	+	begin
408	+	with FFirebird30ClientAPI do
409	+	begin
410	+	state := FCompletionState.getState(StatusIntf,updateNo);
411	+	Check4DataBaseError;
412	+	case state of
413	+	Firebird.IBatchCompletionState.EXECUTE_FAILED:
414	+	Result := bcExecuteFailed;
415	+
416	+	Firebird.IBatchCompletionState.SUCCESS_NO_INFO:
417	+	Result := bcSuccessNoInfo;
418	+
419	+	else
420	+	Result := bcNoMoreErrors;
421	+	end;
422	+	end;
423	+	end;
424	+
425	+	function TBatchCompletion.getStatusMessage(updateNo: cardinal): AnsiString;
426	+	var status: Firebird.IStatus;
427	+	begin
428	+	with FFirebird30ClientAPI do
429	+	begin
430	+	status := MasterIntf.getStatus;
431	+	FCompletionState.getStatus(StatusIntf,status,updateNo);
432	+	Check4DataBaseError;
433	+	Result := FormatFBStatus(status);
434	+	end;
435	+	end;
436	+
437	+	function TBatchCompletion.getUpdated: integer;
438	+	var i: integer;
439	+	upcount: cardinal;
440	+	state: integer;
441	+	begin
442	+	Result := 0;
443	+	with FFirebird30ClientAPI do
444	+	begin
445	+	upcount := FCompletionState.getSize(StatusIntf);
446	+	Check4DataBaseError;
447	+	for i := 0 to upcount -1  do
448	+	begin
449	+	state := FCompletionState.getState(StatusIntf,i);
450	+	if state = Firebird.IBatchCompletionState.EXECUTE_FAILED then
451	+	break;
452	+	Inc(Result);
453	+	end;
454	+	end;
455	+	end;
456	+
457		{ TIBXSQLVAR }
458
459		procedure TIBXSQLVAR.Changed;
#	Line 283 | Line 462 | begin
462		TIBXSQLDA(Parent).Changed;
463		end;
464
465	+	procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
466	+	begin
467	+	with FFirebird30ClientAPI do
468	+	begin
469	+	FSQLType := aMetaData.getType(StatusIntf,Index);
470	+	Check4DataBaseError;
471	+	if FSQLType = SQL_BLOB then
472	+	begin
473	+	FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
474	+	Check4DataBaseError;
475	+	end
476	+	else
477	+	FSQLSubType := 0;
478	+	FDataLength := aMetaData.getLength(StatusIntf,Index);
479	+	Check4DataBaseError;
480	+	FMetadataSize := FDataLength;
481	+	FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
482	+	Check4DataBaseError;
483	+	FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
484	+	Check4DataBaseError;
485	+	FNullable := aMetaData.isNullable(StatusIntf,Index);
486	+	Check4DataBaseError;
487	+	FScale := aMetaData.getScale(StatusIntf,Index);
488	+	Check4DataBaseError;
489	+	FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
490	+	Check4DataBaseError;
491	+	end;
492	+	end;
493	+
494	+	procedure TIBXSQLVAR.ColumnSQLDataInit;
495	+	begin
496	+	FreeSQLData;
497	+	with FFirebird30ClientAPI do
498	+	begin
499	+	case SQLType of
500	+	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
501	+	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
502	+	SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
503	+	SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
504	+	SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
505	+	begin
506	+	if (FDataLength = 0) then
507	+	{ Make sure you get a valid pointer anyway
508	+	select '' from foo }
509	+	IBAlloc(FSQLData, 0, 1)
510	+	else
511	+	IBAlloc(FSQLData, 0, FDataLength)
512	+	end;
513	+	SQL_VARYING:
514	+	IBAlloc(FSQLData, 0, FDataLength + 2);
515	+	else
516	+	IBError(ibxeUnknownSQLDataType, [SQLType and (not 1)])
517	+	end;
518	+	FOwnsSQLData := true;
519	+	FNullIndicator := -1;
520	+	end;
521	+	end;
522	+
523	+	function TIBXSQLVAR.CanChangeSQLType: boolean;
524	+	begin
525	+	Result := Parent.CanChangeMetaData;
526	+	end;
527	+
528		function TIBXSQLVAR.GetSQLType: cardinal;
529		begin
530		Result := FSQLType;
#	Line 295 | Line 537 | end;
537
538		function TIBXSQLVAR.GetAliasName: AnsiString;
539		begin
540	<	with Firebird30ClientAPI do
540	>	with FFirebird30ClientAPI do
541		begin
542		result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
543		Check4DataBaseError;
#	Line 309 | Line 551 | end;
551
552		function TIBXSQLVAR.GetOwnerName: AnsiString;
553		begin
554	<	with Firebird30ClientAPI do
554	>	with FFirebird30ClientAPI do
555		begin
556		result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
557		Check4DataBaseError;
#	Line 328 | Line 570 | end;
570
571		function TIBXSQLVAR.GetCharSetID: cardinal;
572		begin
573	<	result := 0;
573	>	result := 0; {NONE}
574		case SQLType of
575		SQL_VARYING, SQL_TEXT:
576		result := FCharSetID;
577
578		SQL_BLOB:
579		if (SQLSubType = 1) then
580	<	result := FCharSetID;
580	>	result := FCharSetID
581	>	else
582	>	result := 1; {OCTETS}
583
584		SQL_ARRAY:
585		if (FRelationName <> '') and (FFieldName <> '') then
#	Line 348 | Line 592 | end;
592		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
593		begin
594		result := CP_NONE;
595	<	with Firebird30ClientAPI do
595	>	with Statement.GetAttachment do
596		CharSetID2CodePage(GetCharSetID,result);
597		end;
598
599	+	function TIBXSQLVAR.GetCharSetWidth: integer;
600	+	begin
601	+	result := 1;
602	+	with Statement.GetAttachment DO
603	+	CharSetWidth(GetCharSetID,result);
604	+	end;
605	+
606		function TIBXSQLVAR.GetIsNull: Boolean;
607		begin
608		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 372 | Line 623 | begin
623		Result := FDataLength;
624		end;
625
626	+	function TIBXSQLVAR.GetSize: cardinal;
627	+	begin
628	+	Result := FMetadataSize;
629	+	end;
630	+
631	+	function TIBXSQLVAR.GetAttachment: IAttachment;
632	+	begin
633	+	Result := FStatement.GetAttachment;
634	+	end;
635	+
636		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
637		begin
638		if GetSQLType <> SQL_ARRAY then
#	Line 421 | Line 682 | begin
682		end
683		else
684		FSQLNullIndicator := nil;
685	+	Changed;
686		end;
687
688		procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
#	Line 430 | Line 692 | begin
692		FSQLData := AValue;
693		FDataLength := len;
694		FOwnsSQLData := false;
695	+	Changed;
696		end;
697
698		procedure TIBXSQLVAR.SetScale(aValue: integer);
699		begin
700		FScale := aValue;
701	+	Changed;
702		end;
703
704		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 442 | Line 706 | begin
706		if not FOwnsSQLData then
707		FSQLData := nil;
708		FDataLength := len;
709	<	with Firebird30ClientAPI do
709	>	with FFirebird30ClientAPI do
710		IBAlloc(FSQLData, 0, FDataLength);
711		FOwnsSQLData := true;
712	+	Changed;
713		end;
714
715		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
716		begin
717	+	if (FSQLType <> aValue) and not CanChangeSQLType then
718	+	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
719		FSQLType := aValue;
720	+	Changed;
721		end;
722
723		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
724		begin
725		FCharSetID := aValue;
726	+	Changed;
727	+	end;
728	+
729	+	procedure TIBXSQLVAR.SetMetaSize(aValue: cardinal);
730	+	begin
731	+	if (aValue > FMetaDataSize) and not CanChangeSQLType then
732	+	IBError(ibxeCannotIncreaseMetadatasize,[FMetaDataSize,aValue]);
733	+	FMetaDataSize := aValue;
734	+	end;
735	+
736	+	function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
737	+	begin
738	+	Result := SQL_VARYING;
739		end;
740
741		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
742		begin
743		inherited Create(aParent,aIndex);
744		FStatement := aParent.Statement;
745	+	FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
746		end;
747
748		procedure TIBXSQLVAR.RowChange;
#	Line 523 | 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 537 | Line 826 | begin
826		end;
827
828		function TResultSet.FetchNext: boolean;
540	–	var i: integer;
829		begin
830		CheckActive;
831	<	Result := FResults.FStatement.FetchNext;
831	>	Result := FResults.FStatement.Fetch(ftNext);
832		if Result then
833	<	for i := 0 to getCount - 1 do
834	<	FResults.Column[i].RowChange;
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	>	RowChange;
874		end;
875
876		function TResultSet.GetCursorName: AnsiString;
877		begin
878	<	IBError(ibxeNotSupported,[nil]);
552	<	Result := '';
878	>	Result := FResults.FStatement.FCursor;
879		end;
880
881		function TResultSet.GetTransaction: ITransaction;
#	Line 557 | 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 585 | Line 916 | end;
916
917		procedure TIBXINPUTSQLDA.FreeMessageBuffer;
918		begin
588	–	if FCurMetaData <> nil then
589	–	begin
590	–	FCurMetaData.release;
591	–	FCurMetaData := nil;
592	–	end;
919		if FMessageBuffer <> nil then
920		begin
921		FreeMem(FMessageBuffer);
#	Line 598 | 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 606 | Line 941 | end;
941
942		function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
943		begin
944	<	PackBuffer;
944	>	BuildMetadata;
945		Result := FCurMetaData;
946		end;
947
#	Line 616 | Line 951 | begin
951		Result := FMsgLength;
952		end;
953
954	<	procedure TIBXINPUTSQLDA.PackBuffer;
954	>	procedure TIBXINPUTSQLDA.BuildMetadata;
955		var Builder: Firebird.IMetadataBuilder;
956		i: integer;
957		begin
958	<	if FMsgLength > 0 then Exit;
959	<
625	<	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 646 | Line 990 | begin
990		finally
991		Builder.release;
992		end;
993	+	end;
994	+	end;
995	+
996	+	procedure TIBXINPUTSQLDA.PackBuffer;
997	+	var i: integer;
998	+	P: PByte;
999	+	begin
1000	+	BuildMetadata;
1001
1002	+	if (FMsgLength = 0) and (FCurMetaData <> nil) then
1003	+	with FFirebird30ClientAPI do
1004	+	begin
1005		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
1006		Check4DataBaseError;
1007
#	Line 655 | 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]);
1017		if IsNull then
1018	<	FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
1018	>	FillChar(P^,FDataLength,0)
1019		else
1020	<	Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
1021	<	Check4DataBaseError;
1020	>	if FSQLData <> nil then
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 672 | Line 1044 | end;
1044		procedure TIBXINPUTSQLDA.FreeXSQLDA;
1045		begin
1046		inherited FreeXSQLDA;
1047	+	FreeCurMetaData;
1048		FreeMessageBuffer;
1049		end;
1050
#	Line 683 | Line 1056 | end;
1056
1057		destructor TIBXINPUTSQLDA.Destroy;
1058		begin
1059	<	FreeMessageBuffer;
1059	>	FreeXSQLDA;
1060		inherited Destroy;
1061		end;
1062
#	Line 691 | 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;
705	<	if FSQLType = SQL_BLOB then
706	<	begin
707	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
708	<	Check4DataBaseError;
709	<	end
710	<	else
711	<	FSQLSubType := 0;
712	<	FDataLength := aMetaData.getLength(StatusIntf,i);
713	<	Check4DataBaseError;
714	<	case SQLType of
715	<	SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
716	<	SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
717	<	SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
718	<	begin
719	<	if (FDataLength = 0) then
720	<	{ Make sure you get a valid pointer anyway
721	<	select '' from foo }
722	<	IBAlloc(FSQLData, 0, 1)
723	<	else
724	<	IBAlloc(FSQLData, 0, FDataLength)
725	<	end;
726	<	SQL_VARYING:
727	<	IBAlloc(FSQLData, 0, FDataLength + 2);
728	<	else
729	<	IBError(ibxeUnknownSQLDataType, [sqltype and (not 1)])
730	<	end;
731	<	FNullable := aMetaData.isNullable(StatusIntf,i);
732	<	FOwnsSQLData := true;
733	<	Check4DataBaseError;
734	<	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);
740	<	Check4DataBaseError;
741	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
742	<	Check4DataBaseError;
1082	>	ColumnSQLDataInit;
1083		end;
1084		end;
1085		end;
#	Line 747 | 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 769 | 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 782 | 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);
786	<	Check4DataBaseError;
787	<	if FSQLType = SQL_BLOB then
788	<	begin
789	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
790	<	Check4DataBaseError;
791	<	end
792	<	else
793	<	FSQLSubType := 0;
794	<	FBlob := nil;
795	<	FArray := nil;
1134	>	InitColumnMetaData(aMetaData);
1135		FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1136		Check4DataBaseError;
798	–	FDataLength := aMetaData.getLength(StatusIntf,i);
799	–	Check4DataBaseError;
800	–	FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
801	–	Check4DataBaseError;
802	–	FFieldName := strpas(aMetaData.getField(StatusIntf,i));
803	–	Check4DataBaseError;
804	–	FNullable := aMetaData.isNullable(StatusIntf,i);
805	–	Check4DataBaseError;
1137		if FNullable then
1138		begin
1139		FSQLNullIndicator := PShort(FMessageBuffer + aMetaData.getNullOffset(StatusIntf,i));
#	Line 810 | Line 1141 | begin
1141		end
1142		else
1143		FSQLNullIndicator := nil;
1144	<	FScale := aMetaData.getScale(StatusIntf,i);
1145	<	Check4DataBaseError;
815	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
816	<	Check4DataBaseError;
1144	>	FBlob := nil;
1145	>	FArray := nil;
1146		end;
1147		end;
1148		SetUniqueRelationName;
#	Line 829 | 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 846 | 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 906 | 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 937 | 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 953 | 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 970 | Line 1324 | begin
1324		end;
1325		end;
1326
1327	<	procedure TFB30Statement.InternalPrepare;
1327	>	procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1328	>	var GUID : TGUID;
1329		begin
1330		if FPrepared then
1331		Exit;
1332	+
1333	+	FCursor := CursorName;
1334		if (FSQL = '') then
1335		IBError(ibxeEmptyQuery, [nil]);
1336		try
1337		CheckTransaction(FTransactionIntf);
1338	<	with Firebird30ClientAPI do
1338	>	with FFirebird30ClientAPI do
1339		begin
1340	+	if FCursor = '' then
1341	+	begin
1342	+	CreateGuid(GUID);
1343	+	FCursor := GUIDToString(GUID);
1344	+	end;
1345	+
1346		if FHasParamNames then
1347		begin
1348		if FProcessedSQL = '' then
1349	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1349	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1350		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1351		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1352		Length(FProcessedSQL),
#	Line 1002 | Line 1365 | begin
1365		FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1366		Check4DataBaseError;
1367
1368	+	if FSQLStatementType = SQLSelect then
1369	+	begin
1370	+	FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1371	+	Check4DataBaseError;
1372	+	end;
1373		{ Done getting the type }
1374		case FSQLStatementType of
1375		SQLGetSegment,
#	Line 1034 | Line 1402 | begin
1402		if (FStatementIntf <> nil) then
1403		FreeHandle;
1404		if E is EIBInterBaseError then
1405	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1406	<	EIBInterBaseError(E).IBErrorCode,
1039	<	EIBInterBaseError(E).Message +
1040	<	sSQLErrorSeparator + FSQL)
1041	<	else
1042	<	raise;
1405	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1406	>	raise;
1407		end;
1408		end;
1409		FPrepared := true;
1410	+
1411		FSingleResults := false;
1412		if RetainInterfaces then
1413		begin
#	Line 1060 | Line 1425 | begin
1425		end;
1426
1427		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1428	+
1429	+	procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1430	+	begin
1431	+	with FFirebird30ClientAPI do
1432	+	begin
1433	+	SavePerfStats(FBeforeStats);
1434	+	FStatementIntf.execute(StatusIntf,
1435	+	(aTransaction as TFB30Transaction).TransactionIntf,
1436	+	FSQLParams.MetaData,
1437	+	FSQLParams.MessageBuffer,
1438	+	outMetaData,
1439	+	outBuffer);
1440	+	Check4DataBaseError;
1441	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1442	+	end;
1443	+	end;
1444	+
1445	+
1446		begin
1447		Result := nil;
1448	+	FBatchCompletion := nil;
1449		FBOF := false;
1450		FEOF := false;
1451		FSingleResults := false;
1452	+	FStatisticsAvailable := false;
1453	+	if IsInBatchMode then
1454	+	IBerror(ibxeInBatchMode,[]);
1455		CheckTransaction(aTransaction);
1456		if not FPrepared then
1457		InternalPrepare;
1458		CheckHandle;
1459		if aTransaction <> FTransactionIntf then
1460		AddMonitor(aTransaction as TFB30Transaction);
1461	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1461	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1462		IBError(ibxeInterfaceOutofDate,[nil]);
1463
1464	+
1465		try
1466	<	with Firebird30ClientAPI do
1466	>	with FFirebird30ClientAPI do
1467		begin
1080	–	if FCollectStatistics then
1081	–	begin
1082	–	UtilIntf.getPerfCounters(StatusIntf,
1083	–	(GetAttachment as TFB30Attachment).AttachmentIntf,
1084	–	ISQL_COUNTERS,@FBeforeStats);
1085	–	Check4DataBaseError;
1086	–	end;
1087	–
1468		case FSQLStatementType of
1469		SQLSelect:
1470		IBError(ibxeIsAExecuteProcedure,[]);
1471
1472		SQLExecProcedure:
1473		begin
1474	<	FStatementIntf.execute(StatusIntf,
1095	<	(aTransaction as TFB30Transaction).TransactionIntf,
1096	<	FSQLParams.MetaData,
1097	<	FSQLParams.MessageBuffer,
1098	<	FSQLRecord.MetaData,
1099	<	FSQLRecord.MessageBuffer);
1100	<	Check4DataBaseError;
1101	<
1474	>	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1475		Result := TResults.Create(FSQLRecord);
1476		FSingleResults := true;
1104	–	end
1105	–	else
1106	–	FStatementIntf.execute(StatusIntf,
1107	–	(aTransaction as TFB30Transaction).TransactionIntf,
1108	–	FSQLParams.MetaData,
1109	–	FSQLParams.MessageBuffer,
1110	–	nil,
1111	–	nil);
1112	–	Check4DataBaseError;
1477		end;
1478	<	if FCollectStatistics then
1479	<	begin
1480	<	UtilIntf.getPerfCounters(StatusIntf,
1117	<	(GetAttachment as TFB30Attachment).AttachmentIntf,
1118	<	ISQL_COUNTERS, @FAfterStats);
1119	<	Check4DataBaseError;
1120	<	FStatisticsAvailable := true;
1478	>
1479	>	else
1480	>	ExecuteQuery;
1481		end;
1482		end;
1483		finally
#	Line 1125 | Line 1485 | begin
1485		RemoveMonitor(aTransaction as TFB30Transaction);
1486		end;
1487		FExecTransactionIntf := aTransaction;
1488	+	FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1489	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1490		SignalActivity;
1491		Inc(FChangeSeqNo);
1492		end;
1493
1494	<	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1495	<	): IResultSet;
1494	>	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1495	>	Scrollable: boolean): IResultSet;
1496	>	var flags: cardinal;
1497		begin
1498	+	flags := 0;
1499		if FSQLStatementType <> SQLSelect then
1500		IBError(ibxeIsASelectStatement,[]);
1501
1502	<	CheckTransaction(aTransaction);
1502	>	FBatchCompletion := nil;
1503	>	CheckTransaction(aTransaction);
1504		if not FPrepared then
1505		InternalPrepare;
1506		CheckHandle;
1507		if aTransaction <> FTransactionIntf then
1508		AddMonitor(aTransaction as TFB30Transaction);
1509	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1509	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1510		IBError(ibxeInterfaceOutofDate,[nil]);
1511
1512	<	with Firebird30ClientAPI do
1512	>	if Scrollable then
1513	>	flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1514	>
1515	>	with FFirebird30ClientAPI do
1516		begin
1517		if FCollectStatistics then
1518		begin
#	Line 1159 | Line 1527 | begin
1527		FSQLParams.MetaData,
1528		FSQLParams.MessageBuffer,
1529		FSQLRecord.MetaData,
1530	<	0);
1530	>	flags);
1531		Check4DataBaseError;
1532
1533		if FCollectStatistics then
#	Line 1184 | Line 1552 | begin
1552		Inc(FChangeSeqNo);
1553		end;
1554
1555	+	procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1556	+	var processedSQL: AnsiString);
1557	+	begin
1558	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1559	+	end;
1560	+
1561		procedure TFB30Statement.FreeHandle;
1562		begin
1563		Close;
1564		ReleaseInterfaces;
1565	+	if FBatch <> nil then
1566	+	begin
1567	+	FBatch.release;
1568	+	FBatch := nil;
1569	+	end;
1570		if FStatementIntf <> nil then
1571		begin
1572		FStatementIntf.release;
1573		FStatementIntf := nil;
1574		FPrepared := false;
1575		end;
1576	+	FCursor := '';
1577		end;
1578
1579		procedure TFB30Statement.InternalClose(Force: boolean);
1580		begin
1581		if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1582		try
1583	<	with Firebird30ClientAPI do
1583	>	with FFirebird30ClientAPI do
1584		begin
1585		if FResultSet <> nil then
1586		begin
#	Line 1224 | Line 1604 | begin
1604		Inc(FChangeSeqNo);
1605		end;
1606
1607	+	function TFB30Statement.SavePerfStats(var Stats: TPerfStatistics): boolean;
1608	+	begin
1609	+	Result := false;
1610	+	if FCollectStatistics then
1611	+	with FFirebird30ClientAPI do
1612	+	begin
1613	+	UtilIntf.getPerfCounters(StatusIntf,
1614	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1615	+	ISQL_COUNTERS, @Stats);
1616	+	Check4DataBaseError;
1617	+	Result := true;
1618	+	end;
1619	+	end;
1620	+
1621		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1622	<	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1622	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1623	>	CursorName: AnsiString);
1624		begin
1625		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1626	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1627		FSQLParams := TIBXINPUTSQLDA.Create(self);
1628		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1629	<	InternalPrepare;
1629	>	InternalPrepare(CursorName);
1630		end;
1631
1632		constructor TFB30Statement.CreateWithParameterNames(
1633		Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1634	<	aSQLDialect: integer; GenerateParamNames: boolean);
1634	>	aSQLDialect: integer; GenerateParamNames: boolean;
1635	>	CaseSensitiveParams: boolean; CursorName: AnsiString);
1636		begin
1637		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1638	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1639		FSQLParams := TIBXINPUTSQLDA.Create(self);
1640	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1641		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1642	<	InternalPrepare;
1642	>	InternalPrepare(CursorName);
1643		end;
1644
1645		destructor TFB30Statement.Destroy;
#	Line 1250 | Line 1649 | begin
1649		if assigned(FSQLRecord) then FSQLRecord.Free;
1650		end;
1651
1652	<	function TFB30Statement.FetchNext: boolean;
1652	>	function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1653	>	): boolean;
1654		var fetchResult: integer;
1655		begin
1656		result := false;
1657		if not FOpen then
1658		IBError(ibxeSQLClosed, [nil]);
1259	–	if FEOF then
1260	–	IBError(ibxeEOF,[nil]);
1659
1660	<	with Firebird30ClientAPI do
1660	>	with FFirebird30ClientAPI do
1661		begin
1662	<	{ Go to the next record... }
1663	<	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1664	<	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1665	<	begin
1666	<	FBOF := false;
1667	<	FEOF := true;
1668	<	Exit; {End of File}
1669	<	end
1670	<	else
1671	<	if fetchResult <> Firebird.IStatus.RESULT_OK then
1672	<	begin
1673	<	try
1674	<	IBDataBaseError;
1277	<	except
1278	<	Close;
1279	<	raise;
1662	>	case FetchType of
1663	>	ftNext:
1664	>	begin
1665	>	if FEOF then
1666	>	IBError(ibxeEOF,[nil]);
1667	>	{ Go to the next record... }
1668	>	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1669	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1670	>	begin
1671	>	FBOF := false;
1672	>	FEOF := true;
1673	>	Exit; {End of File}
1674	>	end
1675		end;
1676	<	end
1677	<	else
1676	>
1677	>	ftPrior:
1678	>	begin
1679	>	if FBOF then
1680	>	IBError(ibxeBOF,[nil]);
1681	>	{ Go to the next record... }
1682	>	fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1683	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1684	>	begin
1685	>	FBOF := true;
1686	>	FEOF := false;
1687	>	Exit; {Top of File}
1688	>	end
1689	>	end;
1690	>
1691	>	ftFirst:
1692	>	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1693	>
1694	>	ftLast:
1695	>	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1696	>
1697	>	ftAbsolute:
1698	>	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1699	>
1700	>	ftRelative:
1701	>	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1702	>	end;
1703	>
1704	>	Check4DataBaseError;
1705	>	if fetchResult <> Firebird.IStatus.RESULT_OK then
1706	>	exit; {result = false}
1707	>
1708	>	{Result OK}
1709	>	FBOF := false;
1710	>	FEOF := false;
1711	>	result := true;
1712	>
1713	>	if FCollectStatistics then
1714		begin
1715	<	FBOF := false;
1716	<	result := true;
1715	>	UtilIntf.getPerfCounters(StatusIntf,
1716	>	(GetAttachment as TFB30Attachment).AttachmentIntf,
1717	>	ISQL_COUNTERS,@FAfterStats);
1718	>	Check4DataBaseError;
1719	>	FStatisticsAvailable := true;
1720		end;
1721		end;
1722		FSQLRecord.RowChange;
#	Line 1315 | Line 1749 | begin
1749		SQLUpdate, SQLDelete])) then
1750		result := ''
1751		else
1752	<	with Firebird30ClientAPI do
1752	>	with FFirebird30ClientAPI do
1753		begin
1754		Result := FStatementIntf.getPlan(StatusIntf,true);
1755		Check4DataBaseError;
#	Line 1349 | Line 1783 | begin
1783		TSQLParams(GetInterface(0)).RetainInterfaces := aValue;
1784		end;
1785
1786	+	function TFB30Statement.IsInBatchMode: boolean;
1787	+	begin
1788	+	Result := FBatch <> nil;
1789	+	end;
1790	+
1791	+	function TFB30Statement.HasBatchMode: boolean;
1792	+	begin
1793	+	Result := GetAttachment.HasBatchMode;
1794	+	end;
1795	+
1796	+	procedure TFB30Statement.AddToBatch;
1797	+	var BatchPB: TXPBParameterBlock;
1798	+
1799	+	const SixteenMB = 16 * 1024 * 1024;
1800	+	begin
1801	+	FBatchCompletion := nil;
1802	+	if not FPrepared then
1803	+	InternalPrepare;
1804	+	CheckHandle;
1805	+	CheckBatchModeAvailable;
1806	+	with FFirebird30ClientAPI do
1807	+	begin
1808	+	if FBatch = nil then
1809	+	begin
1810	+	{Start Batch}
1811	+	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1812	+	with FFirebird30ClientAPI do
1813	+	try
1814	+	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1815	+	Check4DatabaseError;
1816	+	if FBatchBufferSize < SixteenMB then
1817	+	FBatchBufferSize := SixteenMB;
1818	+	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1819	+	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1820	+
1821	+	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1822	+	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1823	+	FBatch := FStatementIntf.createBatch(StatusIntf,
1824	+	FSQLParams.MetaData,
1825	+	BatchPB.getDataLength,
1826	+	BatchPB.getBuffer);
1827	+	Check4DataBaseError;
1828	+
1829	+	finally
1830	+	BatchPB.Free;
1831	+	end;
1832	+	FBatchRowCount := 0;
1833	+	FBatchBufferUsed := 0;
1834	+	end;
1835	+
1836	+	Inc(FBatchRowCount);
1837	+	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1838	+	Check4DataBaseError;
1839	+	if FBatchBufferUsed > FBatchBufferSize then
1840	+	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1841	+	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1842	+	[FBatchRowCount,FBatchBufferSize]));
1843	+
1844	+	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1845	+	Check4DataBaseError
1846	+	end;
1847	+	end;
1848	+
1849	+	function TFB30Statement.ExecuteBatch(aTransaction: ITransaction
1850	+	): IBatchCompletion;
1851	+
1852	+	procedure Check4BatchCompletionError(bc: IBatchCompletion);
1853	+	var status: IStatus;
1854	+	RowNo: integer;
1855	+	begin
1856	+	status := nil;
1857	+	{Raise an exception if there was an error reported in the BatchCompletion}
1858	+	if (bc <> nil) and bc.getErrorStatus(RowNo,status) then
1859	+	raise EIBInterbaseError.Create(status);
1860	+	end;
1861	+
1862	+	var cs: Firebird.IBatchCompletionState;
1863	+
1864	+	begin
1865	+	Result := nil;
1866	+	if FBatch = nil then
1867	+	IBError(ibxeNotInBatchMode,[]);
1868	+
1869	+	with FFirebird30ClientAPI do
1870	+	begin
1871	+	SavePerfStats(FBeforeStats);
1872	+	if aTransaction = nil then
1873	+	cs := FBatch.execute(StatusIntf,(FTransactionIntf as TFB30Transaction).TransactionIntf)
1874	+	else
1875	+	cs := FBatch.execute(StatusIntf,(aTransaction as TFB30Transaction).TransactionIntf);
1876	+	Check4DataBaseError;
1877	+	FBatchCompletion := TBatchCompletion.Create(FFirebird30ClientAPI,cs);
1878	+	FStatisticsAvailable := SavePerfStats(FAfterStats);
1879	+	FBatch.release;
1880	+	FBatch := nil;
1881	+	Check4BatchCompletionError(FBatchCompletion);
1882	+	Result := FBatchCompletion;
1883	+	end;
1884	+	end;
1885	+
1886	+	procedure TFB30Statement.CancelBatch;
1887	+	begin
1888	+	if FBatch = nil then
1889	+	IBError(ibxeNotInBatchMode,[]);
1890	+	FBatch.release;
1891	+	FBatch := nil;
1892	+	end;
1893	+
1894	+	function TFB30Statement.GetBatchCompletion: IBatchCompletion;
1895	+	begin
1896	+	Result := FBatchCompletion;
1897	+	end;
1898	+
1899		function TFB30Statement.IsPrepared: boolean;
1900		begin
1901		Result := FStatementIntf <> nil;

Diff Legend

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