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 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 371 by tony, Wed Jan 5 15:21:22 2022 UTC

#	Line 88 | Line 88 | type
88		FStatement: TFB30Statement;
89		FFirebird30ClientAPI: TFB30ClientAPI;
90		FBlob: IBlob;             {Cache references}
91	–	FArray: IArray;
91		FNullIndicator: short;
92		FOwnsSQLData: boolean;
93		FBlobMetaData: IBlobMetaData;
#	Line 99 | Line 98 | type
98		FSQLSubType: integer;
99		FSQLData: PByte; {Address of SQL Data in Message Buffer}
100		FSQLNullIndicator: PShort; {Address of null indicator}
101	<	FDataLength: integer;
102	<	FMetadataSize: integer;
101	>	FDataLength: cardinal;
102	>	FMetadataSize: cardinal;
103		FNullable: boolean;
104		FScale: integer;
105		FCharSetID: cardinal;
#	Line 117 | Line 116 | type
116		function GetRelationName: AnsiString;  override;
117		function GetScale: integer; override;
118		function GetCharSetID: cardinal; override;
120	–	function GetCodePage: TSystemCodePage; override;
121	–	function GetCharSetWidth: integer; override;
119		function GetIsNull: Boolean;   override;
120		function GetIsNullable: boolean; override;
121		function GetSQLData: PByte;  override;
122		function GetDataLength: cardinal; override;
123		function GetSize: cardinal; override;
127	–	function GetAttachment: IAttachment; override;
124		function GetDefaultTextSQLType: cardinal; override;
125		procedure SetIsNull(Value: Boolean); override;
126		procedure SetIsNullable(Value: Boolean);  override;
127	<	procedure SetSQLData(AValue: PByte; len: cardinal); override;
128	<	procedure SetScale(aValue: integer); override;
129	<	procedure SetDataLength(len: cardinal); override;
134	<	procedure SetSQLType(aValue: cardinal); override;
127	>	procedure InternalSetScale(aValue: integer); override;
128	>	procedure InternalSetDataLength(len: cardinal); override;
129	>	procedure InternalSetSQLType(aValue: cardinal); override;
130		procedure SetCharSetID(aValue: cardinal); override;
131		procedure SetMetaSize(aValue: cardinal); override;
132		public
133		constructor Create(aParent: TIBXSQLDA; aIndex: integer);
134		procedure Changed; override;
135	+	procedure InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
136		procedure ColumnSQLDataInit;
137		procedure RowChange; override;
138		procedure FreeSQLData;
139	<	function GetAsArray(Array_ID: TISC_QUAD): IArray; override;
139	>	function GetAsArray: IArray; override;
140		function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; override;
141		function GetArrayMetaData: IArrayMetaData; override;
142		function GetBlobMetaData: IBlobMetaData; override;
143		function CreateBlob: IBlob; override;
144	+	procedure SetSQLData(AValue: PByte; len: cardinal); override;
145		end;
146
147		{ TIBXSQLDA }
#	Line 158 | Line 155 | type
155		protected
156		FStatement: TFB30Statement;
157		FFirebird30ClientAPI: TFB30ClientAPI;
158	+	FMessageBuffer: PByte; {Message Buffer}
159	+	FMsgLength: integer; {Message Buffer length}
160		function GetTransactionSeqNo: integer; override;
161		procedure FreeXSQLDA; virtual;
162		function GetStatement: IStatement; override;
163		function GetPrepareSeqNo: integer; override;
164		procedure SetCount(Value: Integer); override;
165	+	procedure AllocMessageBuffer(len: integer); virtual;
166	+	procedure FreeMessageBuffer; virtual;
167		public
168	<	constructor Create(aStatement: TFB30Statement);
168	>	constructor Create(aStatement: TFB30Statement); overload;
169	>	constructor Create(api: IFirebirdAPI); overload;
170		destructor Destroy; override;
171		procedure Changed; virtual;
172		function CheckStatementStatus(Request: TStatementStatus): boolean; override;
173		function ColumnsInUseCount: integer; override;
174	<	function GetTransaction: TFB30Transaction; virtual;
174	>	function GetMetaData: Firebird.IMessageMetadata; virtual;
175		procedure Initialize; override;
176		function StateChanged(var ChangeSeqNo: integer): boolean; override;
177		function CanChangeMetaData: boolean; override;
176	–	property MetaData: Firebird.IMessageMetadata read FMetaData;
178		property Count: Integer read FCount write SetCount;
179		property Statement: TFB30Statement read FStatement;
180		end;
#	Line 182 | Line 183 | type
183
184		TIBXINPUTSQLDA = class(TIBXSQLDA)
185		private
185	–	FMessageBuffer: PByte; {Message Buffer}
186	–	FMsgLength: integer; {Message Buffer length}
186		FCurMetaData: Firebird.IMessageMetadata;
188	–	procedure FreeMessageBuffer;
187		procedure FreeCurMetaData;
188		function GetMessageBuffer: PByte;
191	–	function GetMetaData: Firebird.IMessageMetadata;
189		function GetModified: Boolean;
190		function GetMsgLength: integer;
191		procedure BuildMetadata;
195	–	procedure PackBuffer;
192		protected
193	+	procedure PackBuffer;
194		procedure FreeXSQLDA; override;
195		public
196	<	constructor Create(aStatement: TFB30Statement);
196	>	constructor Create(aStatement: TFB30Statement); overload;
197	>	constructor Create(api: IFirebirdAPI); overload;
198		destructor Destroy; override;
199		procedure Bind(aMetaData: Firebird.IMessageMetadata);
200		procedure Changed; override;
201	+	function GetMetaData: Firebird.IMessageMetadata; override;
202		procedure ReInitialise;
203		function IsInputDataArea: boolean; override;
205	–	property MetaData: Firebird.IMessageMetadata read GetMetaData;
204		property MessageBuffer: PByte read GetMessageBuffer;
205		property MsgLength: integer read GetMsgLength;
206		end;
#	Line 212 | Line 210 | type
210		TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211		private
212		FTransaction: TFB30Transaction; {transaction used to execute the statement}
215	–	FMessageBuffer: PByte; {Message Buffer}
216	–	FMsgLength: integer; {Message Buffer length}
213		protected
214	<	procedure FreeXSQLDA; override;
214	>	function GetTransaction: ITransaction; override;
215		public
216		procedure Bind(aMetaData: Firebird.IMessageMetadata);
217		procedure GetData(index: integer; var aIsNull: boolean; var len: short;
#	Line 231 | Line 227 | type
227		private
228		FResults: TIBXOUTPUTSQLDA;
229		FCursorSeqNo: integer;
230	+	procedure RowChange;
231		public
232		constructor Create(aResults: TIBXOUTPUTSQLDA);
233		destructor Destroy; override;
234		{IResultSet}
235	<	function FetchNext: boolean;
235	>	function FetchNext: boolean; {fetch next record}
236	>	function FetchPrior: boolean; {fetch previous record}
237	>	function FetchFirst:boolean; {fetch first record}
238	>	function FetchLast: boolean; {fetch last record}
239	>	function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
240	>	function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
241		function GetCursorName: AnsiString;
242	<	function GetTransaction: ITransaction; override;
242	>	function IsBof: boolean;
243		function IsEof: boolean;
244		procedure Close;
245		end;
#	Line 259 | Line 261 | type
261		function getUpdated: integer;
262		end;
263
264	+	TFetchType = (ftNext,ftPrior,ftFirst,ftLast,ftAbsolute,ftRelative);
265	+
266		{ TFB30Statement }
267
268		TFB30Statement = class(TFBStatement,IStatement)
#	Line 269 | Line 273 | type
273		FSQLRecord: TIBXOUTPUTSQLDA;
274		FResultSet: Firebird.IResultSet;
275		FCursorSeqNo: integer;
276	+	FCursor: AnsiString;
277		FBatch: Firebird.IBatch;
278		FBatchCompletion: IBatchCompletion;
279		FBatchRowCount: integer;
#	Line 279 | Line 284 | type
284		procedure CheckHandle; override;
285		procedure CheckBatchModeAvailable;
286		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
287	<	procedure InternalPrepare; override;
287	>	function GetStatementIntf: IStatement; override;
288	>	procedure InternalPrepare(CursorName: AnsiString=''); override;
289		function InternalExecute(aTransaction: ITransaction): IResults; override;
290	<	function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
290	>	function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
291	>	): IResultSet; override;
292		procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
293		procedure FreeHandle; override;
294		procedure InternalClose(Force: boolean); override;
295		function SavePerfStats(var Stats: TPerfStatistics): boolean;
296		public
297		constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
298	<	sql: AnsiString; aSQLDialect: integer);
298	>	sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString='');
299		constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
300		sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
301	<	CaseSensitiveParams: boolean=false);
301	>	CaseSensitiveParams: boolean=false; CursorName: AnsiString='');
302		destructor Destroy; override;
303	<	function FetchNext: boolean;
303	>	function Fetch(FetchType: TFetchType; PosOrOffset: integer=0): boolean;
304		property StatementIntf: Firebird.IStatement read FStatementIntf;
305	+	property SQLParams: TIBXINPUTSQLDA read FSQLParams;
306	+	property SQLRecord: TIBXOUTPUTSQLDA read FSQLRecord;
307
308		public
309		{IStatement}
#	Line 302 | Line 311 | type
311		function GetMetaData: IMetaData; override;
312		function GetPlan: AnsiString;
313		function IsPrepared: boolean;
314	+	function GetFlags: TStatementFlags; override;
315		function CreateBlob(column: TColumnMetaData): IBlob; override;
316		function CreateArray(column: TColumnMetaData): IArray; override;
317		procedure SetRetainInterfaces(aValue: boolean); override;
#	Line 418 | Line 428 | begin
428		status := MasterIntf.getStatus;
429		FCompletionState.getStatus(StatusIntf,status,updateNo);
430		Check4DataBaseError;
431	<	Result := FormatFBStatus(status);
431	>	Result := FormatStatus(status);
432		end;
433		end;
434
#	Line 450 | Line 460 | begin
460		TIBXSQLDA(Parent).Changed;
461		end;
462
463	+	procedure TIBXSQLVAR.InitColumnMetaData(aMetaData: Firebird.IMessageMetadata);
464	+	begin
465	+	with FFirebird30ClientAPI do
466	+	begin
467	+	FSQLType := aMetaData.getType(StatusIntf,Index);
468	+	Check4DataBaseError;
469	+	if FSQLType = SQL_BLOB then
470	+	begin
471	+	FSQLSubType := aMetaData.getSubType(StatusIntf,Index);
472	+	Check4DataBaseError;
473	+	end
474	+	else
475	+	FSQLSubType := 0;
476	+	FDataLength := aMetaData.getLength(StatusIntf,Index);
477	+	Check4DataBaseError;
478	+	FMetadataSize := FDataLength;
479	+	FRelationName := strpas(aMetaData.getRelation(StatusIntf,Index));
480	+	Check4DataBaseError;
481	+	FFieldName := strpas(aMetaData.getField(StatusIntf,Index));
482	+	Check4DataBaseError;
483	+	FNullable := aMetaData.isNullable(StatusIntf,Index);
484	+	Check4DataBaseError;
485	+	FScale := aMetaData.getScale(StatusIntf,Index);
486	+	Check4DataBaseError;
487	+	FCharSetID :=  aMetaData.getCharSet(StatusIntf,Index) and $FF;
488	+	Check4DataBaseError;
489	+	end;
490	+	end;
491	+
492		procedure TIBXSQLVAR.ColumnSQLDataInit;
493		begin
494		FreeSQLData;
#	Line 495 | Line 534 | begin
534		end;
535
536		function TIBXSQLVAR.GetAliasName: AnsiString;
537	+	var metadata: Firebird.IMessageMetadata;
538		begin
539	<	with FFirebird30ClientAPI do
540	<	begin
541	<	result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
542	<	Check4DataBaseError;
539	>	metadata := TIBXSQLDA(Parent).GetMetaData;
540	>	try
541	>	with FFirebird30ClientAPI do
542	>	begin
543	>	result := strpas(metaData.getAlias(StatusIntf,Index));
544	>	Check4DataBaseError;
545	>	end;
546	>	finally
547	>	metadata.release;
548		end;
549		end;
550
#	Line 509 | Line 554 | begin
554		end;
555
556		function TIBXSQLVAR.GetOwnerName: AnsiString;
557	+	var metadata: Firebird.IMessageMetadata;
558		begin
559	<	with FFirebird30ClientAPI do
560	<	begin
561	<	result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
562	<	Check4DataBaseError;
559	>	metadata := TIBXSQLDA(Parent).GetMetaData;
560	>	try
561	>	with FFirebird30ClientAPI do
562	>	begin
563	>	result := strpas(metaData.getOwner(StatusIntf,Index));
564	>	Check4DataBaseError;
565	>	end;
566	>	finally
567	>	metadata.release;
568		end;
569		end;
570
#	Line 548 | Line 599 | begin
599		end;
600		end;
601
551	–	function TIBXSQLVAR.GetCodePage: TSystemCodePage;
552	–	begin
553	–	result := CP_NONE;
554	–	with Statement.GetAttachment do
555	–	CharSetID2CodePage(GetCharSetID,result);
556	–	end;
557	–
558	–	function TIBXSQLVAR.GetCharSetWidth: integer;
559	–	begin
560	–	result := 1;
561	–	with Statement.GetAttachment DO
562	–	CharSetWidth(GetCharSetID,result);
563	–	end;
564	–
602		function TIBXSQLVAR.GetIsNull: Boolean;
603		begin
604		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 587 | Line 624 | begin
624		Result := FMetadataSize;
625		end;
626
590	–	function TIBXSQLVAR.GetAttachment: IAttachment;
591	–	begin
592	–	Result := FStatement.GetAttachment;
593	–	end;
594	–
627		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
628		begin
629		if GetSQLType <> SQL_ARRAY then
630		IBError(ibxeInvalidDataConversion,[nil]);
631
632		if FArrayMetaData = nil then
633	<	FArrayMetaData := TFB30ArrayMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
634	<	FStatement.GetTransaction as TFB30Transaction,
633	>	FArrayMetaData := TFB30ArrayMetaData.Create(GetAttachment as TFB30Attachment,
634	>	GetTransaction as TFB30Transaction,
635		GetRelationName,GetFieldName);
636		Result := FArrayMetaData;
637		end;
#	Line 610 | Line 642 | begin
642		IBError(ibxeInvalidDataConversion,[nil]);
643
644		if FBlobMetaData = nil then
645	<	FBlobMetaData := TFB30BlobMetaData.Create(FStatement.GetAttachment as TFB30Attachment,
646	<	FStatement.GetTransaction as TFB30Transaction,
645	>	FBlobMetaData := TFB30BlobMetaData.Create(GetAttachment as TFB30Attachment,
646	>	GetTransaction as TFB30Transaction,
647		GetRelationName,GetFieldName,
648		GetSubType);
649		(FBlobMetaData as TFBBlobMetaData).SetCharSetID(GetCharSetID);
#	Line 654 | Line 686 | begin
686		Changed;
687		end;
688
689	<	procedure TIBXSQLVAR.SetScale(aValue: integer);
689	>	procedure TIBXSQLVAR.InternalSetScale(aValue: integer);
690		begin
691		FScale := aValue;
692		Changed;
693		end;
694
695	<	procedure TIBXSQLVAR.SetDataLength(len: cardinal);
695	>	procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal);
696		begin
697		if not FOwnsSQLData then
698		FSQLData := nil;
#	Line 671 | Line 703 | begin
703		Changed;
704		end;
705
706	<	procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706	>	procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707		begin
676	–	if (FSQLType <> aValue) and not CanChangeSQLType then
677	–	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
708		FSQLType := aValue;
709		Changed;
710		end;
#	Line 708 | Line 738 | procedure TIBXSQLVAR.RowChange;
738		begin
739		inherited;
740		FBlob := nil;
711	–	FArray := nil;
741		end;
742
743		procedure TIBXSQLVAR.FreeSQLData;
#	Line 719 | Line 748 | begin
748		FOwnsSQLData := true;
749		end;
750
751	<	function TIBXSQLVAR.GetAsArray(Array_ID: TISC_QUAD): IArray;
751	>	function TIBXSQLVAR.GetAsArray: IArray;
752		begin
753		if SQLType <> SQL_ARRAY then
754		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 728 | Line 757 | begin
757		Result := nil
758		else
759		begin
760	<	if FArray = nil then
761	<	FArray := TFB30Array.Create(FStatement.GetAttachment as TFB30Attachment,
762	<	TIBXSQLDA(Parent).GetTransaction,
763	<	GetArrayMetaData,Array_ID);
764	<	Result := FArray;
760	>	if FArrayIntf = nil then
761	>	FArrayIntf := TFB30Array.Create(GetAttachment as TFB30Attachment,
762	>	GetTransaction as TFB30Transaction,
763	>	GetArrayMetaData,PISC_QUAD(SQLData)^);
764	>	Result := FArrayIntf;
765		end;
766		end;
767
#	Line 747 | Line 776 | begin
776		if IsNull then
777		Result := nil
778		else
779	<	Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
780	<	TIBXSQLDA(Parent).GetTransaction,
779	>	Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
780	>	GetTransaction as TFB30Transaction,
781		GetBlobMetaData,
782		Blob_ID,BPB);
783		FBlob := Result;
#	Line 757 | Line 786 | end;
786
787		function TIBXSQLVAR.CreateBlob: IBlob;
788		begin
789	<	Result := TFB30Blob.Create(FStatement.GetAttachment as TFB30Attachment,
790	<	FStatement.GetTransaction as TFB30Transaction,
789	>	Result := TFB30Blob.Create(GetAttachment as TFB30Attachment,
790	>	GetTransaction as TFB30Transaction,
791		GetSubType,GetCharSetID,nil);
792		end;
793
794		{ TResultSet }
795
796	+	procedure TResultSet.RowChange;
797	+	var i: integer;
798	+	begin
799	+	for i := 0 to getCount - 1 do
800	+	FResults.Column[i].RowChange;
801	+	end;
802	+
803		constructor TResultSet.Create(aResults: TIBXOUTPUTSQLDA);
804		begin
805		inherited Create(aResults);
#	Line 778 | Line 814 | begin
814		end;
815
816		function TResultSet.FetchNext: boolean;
781	–	var i: integer;
817		begin
818		CheckActive;
819	<	Result := FResults.FStatement.FetchNext;
819	>	Result := FResults.FStatement.Fetch(ftNext);
820	>	if Result then
821	>	RowChange;
822	>	end;
823	>
824	>	function TResultSet.FetchPrior: boolean;
825	>	begin
826	>	CheckActive;
827	>	Result := FResults.FStatement.Fetch(ftPrior);
828	>	if Result then
829	>	RowChange;
830	>	end;
831	>
832	>	function TResultSet.FetchFirst: boolean;
833	>	begin
834	>	CheckActive;
835	>	Result := FResults.FStatement.Fetch(ftFirst);
836	>	if Result then
837	>	RowChange;
838	>	end;
839	>
840	>	function TResultSet.FetchLast: boolean;
841	>	begin
842	>	CheckActive;
843	>	Result := FResults.FStatement.Fetch(ftLast);
844	>	if Result then
845	>	RowChange;
846	>	end;
847	>
848	>	function TResultSet.FetchAbsolute(position: Integer): boolean;
849	>	begin
850	>	CheckActive;
851	>	Result := FResults.FStatement.Fetch(ftAbsolute,position);
852		if Result then
853	<	for i := 0 to getCount - 1 do
854	<	FResults.Column[i].RowChange;
853	>	RowChange;
854	>	end;
855	>
856	>	function TResultSet.FetchRelative(offset: Integer): boolean;
857	>	begin
858	>	CheckActive;
859	>	Result := FResults.FStatement.Fetch(ftRelative,offset);
860	>	if Result then
861	>	RowChange;
862		end;
863
864		function TResultSet.GetCursorName: AnsiString;
865		begin
866	<	IBError(ibxeNotSupported,[nil]);
793	<	Result := '';
866	>	Result := FResults.FStatement.FCursor;
867		end;
868
869	<	function TResultSet.GetTransaction: ITransaction;
869	>	function TResultSet.IsBof: boolean;
870		begin
871	<	Result := FResults.FTransaction;
871	>	Result := FResults.FStatement.FBof;
872		end;
873
874		function TResultSet.IsEof: boolean;
#	Line 824 | Line 897 | begin
897		end;
898		end;
899
827	–	procedure TIBXINPUTSQLDA.FreeMessageBuffer;
828	–	begin
829	–	if FMessageBuffer <> nil then
830	–	begin
831	–	FreeMem(FMessageBuffer);
832	–	FMessageBuffer := nil;
833	–	end;
834	–	FMsgLength := 0;
835	–	end;
836	–
900		procedure TIBXINPUTSQLDA.FreeCurMetaData;
901		begin
902		if FCurMetaData <> nil then
#	Line 853 | Line 916 | function TIBXINPUTSQLDA.GetMetaData: Fir
916		begin
917		BuildMetadata;
918		Result := FCurMetaData;
919	+	if Result <> nil then
920	+	Result.addRef;
921		end;
922
923		function TIBXINPUTSQLDA.GetMsgLength: integer;
#	Line 864 | Line 929 | end;
929		procedure TIBXINPUTSQLDA.BuildMetadata;
930		var Builder: Firebird.IMetadataBuilder;
931		i: integer;
932	+	version: NativeInt;
933		begin
934		if (FCurMetaData = nil) and (Count > 0) then
935		with FFirebird30ClientAPI do
#	Line 874 | Line 940 | begin
940		for i := 0 to Count - 1 do
941		with TIBXSQLVar(Column[i]) do
942		begin
943	<	Builder.setType(StatusIntf,i,FSQLType+1);
943	>	version := Builder.vtable.version;
944	>	if version >= 4 then
945	>	{Firebird 4 or later}
946	>	begin
947	>	Builder.setField(StatusIntf,i,PAnsiChar(Name));
948	>	Check4DataBaseError;
949	>	Builder.setAlias(StatusIntf,i,PAnsiChar(Name));
950	>	Check4DataBaseError;
951	>	end;
952	>	Builder.setType(StatusIntf,i,FSQLType);
953		Check4DataBaseError;
954		Builder.setSubType(StatusIntf,i,FSQLSubType);
955		Check4DataBaseError;
#	Line 906 | Line 981 | end;
981		procedure TIBXINPUTSQLDA.PackBuffer;
982		var i: integer;
983		P: PByte;
984	+	MsgLen: cardinal;
985		begin
986		BuildMetadata;
987
988		if (FMsgLength = 0) and (FCurMetaData <> nil) then
989		with FFirebird30ClientAPI do
990		begin
991	<	FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
991	>	MsgLen := FCurMetaData.getMessageLength(StatusIntf);
992		Check4DataBaseError;
993
994	<	IBAlloc(FMessageBuffer,0,FMsgLength);
994	>	AllocMessageBuffer(MsgLen);
995
996		for i := 0 to Count - 1 do
997		with TIBXSQLVar(Column[i]) do
#	Line 955 | Line 1031 | procedure TIBXINPUTSQLDA.FreeXSQLDA;
1031		begin
1032		inherited FreeXSQLDA;
1033		FreeCurMetaData;
958	–	FreeMessageBuffer;
1034		end;
1035
1036		constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
#	Line 964 | Line 1039 | begin
1039		FMessageBuffer := nil;
1040		end;
1041
1042	+	constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI);
1043	+	begin
1044	+	inherited Create(api);
1045	+	FMessageBuffer := nil;
1046	+	end;
1047	+
1048		destructor TIBXINPUTSQLDA.Destroy;
1049		begin
1050		FreeXSQLDA;
#	Line 974 | Line 1055 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1055		var i: integer;
1056		begin
1057		FMetaData := aMetaData;
1058	+	FMetaData.AddRef;
1059		with FFirebird30ClientAPI do
1060		begin
1061		Count := aMetadata.getCount(StatusIntf);
#	Line 983 | Line 1065 | begin
1065		for i := 0 to Count - 1 do
1066		with TIBXSQLVar(Column[i]) do
1067		begin
1068	<	FSQLType := aMetaData.getType(StatusIntf,i);
1069	<	Check4DataBaseError;
988	<	if FSQLType = SQL_BLOB then
989	<	begin
990	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
991	<	Check4DataBaseError;
992	<	end
993	<	else
994	<	FSQLSubType := 0;
995	<	FDataLength := aMetaData.getLength(StatusIntf,i);
996	<	Check4DataBaseError;
997	<	FMetadataSize := FDataLength;
998	<	FNullable := aMetaData.isNullable(StatusIntf,i);
999	<	Check4DataBaseError;
1068	>	InitColumnMetaData(aMetaData);
1069	>	SaveMetaData;
1070		if FNullable then
1071		FSQLNullIndicator := @FNullIndicator
1072		else
1073		FSQLNullIndicator := nil;
1004	–	FScale := aMetaData.getScale(StatusIntf,i);
1005	–	Check4DataBaseError;
1006	–	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
1007	–	Check4DataBaseError;
1074		ColumnSQLDataInit;
1075		end;
1076		end;
#	Line 1032 | Line 1098 | end;
1098
1099		{ TIBXOUTPUTSQLDA }
1100
1101	<	procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
1101	>	function TIBXOUTPUTSQLDA.GetTransaction: ITransaction;
1102		begin
1103	<	inherited FreeXSQLDA;
1104	<	FreeMem(FMessageBuffer);
1105	<	FMessageBuffer := nil;
1106	<	FMsgLength := 0;
1103	>	if FTransaction <> nil then
1104	>	Result := FTransaction
1105	>	else
1106	>	Result := inherited GetTransaction;
1107		end;
1108
1109		procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
1110		var i: integer;
1111	+	MsgLen: cardinal;
1112		begin
1113		FMetaData := aMetaData;
1114	+	FMetaData.AddRef;
1115		with FFirebird30ClientAPI do
1116		begin
1117	<	Count := metadata.getCount(StatusIntf);
1117	>	Count := aMetaData.getCount(StatusIntf);
1118		Check4DataBaseError;
1119		Initialize;
1120
1121	<	FMsgLength := metaData.getMessageLength(StatusIntf);
1121	>	MsgLen := aMetaData.getMessageLength(StatusIntf);
1122		Check4DataBaseError;
1123	<	IBAlloc(FMessageBuffer,0,FMsgLength);
1123	>	AllocMessageBuffer(MsgLen);
1124
1125		for i := 0 to Count - 1 do
1126		with TIBXSQLVar(Column[i]) do
1127		begin
1128	<	FSQLType := aMetaData.getType(StatusIntf,i);
1129	<	Check4DataBaseError;
1062	<	if FSQLType = SQL_BLOB then
1063	<	begin
1064	<	FSQLSubType := aMetaData.getSubType(StatusIntf,i);
1065	<	Check4DataBaseError;
1066	<	end
1067	<	else
1068	<	FSQLSubType := 0;
1069	<	FBlob := nil;
1070	<	FArray := nil;
1071	<	FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1072	<	Check4DataBaseError;
1073	<	FDataLength := aMetaData.getLength(StatusIntf,i);
1074	<	Check4DataBaseError;
1075	<	FMetadataSize := FDataLength;
1076	<	FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
1077	<	Check4DataBaseError;
1078	<	FFieldName := strpas(aMetaData.getField(StatusIntf,i));
1079	<	Check4DataBaseError;
1080	<	FNullable := aMetaData.isNullable(StatusIntf,i);
1128	>	InitColumnMetaData(aMetaData);
1129	>	FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1130		Check4DataBaseError;
1131		if FNullable then
1132		begin
#	Line 1086 | Line 1135 | begin
1135		end
1136		else
1137		FSQLNullIndicator := nil;
1138	<	FScale := aMetaData.getScale(StatusIntf,i);
1139	<	Check4DataBaseError;
1091	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
1092	<	Check4DataBaseError;
1138	>	FBlob := nil;
1139	>	FArrayIntf := nil;
1140		end;
1141		end;
1142		SetUniqueRelationName;
#	Line 1127 | Line 1174 | begin
1174		//  writeln('Creating ',ClassName);
1175		end;
1176
1177	+	constructor TIBXSQLDA.Create(api: IFirebirdAPI);
1178	+	begin
1179	+	inherited Create;
1180	+	FStatement := nil;
1181	+	FSize := 0;
1182	+	FFirebird30ClientAPI := api as TFB30ClientAPI;
1183	+	end;
1184	+
1185		destructor TIBXSQLDA.Destroy;
1186		begin
1187		FreeXSQLDA;
#	Line 1142 | Line 1197 | end;
1197		function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
1198		begin
1199		Result := false;
1200	+	if FStatement <> nil then
1201		case Request of
1202		ssPrepared:
1203		Result := FStatement.IsPrepared;
1204
1205		ssExecuteResults:
1206	<	Result :=FStatement.FSingleResults;
1206	>	Result := FStatement.FSingleResults;
1207
1208		ssCursorOpen:
1209		Result := FStatement.FOpen;
#	Line 1165 | Line 1221 | begin
1221		Result := FCount;
1222		end;
1223
1168	–	function TIBXSQLDA.GetTransaction: TFB30Transaction;
1169	–	begin
1170	–	Result := FStatement.GetTransaction as TFB30Transaction;
1171	–	end;
1172	–
1224		procedure TIBXSQLDA.Initialize;
1225		begin
1226		if FMetaData <> nil then
#	Line 1178 | Line 1229 | end;
1229
1230		function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
1231		begin
1232	<	Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
1232	>	Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo);
1233		if Result then
1234		ChangeSeqNo := FStatement.ChangeSeqNo;
1235		end;
#	Line 1204 | Line 1255 | begin
1255		end;
1256		end;
1257
1258	+	procedure TIBXSQLDA.AllocMessageBuffer(len: integer);
1259	+	begin
1260	+	with FFirebird30ClientAPI do
1261	+	IBAlloc(FMessageBuffer,0,len);
1262	+	FMsgLength := len;
1263	+	end;
1264	+
1265	+	procedure TIBXSQLDA.FreeMessageBuffer;
1266	+	begin
1267	+	if FMessageBuffer <> nil then
1268	+	begin
1269	+	FreeMem(FMessageBuffer);
1270	+	FMessageBuffer := nil;
1271	+	end;
1272	+	FMsgLength := 0;
1273	+	end;
1274	+
1275	+	function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata;
1276	+	begin
1277	+	Result := FMetadata;
1278	+	if Result <> nil then
1279	+	Result.addRef;
1280	+	end;
1281	+
1282		function TIBXSQLDA.GetTransactionSeqNo: integer;
1283		begin
1284		Result := FTransactionSeqNo;
#	Line 1222 | Line 1297 | begin
1297		FCount := 0;
1298		SetLength(FColumnList,0);
1299		FSize := 0;
1300	+	FreeMessageBuffer;
1301		end;
1302
1303		function TIBXSQLDA.GetStatement: IStatement;
#	Line 1231 | Line 1307 | end;
1307
1308		function TIBXSQLDA.GetPrepareSeqNo: integer;
1309		begin
1310	<	Result := FStatement.FPrepareSeqNo;
1310	>	if FStatement = nil then
1311	>	Result := 0
1312	>	else
1313	>	Result := FStatement.FPrepareSeqNo;
1314		end;
1315
1316		{ TFB30Statement }
#	Line 1271 | Line 1350 | begin
1350		end;
1351		end;
1352
1353	<	procedure TFB30Statement.InternalPrepare;
1353	>	function TFB30Statement.GetStatementIntf: IStatement;
1354	>	begin
1355	>	Result := self;
1356	>	end;
1357	>
1358	>	procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1359	>	var GUID : TGUID;
1360	>	metadata: Firebird.IMessageMetadata;
1361		begin
1362		if FPrepared then
1363		Exit;
1364	+
1365	+	FCursor := CursorName;
1366		if (FSQL = '') then
1367		IBError(ibxeEmptyQuery, [nil]);
1368		try
1369		CheckTransaction(FTransactionIntf);
1370		with FFirebird30ClientAPI do
1371		begin
1372	+	if FCursor = '' then
1373	+	begin
1374	+	CreateGuid(GUID);
1375	+	FCursor := GUIDToString(GUID);
1376	+	end;
1377	+
1378		if FHasParamNames then
1379		begin
1380		if FProcessedSQL = '' then
#	Line 1303 | Line 1397 | begin
1397		FSQLStatementType := TIBSQLStatementTypes(FStatementIntf.getType(StatusIntf));
1398		Check4DataBaseError;
1399
1400	+	if FSQLStatementType = SQLSelect then
1401	+	begin
1402	+	FStatementIntf.setCursorName(StatusIntf,PAnsiChar(FCursor));
1403	+	Check4DataBaseError;
1404	+	end;
1405		{ Done getting the type }
1406		case FSQLStatementType of
1407		SQLGetSegment,
#	Line 1319 | Line 1418 | begin
1418		SQLExecProcedure:
1419		begin
1420		{set up input sqlda}
1421	<	FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1421	>	metadata := FStatementIntf.getInputMetadata(StatusIntf);
1422		Check4DataBaseError;
1423	+	try
1424	+	FSQLParams.Bind(metadata);
1425	+	finally
1426	+	metadata.release;
1427	+	end;
1428
1429		{setup output sqlda}
1430		if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1431		SQLExecProcedure] then
1432	<	FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1433	<	Check4DataBaseError;
1432	>	begin
1433	>	metadata := FStatementIntf.getOutputMetadata(StatusIntf);
1434	>	Check4DataBaseError;
1435	>	try
1436	>	FSQLRecord.Bind(metadata);
1437	>	finally
1438	>	metadata.release;
1439	>	end;
1440	>	end;
1441		end;
1442		end;
1443		end;
#	Line 1340 | Line 1451 | begin
1451		end;
1452		end;
1453		FPrepared := true;
1454	+
1455		FSingleResults := false;
1456		if RetainInterfaces then
1457		begin
#	Line 1359 | Line 1471 | end;
1471		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1472
1473		procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1474	+	var inMetadata: Firebird.IMessageMetaData;
1475		begin
1476		with FFirebird30ClientAPI do
1477		begin
1478		SavePerfStats(FBeforeStats);
1479	<	FStatementIntf.execute(StatusIntf,
1480	<	(aTransaction as TFB30Transaction).TransactionIntf,
1481	<	FSQLParams.MetaData,
1482	<	FSQLParams.MessageBuffer,
1483	<	outMetaData,
1484	<	outBuffer);
1485	<	Check4DataBaseError;
1479	>	inMetadata := FSQLParams.GetMetaData;
1480	>	try
1481	>	FStatementIntf.execute(StatusIntf,
1482	>	(aTransaction as TFB30Transaction).TransactionIntf,
1483	>	inMetaData,
1484	>	FSQLParams.MessageBuffer,
1485	>	outMetaData,
1486	>	outBuffer);
1487	>	Check4DataBaseError;
1488	>	finally
1489	>	if inMetadata <> nil then
1490	>	inMetadata.release;
1491	>	end;
1492		FStatisticsAvailable := SavePerfStats(FAfterStats);
1493		end;
1494		end;
1495
1496	+	var Cursor: IResultSet;
1497	+	outMetadata: Firebird.IMessageMetaData;
1498
1499		begin
1500		Result := nil;
#	Line 1390 | Line 1511 | begin
1511		CheckHandle;
1512		if aTransaction <> FTransactionIntf then
1513		AddMonitor(aTransaction as TFB30Transaction);
1514	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1514	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1515		IBError(ibxeInterfaceOutofDate,[nil]);
1516
1517
#	Line 1399 | Line 1520 | begin
1520		begin
1521		case FSQLStatementType of
1522		SQLSelect:
1523	<	IBError(ibxeIsAExecuteProcedure,[]);
1523	>	{e.g. Update...returning with a single row in Firebird 5 and later}
1524	>	begin
1525	>	Cursor := InternalOpenCursor(aTransaction,false);
1526	>	if not Cursor.IsEof then
1527	>	Cursor.FetchNext;
1528	>	Result := Cursor; {note only first row}
1529	>	FSingleResults := true;
1530	>	end;
1531
1532		SQLExecProcedure:
1533		begin
1534	<	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1535	<	Result := TResults.Create(FSQLRecord);
1536	<	FSingleResults := true;
1534	>	outMetadata := FSQLRecord.GetMetaData;
1535	>	try
1536	>	ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer);
1537	>	Result := TResults.Create(FSQLRecord);
1538	>	FSingleResults := true;
1539	>	finally
1540	>	if outMetadata <> nil then
1541	>	outMetadata.release;
1542	>	end;
1543		end;
1544
1545		else
#	Line 1423 | Line 1557 | begin
1557		Inc(FChangeSeqNo);
1558		end;
1559
1560	<	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction
1561	<	): IResultSet;
1560	>	function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1561	>	Scrollable: boolean): IResultSet;
1562	>	var flags: cardinal;
1563	>	inMetadata,
1564	>	outMetadata: Firebird.IMessageMetadata;
1565		begin
1566	<	if FSQLStatementType <> SQLSelect then
1566	>	flags := 0;
1567	>	if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
1568		IBError(ibxeIsASelectStatement,[]);
1569
1570		FBatchCompletion := nil;
#	Line 1436 | Line 1574 | begin
1574		CheckHandle;
1575		if aTransaction <> FTransactionIntf then
1576		AddMonitor(aTransaction as TFB30Transaction);
1577	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1577	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1578		IBError(ibxeInterfaceOutofDate,[nil]);
1579
1580	+	if Scrollable then
1581	+	flags := Firebird.IStatement.CURSOR_TYPE_SCROLLABLE;
1582	+
1583		with FFirebird30ClientAPI do
1584		begin
1585		if FCollectStatistics then
#	Line 1449 | Line 1590 | begin
1590		Check4DataBaseError;
1591		end;
1592
1593	<	FResultSet := FStatementIntf.openCursor(StatusIntf,
1593	>	inMetadata := FSQLParams.GetMetaData;
1594	>	outMetadata := FSQLRecord.GetMetaData;
1595	>	try
1596	>	FResultSet := FStatementIntf.openCursor(StatusIntf,
1597		(aTransaction as TFB30Transaction).TransactionIntf,
1598	<	FSQLParams.MetaData,
1598	>	inMetaData,
1599		FSQLParams.MessageBuffer,
1600	<	FSQLRecord.MetaData,
1601	<	0);
1602	<	Check4DataBaseError;
1600	>	outMetaData,
1601	>	flags);
1602	>	Check4DataBaseError;
1603	>	finally
1604	>	if inMetadata <> nil then
1605	>	inMetadata.release;
1606	>	if outMetadata <> nil then
1607	>	outMetadata.release;
1608	>	end;
1609
1610		if FCollectStatistics then
1611		begin
#	Line 1500 | Line 1650 | begin
1650		FStatementIntf := nil;
1651		FPrepared := false;
1652		end;
1653	+	FCursor := '';
1654		end;
1655
1656		procedure TFB30Statement.InternalClose(Force: boolean);
#	Line 1545 | Line 1696 | begin
1696		end;
1697
1698		constructor TFB30Statement.Create(Attachment: TFB30Attachment;
1699	<	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1699	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1700	>	CursorName: AnsiString);
1701		begin
1702		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1703		FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1704		FSQLParams := TIBXINPUTSQLDA.Create(self);
1705		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1706	<	InternalPrepare;
1706	>	InternalPrepare(CursorName);
1707		end;
1708
1709		constructor TFB30Statement.CreateWithParameterNames(
1710		Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1711		aSQLDialect: integer; GenerateParamNames: boolean;
1712	<	CaseSensitiveParams: boolean);
1712	>	CaseSensitiveParams: boolean; CursorName: AnsiString);
1713		begin
1714		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1715		FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1716		FSQLParams := TIBXINPUTSQLDA.Create(self);
1717		FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1718		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1719	<	InternalPrepare;
1719	>	InternalPrepare(CursorName);
1720		end;
1721
1722		destructor TFB30Statement.Destroy;
#	Line 1574 | Line 1726 | begin
1726		if assigned(FSQLRecord) then FSQLRecord.Free;
1727		end;
1728
1729	<	function TFB30Statement.FetchNext: boolean;
1729	>	function TFB30Statement.Fetch(FetchType: TFetchType; PosOrOffset: integer
1730	>	): boolean;
1731		var fetchResult: integer;
1732		begin
1733	<	result := false;
1733	>	result := false;
1734		if not FOpen then
1735		IBError(ibxeSQLClosed, [nil]);
1583	–	if FEOF then
1584	–	IBError(ibxeEOF,[nil]);
1736
1737		with FFirebird30ClientAPI do
1738		begin
1739	<	{ Go to the next record... }
1740	<	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1741	<	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1742	<	begin
1743	<	FBOF := false;
1744	<	FEOF := true;
1745	<	Exit; {End of File}
1746	<	end
1747	<	else
1748	<	if fetchResult <> Firebird.IStatus.RESULT_OK then
1749	<	begin
1750	<	try
1751	<	IBDataBaseError;
1601	<	except
1602	<	Close;
1603	<	raise;
1739	>	case FetchType of
1740	>	ftNext:
1741	>	begin
1742	>	if FEOF then
1743	>	IBError(ibxeEOF,[nil]);
1744	>	{ Go to the next record... }
1745	>	fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
1746	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1747	>	begin
1748	>	FBOF := false;
1749	>	FEOF := true;
1750	>	Exit; {End of File}
1751	>	end
1752		end;
1753	<	end
1754	<	else
1755	<	begin
1756	<	FBOF := false;
1757	<	result := true;
1753	>
1754	>	ftPrior:
1755	>	begin
1756	>	if FBOF then
1757	>	IBError(ibxeBOF,[nil]);
1758	>	{ Go to the next record... }
1759	>	fetchResult := FResultSet.fetchPrior(StatusIntf,FSQLRecord.MessageBuffer);
1760	>	if fetchResult = Firebird.IStatus.RESULT_NO_DATA then
1761	>	begin
1762	>	FBOF := true;
1763	>	FEOF := false;
1764	>	Exit; {Top of File}
1765	>	end
1766	>	end;
1767	>
1768	>	ftFirst:
1769	>	fetchResult := FResultSet.fetchFirst(StatusIntf,FSQLRecord.MessageBuffer);
1770	>
1771	>	ftLast:
1772	>	fetchResult := FResultSet.fetchLast(StatusIntf,FSQLRecord.MessageBuffer);
1773	>
1774	>	ftAbsolute:
1775	>	fetchResult := FResultSet.fetchAbsolute(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1776	>
1777	>	ftRelative:
1778	>	fetchResult := FResultSet.fetchRelative(StatusIntf,PosOrOffset,FSQLRecord.MessageBuffer);
1779		end;
1780	+
1781	+	Check4DataBaseError;
1782	+	if fetchResult <> Firebird.IStatus.RESULT_OK then
1783	+	exit; {result = false}
1784	+
1785	+	{Result OK}
1786	+	FBOF := false;
1787	+	FEOF := false;
1788	+	result := true;
1789	+
1790		if FCollectStatistics then
1791		begin
1792		UtilIntf.getPerfCounters(StatusIntf,
#	Line 1693 | Line 1872 | end;
1872
1873		procedure TFB30Statement.AddToBatch;
1874		var BatchPB: TXPBParameterBlock;
1875	+	inMetadata: Firebird.IMessageMetadata;
1876
1877		const SixteenMB = 16 * 1024 * 1024;
1878	+	MB256 = 256* 1024 *1024;
1879		begin
1880		FBatchCompletion := nil;
1881		if not FPrepared then
1882		InternalPrepare;
1883		CheckHandle;
1884		CheckBatchModeAvailable;
1885	<	with FFirebird30ClientAPI do
1886	<	begin
1887	<	if FBatch = nil then
1885	>	inMetadata := FSQLParams.GetMetaData;
1886	>	try
1887	>	with FFirebird30ClientAPI do
1888		begin
1889	<	{Start Batch}
1890	<	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1891	<	with FFirebird30ClientAPI do
1892	<	try
1893	<	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1894	<	Check4DatabaseError;
1895	<	if FBatchBufferSize < SixteenMB then
1896	<	FBatchBufferSize := SixteenMB;
1897	<	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1898	<	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1899	<
1900	<	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1901	<	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1902	<	FBatch := FStatementIntf.createBatch(StatusIntf,
1903	<	FSQLParams.MetaData,
1904	<	BatchPB.getDataLength,
1905	<	BatchPB.getBuffer);
1906	<	Check4DataBaseError;
1889	>	if FBatch = nil then
1890	>	begin
1891	>	{Start Batch}
1892	>	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1893	>	with FFirebird30ClientAPI do
1894	>	try
1895	>	if FBatchRowLimit = maxint then
1896	>	FBatchBufferSize := MB256
1897	>	else
1898	>	begin
1899	>	FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf);
1900	>	Check4DatabaseError;
1901	>	if FBatchBufferSize < SixteenMB then
1902	>	FBatchBufferSize := SixteenMB;
1903	>	if FBatchBufferSize > MB256 {assumed limit} then
1904	>	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1905	>	end;
1906	>	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1907	>	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1908	>	FBatch := FStatementIntf.createBatch(StatusIntf,
1909	>	inMetadata,
1910	>	BatchPB.getDataLength,
1911	>	BatchPB.getBuffer);
1912	>	Check4DataBaseError;
1913
1914	<	finally
1915	<	BatchPB.Free;
1914	>	finally
1915	>	BatchPB.Free;
1916	>	end;
1917	>	FBatchRowCount := 0;
1918	>	FBatchBufferUsed := 0;
1919		end;
1730	–	FBatchRowCount := 0;
1731	–	FBatchBufferUsed := 0;
1732	–	end;
1920
1921	<	Inc(FBatchRowCount);
1922	<	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1923	<	Check4DataBaseError;
1924	<	if FBatchBufferUsed > FBatchBufferSize then
1925	<	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1926	<	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1927	<	[FBatchRowCount,FBatchBufferSize]));
1921	>	Inc(FBatchRowCount);
1922	>	Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf));
1923	>	Check4DataBaseError;
1924	>	if FBatchBufferUsed > FBatchBufferSize then
1925	>	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1926	>	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1927	>	[FBatchRowCount,FBatchBufferSize]));
1928
1929	<	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1930	<	Check4DataBaseError
1929	>	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1930	>	Check4DataBaseError
1931	>	end;
1932	>	finally
1933	>	if inMetadata <> nil then
1934	>	inMetadata.release;
1935		end;
1936		end;
1937
#	Line 1799 | Line 1990 | begin
1990		Result := FStatementIntf <> nil;
1991		end;
1992
1993	+	function TFB30Statement.GetFlags: TStatementFlags;
1994	+	var flags: cardinal;
1995	+	begin
1996	+	CheckHandle;
1997	+	Result := [];
1998	+	with FFirebird30ClientAPI do
1999	+	begin
2000	+	flags := FStatementIntf.getFlags(StatusIntf);
2001	+	Check4DataBaseError;
2002	+	end;
2003	+	if flags and Firebird.IStatement.FLAG_HAS_CURSOR <> 0 then
2004	+	Result := Result + [stHasCursor];
2005	+	if flags and Firebird.IStatement.FLAG_REPEAT_EXECUTE <> 0 then
2006	+	Result := Result + [stRepeatExecute];
2007	+	if flags and Firebird.IStatement.CURSOR_TYPE_SCROLLABLE <> 0 then
2008	+	Result := Result + [stScrollable];
2009	+	end;
2010	+
2011		end.
2012

Diff Legend

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