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 359 by tony, Tue Dec 7 09:37:32 2021 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (file contents), Revision 384 by tony, Mon Jan 17 09:52:58 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
#	Line 141 | Line 136 | type
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 159 | 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;
177	–	property MetaData: Firebird.IMessageMetadata read FMetaData;
178		property Count: Integer read FCount write SetCount;
179		property Statement: TFB30Statement read FStatement;
180		end;
#	Line 183 | Line 183 | type
183
184		TIBXINPUTSQLDA = class(TIBXSQLDA)
185		private
186	–	FMessageBuffer: PByte; {Message Buffer}
187	–	FMsgLength: integer; {Message Buffer length}
186		FCurMetaData: Firebird.IMessageMetadata;
189	–	procedure FreeMessageBuffer;
187		procedure FreeCurMetaData;
188		function GetMessageBuffer: PByte;
192	–	function GetMetaData: Firebird.IMessageMetadata;
189		function GetModified: Boolean;
190		function GetMsgLength: integer;
191		procedure BuildMetadata;
196	–	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;
206	–	property MetaData: Firebird.IMessageMetadata read GetMetaData;
204		property MessageBuffer: PByte read GetMessageBuffer;
205		property MsgLength: integer read GetMsgLength;
206		end;
#	Line 213 | Line 210 | type
210		TIBXOUTPUTSQLDA = class(TIBXSQLDA)
211		private
212		FTransaction: TFB30Transaction; {transaction used to execute the statement}
216	–	FMessageBuffer: PByte; {Message Buffer}
217	–	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 244 | Line 239 | type
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;
247	–	function GetTransaction: ITransaction; override;
242		function IsBof: boolean;
243		function IsEof: boolean;
244		procedure Close;
#	Line 290 | Line 284 | type
284		procedure CheckHandle; override;
285		procedure CheckBatchModeAvailable;
286		procedure GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults); override;
287	+	function GetStatementIntf: IStatement; override;
288		procedure InternalPrepare(CursorName: AnsiString=''); override;
289		function InternalExecute(aTransaction: ITransaction): IResults; override;
290		function InternalOpenCursor(aTransaction: ITransaction; Scrollable: boolean
#	Line 307 | Line 302 | type
302		destructor Destroy; override;
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 431 | 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 537 | 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 551 | 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 590 | Line 599 | begin
599		end;
600		end;
601
593	–	function TIBXSQLVAR.GetCodePage: TSystemCodePage;
594	–	begin
595	–	result := CP_NONE;
596	–	with Statement.GetAttachment do
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	–
602		function TIBXSQLVAR.GetIsNull: Boolean;
603		begin
604		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 629 | Line 624 | begin
624		Result := FMetadataSize;
625		end;
626
632	–	function TIBXSQLVAR.GetAttachment: IAttachment;
633	–	begin
634	–	Result := FStatement.GetAttachment;
635	–	end;
636	–
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 652 | 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 696 | 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 713 | Line 703 | begin
703		Changed;
704		end;
705
706	<	procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
706	>	procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
707		begin
718	–	if (FSQLType <> aValue) and not CanChangeSQLType then
719	–	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(FSQLType),TSQLDataItem.GetSQLTypeName(aValue)]);
708		FSQLType := aValue;
709		Changed;
710		end;
#	Line 750 | Line 738 | procedure TIBXSQLVAR.RowChange;
738		begin
739		inherited;
740		FBlob := nil;
753	–	FArray := nil;
741		end;
742
743		procedure TIBXSQLVAR.FreeSQLData;
#	Line 761 | 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 770 | 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 789 | 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 799 | 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
#	Line 879 | Line 866 | begin
866		Result := FResults.FStatement.FCursor;
867		end;
868
882	–	function TResultSet.GetTransaction: ITransaction;
883	–	begin
884	–	Result := FResults.FTransaction;
885	–	end;
886	–
869		function TResultSet.IsBof: boolean;
870		begin
871		Result := FResults.FStatement.FBof;
#	Line 915 | Line 897 | begin
897		end;
898		end;
899
918	–	procedure TIBXINPUTSQLDA.FreeMessageBuffer;
919	–	begin
920	–	if FMessageBuffer <> nil then
921	–	begin
922	–	FreeMem(FMessageBuffer);
923	–	FMessageBuffer := nil;
924	–	end;
925	–	FMsgLength := 0;
926	–	end;
927	–
900		procedure TIBXINPUTSQLDA.FreeCurMetaData;
901		begin
902		if FCurMetaData <> nil then
#	Line 944 | 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 955 | 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 965 | 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 997 | Line 981 | end;
981		procedure TIBXINPUTSQLDA.PackBuffer;
982		var i: integer;
983		P: PByte;
984	+	MsgLen: cardinal;
985	+	aNullIndicator: short;
986		begin
987		BuildMetadata;
988
989		if (FMsgLength = 0) and (FCurMetaData <> nil) then
990		with FFirebird30ClientAPI do
991		begin
992	<	FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
992	>	MsgLen := FCurMetaData.getMessageLength(StatusIntf);
993		Check4DataBaseError;
994
995	<	IBAlloc(FMessageBuffer,0,FMsgLength);
995	>	AllocMessageBuffer(MsgLen);
996
997		for i := 0 to Count - 1 do
998		with TIBXSQLVar(Column[i]) do
#	Line 1037 | Line 1023 | begin
1023		begin
1024		Move(FNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(FNullIndicator));
1025		Check4DataBaseError;
1026	+	end
1027	+	else
1028	+	begin
1029	+	aNullIndicator := 0;
1030	+	Move(aNullIndicator,(FMessageBuffer + FCurMetaData.getNullOffset(StatusIntf,i))^,sizeof(aNullIndicator));
1031		end;
1032		end;
1033		end;
#	Line 1046 | Line 1037 | procedure TIBXINPUTSQLDA.FreeXSQLDA;
1037		begin
1038		inherited FreeXSQLDA;
1039		FreeCurMetaData;
1049	–	FreeMessageBuffer;
1040		end;
1041
1042		constructor TIBXINPUTSQLDA.Create(aStatement: TFB30Statement);
#	Line 1055 | Line 1045 | begin
1045		FMessageBuffer := nil;
1046		end;
1047
1048	+	constructor TIBXINPUTSQLDA.Create(api: IFirebirdAPI);
1049	+	begin
1050	+	inherited Create(api);
1051	+	FMessageBuffer := nil;
1052	+	end;
1053	+
1054		destructor TIBXINPUTSQLDA.Destroy;
1055		begin
1056		FreeXSQLDA;
#	Line 1065 | Line 1061 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
1061		var i: integer;
1062		begin
1063		FMetaData := aMetaData;
1064	+	FMetaData.AddRef;
1065		with FFirebird30ClientAPI do
1066		begin
1067		Count := aMetadata.getCount(StatusIntf);
#	Line 1107 | Line 1104 | end;
1104
1105		{ TIBXOUTPUTSQLDA }
1106
1107	<	procedure TIBXOUTPUTSQLDA.FreeXSQLDA;
1107	>	function TIBXOUTPUTSQLDA.GetTransaction: ITransaction;
1108		begin
1109	<	inherited FreeXSQLDA;
1110	<	FreeMem(FMessageBuffer);
1111	<	FMessageBuffer := nil;
1112	<	FMsgLength := 0;
1109	>	if FTransaction <> nil then
1110	>	Result := FTransaction
1111	>	else
1112	>	Result := inherited GetTransaction;
1113		end;
1114
1115		procedure TIBXOUTPUTSQLDA.Bind(aMetaData: Firebird.IMessageMetadata);
1116		var i: integer;
1117	+	MsgLen: cardinal;
1118		begin
1119		FMetaData := aMetaData;
1120	+	FMetaData.AddRef;
1121		with FFirebird30ClientAPI do
1122		begin
1123	<	Count := metadata.getCount(StatusIntf);
1123	>	Count := aMetaData.getCount(StatusIntf);
1124		Check4DataBaseError;
1125		Initialize;
1126
1127	<	FMsgLength := metaData.getMessageLength(StatusIntf);
1127	>	MsgLen := aMetaData.getMessageLength(StatusIntf);
1128		Check4DataBaseError;
1129	<	IBAlloc(FMessageBuffer,0,FMsgLength);
1129	>	AllocMessageBuffer(MsgLen);
1130
1131		for i := 0 to Count - 1 do
1132		with TIBXSQLVar(Column[i]) do
1133		begin
1134		InitColumnMetaData(aMetaData);
1135	<	FSQLData := FMessageBuffer + metaData.getOffset(StatusIntf,i);
1135	>	FSQLData := FMessageBuffer + aMetaData.getOffset(StatusIntf,i);
1136		Check4DataBaseError;
1137		if FNullable then
1138		begin
#	Line 1143 | Line 1142 | begin
1142		else
1143		FSQLNullIndicator := nil;
1144		FBlob := nil;
1145	<	FArray := nil;
1145	>	FArrayIntf := nil;
1146		end;
1147		end;
1148		SetUniqueRelationName;
#	Line 1181 | Line 1180 | begin
1180		//  writeln('Creating ',ClassName);
1181		end;
1182
1183	+	constructor TIBXSQLDA.Create(api: IFirebirdAPI);
1184	+	begin
1185	+	inherited Create;
1186	+	FStatement := nil;
1187	+	FSize := 0;
1188	+	FFirebird30ClientAPI := api as TFB30ClientAPI;
1189	+	end;
1190	+
1191		destructor TIBXSQLDA.Destroy;
1192		begin
1193		FreeXSQLDA;
#	Line 1196 | Line 1203 | end;
1203		function TIBXSQLDA.CheckStatementStatus(Request: TStatementStatus): boolean;
1204		begin
1205		Result := false;
1206	+	if FStatement <> nil then
1207		case Request of
1208		ssPrepared:
1209		Result := FStatement.IsPrepared;
1210
1211		ssExecuteResults:
1212	<	Result :=FStatement.FSingleResults;
1212	>	Result := FStatement.FSingleResults;
1213
1214		ssCursorOpen:
1215		Result := FStatement.FOpen;
#	Line 1219 | Line 1227 | begin
1227		Result := FCount;
1228		end;
1229
1222	–	function TIBXSQLDA.GetTransaction: TFB30Transaction;
1223	–	begin
1224	–	Result := FStatement.GetTransaction as TFB30Transaction;
1225	–	end;
1226	–
1230		procedure TIBXSQLDA.Initialize;
1231		begin
1232		if FMetaData <> nil then
#	Line 1232 | Line 1235 | end;
1235
1236		function TIBXSQLDA.StateChanged(var ChangeSeqNo: integer): boolean;
1237		begin
1238	<	Result := FStatement.ChangeSeqNo <> ChangeSeqNo;
1238	>	Result := (FStatement <> nil) and (FStatement.ChangeSeqNo <> ChangeSeqNo);
1239		if Result then
1240		ChangeSeqNo := FStatement.ChangeSeqNo;
1241		end;
#	Line 1258 | Line 1261 | begin
1261		end;
1262		end;
1263
1264	+	procedure TIBXSQLDA.AllocMessageBuffer(len: integer);
1265	+	begin
1266	+	with FFirebird30ClientAPI do
1267	+	IBAlloc(FMessageBuffer,0,len);
1268	+	FMsgLength := len;
1269	+	end;
1270	+
1271	+	procedure TIBXSQLDA.FreeMessageBuffer;
1272	+	begin
1273	+	if FMessageBuffer <> nil then
1274	+	begin
1275	+	FreeMem(FMessageBuffer);
1276	+	FMessageBuffer := nil;
1277	+	end;
1278	+	FMsgLength := 0;
1279	+	end;
1280	+
1281	+	function TIBXSQLDA.GetMetaData: Firebird.IMessageMetadata;
1282	+	begin
1283	+	Result := FMetadata;
1284	+	if Result <> nil then
1285	+	Result.addRef;
1286	+	end;
1287	+
1288		function TIBXSQLDA.GetTransactionSeqNo: integer;
1289		begin
1290		Result := FTransactionSeqNo;
#	Line 1276 | Line 1303 | begin
1303		FCount := 0;
1304		SetLength(FColumnList,0);
1305		FSize := 0;
1306	+	FreeMessageBuffer;
1307		end;
1308
1309		function TIBXSQLDA.GetStatement: IStatement;
#	Line 1285 | Line 1313 | end;
1313
1314		function TIBXSQLDA.GetPrepareSeqNo: integer;
1315		begin
1316	<	Result := FStatement.FPrepareSeqNo;
1316	>	if FStatement = nil then
1317	>	Result := 0
1318	>	else
1319	>	Result := FStatement.FPrepareSeqNo;
1320		end;
1321
1322		{ TFB30Statement }
#	Line 1325 | Line 1356 | begin
1356		end;
1357		end;
1358
1359	+	function TFB30Statement.GetStatementIntf: IStatement;
1360	+	begin
1361	+	Result := self;
1362	+	end;
1363	+
1364		procedure TFB30Statement.InternalPrepare(CursorName: AnsiString);
1365		var GUID : TGUID;
1366	+	metadata: Firebird.IMessageMetadata;
1367		begin
1368		if FPrepared then
1369		Exit;
#	Line 1387 | Line 1424 | begin
1424		SQLExecProcedure:
1425		begin
1426		{set up input sqlda}
1427	<	FSQLParams.Bind(FStatementIntf.getInputMetadata(StatusIntf));
1427	>	metadata := FStatementIntf.getInputMetadata(StatusIntf);
1428		Check4DataBaseError;
1429	+	try
1430	+	FSQLParams.Bind(metadata);
1431	+	finally
1432	+	metadata.release;
1433	+	end;
1434
1435		{setup output sqlda}
1436		if FSQLStatementType in [SQLSelect, SQLSelectForUpdate,
1437		SQLExecProcedure] then
1438	<	FSQLRecord.Bind(FStatementIntf.getOutputMetadata(StatusIntf));
1439	<	Check4DataBaseError;
1438	>	begin
1439	>	metadata := FStatementIntf.getOutputMetadata(StatusIntf);
1440	>	Check4DataBaseError;
1441	>	try
1442	>	FSQLRecord.Bind(metadata);
1443	>	finally
1444	>	metadata.release;
1445	>	end;
1446	>	end;
1447		end;
1448		end;
1449		end;
#	Line 1428 | Line 1477 | end;
1477		function TFB30Statement.InternalExecute(aTransaction: ITransaction): IResults;
1478
1479		procedure ExecuteQuery(outMetaData: Firebird.IMessageMetaData=nil; outBuffer: pointer=nil);
1480	+	var inMetadata: Firebird.IMessageMetaData;
1481		begin
1482		with FFirebird30ClientAPI do
1483		begin
1484		SavePerfStats(FBeforeStats);
1485	<	FStatementIntf.execute(StatusIntf,
1486	<	(aTransaction as TFB30Transaction).TransactionIntf,
1487	<	FSQLParams.MetaData,
1488	<	FSQLParams.MessageBuffer,
1489	<	outMetaData,
1490	<	outBuffer);
1491	<	Check4DataBaseError;
1485	>	inMetadata := FSQLParams.GetMetaData;
1486	>	try
1487	>	FStatementIntf.execute(StatusIntf,
1488	>	(aTransaction as TFB30Transaction).TransactionIntf,
1489	>	inMetaData,
1490	>	FSQLParams.MessageBuffer,
1491	>	outMetaData,
1492	>	outBuffer);
1493	>	Check4DataBaseError;
1494	>	finally
1495	>	if inMetadata <> nil then
1496	>	inMetadata.release;
1497	>	end;
1498		FStatisticsAvailable := SavePerfStats(FAfterStats);
1499		end;
1500		end;
1501
1502		var Cursor: IResultSet;
1503	+	outMetadata: Firebird.IMessageMetaData;
1504
1505		begin
1506		Result := nil;
#	Line 1480 | Line 1537 | begin
1537
1538		SQLExecProcedure:
1539		begin
1540	<	ExecuteQuery(FSQLRecord.MetaData,FSQLRecord.MessageBuffer);
1541	<	Result := TResults.Create(FSQLRecord);
1542	<	FSingleResults := true;
1540	>	outMetadata := FSQLRecord.GetMetaData;
1541	>	try
1542	>	ExecuteQuery(outMetadata,FSQLRecord.MessageBuffer);
1543	>	Result := TResults.Create(FSQLRecord);
1544	>	FSingleResults := true;
1545	>	finally
1546	>	if outMetadata <> nil then
1547	>	outMetadata.release;
1548	>	end;
1549		end;
1550
1551		else
#	Line 1503 | Line 1566 | end;
1566		function TFB30Statement.InternalOpenCursor(aTransaction: ITransaction;
1567		Scrollable: boolean): IResultSet;
1568		var flags: cardinal;
1569	+	inMetadata,
1570	+	outMetadata: Firebird.IMessageMetadata;
1571		begin
1572		flags := 0;
1573		if (FSQLStatementType <> SQLSelect) and not (stHasCursor in getFlags) then
#	Line 1531 | Line 1596 | begin
1596		Check4DataBaseError;
1597		end;
1598
1599	<	FResultSet := FStatementIntf.openCursor(StatusIntf,
1599	>	inMetadata := FSQLParams.GetMetaData;
1600	>	outMetadata := FSQLRecord.GetMetaData;
1601	>	try
1602	>	FResultSet := FStatementIntf.openCursor(StatusIntf,
1603		(aTransaction as TFB30Transaction).TransactionIntf,
1604	<	FSQLParams.MetaData,
1604	>	inMetaData,
1605		FSQLParams.MessageBuffer,
1606	<	FSQLRecord.MetaData,
1606	>	outMetaData,
1607		flags);
1608	<	Check4DataBaseError;
1608	>	Check4DataBaseError;
1609	>	finally
1610	>	if inMetadata <> nil then
1611	>	inMetadata.release;
1612	>	if outMetadata <> nil then
1613	>	outMetadata.release;
1614	>	end;
1615
1616		if FCollectStatistics then
1617		begin
#	Line 1662 | Line 1736 | function TFB30Statement.Fetch(FetchType:
1736		): boolean;
1737		var fetchResult: integer;
1738		begin
1739	<	result := false;
1739	>	result := false;
1740		if not FOpen then
1741		IBError(ibxeSQLClosed, [nil]);
1742
#	Line 1804 | Line 1878 | end;
1878
1879		procedure TFB30Statement.AddToBatch;
1880		var BatchPB: TXPBParameterBlock;
1881	+	inMetadata: Firebird.IMessageMetadata;
1882
1883		const SixteenMB = 16 * 1024 * 1024;
1884	+	MB256 = 256* 1024 *1024;
1885		begin
1886		FBatchCompletion := nil;
1887		if not FPrepared then
1888		InternalPrepare;
1889		CheckHandle;
1890		CheckBatchModeAvailable;
1891	<	with FFirebird30ClientAPI do
1892	<	begin
1893	<	if FBatch = nil then
1891	>	inMetadata := FSQLParams.GetMetaData;
1892	>	try
1893	>	with FFirebird30ClientAPI do
1894		begin
1895	<	{Start Batch}
1896	<	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1897	<	with FFirebird30ClientAPI do
1898	<	try
1899	<	FBatchBufferSize := FBatchRowLimit * FSQLParams.MetaData.getAlignedLength(StatusIntf);
1900	<	Check4DatabaseError;
1901	<	if FBatchBufferSize < SixteenMB then
1902	<	FBatchBufferSize := SixteenMB;
1903	<	if FBatchBufferSize > 256 * 1024 *1024 {assumed limit} then
1904	<	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1905	<
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	<	FSQLParams.MetaData,
1910	<	BatchPB.getDataLength,
1911	<	BatchPB.getBuffer);
1912	<	Check4DataBaseError;
1895	>	if FBatch = nil then
1896	>	begin
1897	>	{Start Batch}
1898	>	BatchPB := TXPBParameterBlock.Create(FFirebird30ClientAPI,Firebird.IXpbBuilder.BATCH);
1899	>	with FFirebird30ClientAPI do
1900	>	try
1901	>	if FBatchRowLimit = maxint then
1902	>	FBatchBufferSize := MB256
1903	>	else
1904	>	begin
1905	>	FBatchBufferSize := FBatchRowLimit * inMetadata.getAlignedLength(StatusIntf);
1906	>	Check4DatabaseError;
1907	>	if FBatchBufferSize < SixteenMB then
1908	>	FBatchBufferSize := SixteenMB;
1909	>	if FBatchBufferSize > MB256 {assumed limit} then
1910	>	IBError(ibxeBatchBufferSizeTooBig,[FBatchBufferSize]);
1911	>	end;
1912	>	BatchPB.insertInt(Firebird.IBatch.TAG_RECORD_COUNTS,1);
1913	>	BatchPB.insertInt(Firebird.IBatch.TAG_BUFFER_BYTES_SIZE,FBatchBufferSize);
1914	>	FBatch := FStatementIntf.createBatch(StatusIntf,
1915	>	inMetadata,
1916	>	BatchPB.getDataLength,
1917	>	BatchPB.getBuffer);
1918	>	Check4DataBaseError;
1919
1920	<	finally
1921	<	BatchPB.Free;
1920	>	finally
1921	>	BatchPB.Free;
1922	>	end;
1923	>	FBatchRowCount := 0;
1924	>	FBatchBufferUsed := 0;
1925		end;
1841	–	FBatchRowCount := 0;
1842	–	FBatchBufferUsed := 0;
1843	–	end;
1926
1927	<	Inc(FBatchRowCount);
1928	<	Inc(FBatchBufferUsed,FSQLParams.MetaData.getAlignedLength(StatusIntf));
1929	<	Check4DataBaseError;
1930	<	if FBatchBufferUsed > FBatchBufferSize then
1931	<	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1932	<	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1933	<	[FBatchRowCount,FBatchBufferSize]));
1927	>	Inc(FBatchRowCount);
1928	>	Inc(FBatchBufferUsed,inMetadata.getAlignedLength(StatusIntf));
1929	>	Check4DataBaseError;
1930	>	if FBatchBufferUsed > FBatchBufferSize then
1931	>	raise EIBBatchBufferOverflow.Create(Ord(ibxeBatchRowBufferOverflow),
1932	>	Format(GetErrorMessage(ibxeBatchRowBufferOverflow),
1933	>	[FBatchRowCount,FBatchBufferSize]));
1934
1935	<	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1936	<	Check4DataBaseError
1935	>	FBatch.Add(StatusIntf,1,FSQLParams.GetMessageBuffer);
1936	>	Check4DataBaseError
1937	>	end;
1938	>	finally
1939	>	if inMetadata <> nil then
1940	>	inMetadata.release;
1941		end;
1942		end;
1943

Comparing:
ibx/trunk/fbintf/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 359 by tony, Tue Dec 7 09:37:32 2021 UTC vs.
ibx/branches/udr/client/3.0/FB30Statement.pas (property svn:eol-style), Revision 384 by tony, Mon Jan 17 09:52:58 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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