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 315 by tony, Thu Feb 25 11:56:36 2021 UTC

#	Line 87 | Line 87 | type
87		TIBXSQLVAR = class(TSQLVarData)
88		private
89		FStatement: TFB30Statement;
90	+	FFirebird30ClientAPI: TFB30ClientAPI;
91		FBlob: IBlob;             {Cache references}
92		FArray: IArray;
93		FNullIndicator: short;
#	Line 100 | Line 101 | type
101		FSQLData: PByte; {Address of SQL Data in Message Buffer}
102		FSQLNullIndicator: PShort; {Address of null indicator}
103		FDataLength: integer;
104	+	FMetadataSize: integer;
105		FNullable: boolean;
106		FScale: integer;
107		FCharSetID: cardinal;
#	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		procedure SetIsNull(Value: Boolean); override;
128		procedure SetIsNullable(Value: Boolean);  override;
129		procedure SetSQLData(AValue: PByte; len: cardinal); override;
#	Line 148 | Line 152 | type
152		FSize: Integer;  {Number of TIBXSQLVARs in column list}
153		FMetaData: Firebird.IMessageMetadata;
154		FTransactionSeqNo: integer;
155	<	protected
155	>	protected
156		FStatement: TFB30Statement;
157	+	FFirebird30ClientAPI: TFB30ClientAPI;
158		function GetTransactionSeqNo: integer; override;
159		procedure FreeXSQLDA; virtual;
160		function GetStatement: IStatement; override;
#	Line 181 | Line 186 | type
186		function GetMetaData: Firebird.IMessageMetadata;
187		function GetModified: Boolean;
188		function GetMsgLength: integer;
189	+	procedure BuildMetadata;
190		procedure PackBuffer;
191		protected
192		procedure FreeXSQLDA; override;
#	Line 235 | Line 241 | type
241		TFB30Statement = class(TFBStatement,IStatement)
242		private
243		FStatementIntf: Firebird.IStatement;
244	+	FFirebird30ClientAPI: TFB30ClientAPI;
245		FSQLParams: TIBXINPUTSQLDA;
246		FSQLRecord: TIBXOUTPUTSQLDA;
247		FResultSet: Firebird.IResultSet;
#	Line 245 | Line 252 | type
252		procedure InternalPrepare; override;
253		function InternalExecute(aTransaction: ITransaction): IResults; override;
254		function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
255	+	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
256		procedure FreeHandle; override;
257		procedure InternalClose(Force: boolean); override;
258		public
259		constructor Create(Attachment: TFB30Attachment; Transaction: ITransaction;
260		sql: AnsiString; aSQLDialect: integer);
261		constructor CreateWithParameterNames(Attachment: TFB30Attachment; Transaction: ITransaction;
262	<	sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false);
262	>	sql: AnsiString;  aSQLDialect: integer; GenerateParamNames: boolean =false;
263	>	CaseSensitiveParams: boolean=false);
264		destructor Destroy; override;
265		function FetchNext: boolean;
266		property StatementIntf: Firebird.IStatement read FStatementIntf;
#	Line 270 | Line 279 | end;
279
280		implementation
281
282	<	uses IBUtils, FBMessages, FBBLob, FB30Blob, variants,  FBArray, FB30Array;
282	>	uses IBUtils, FBMessages, FBBlob, FB30Blob, variants,  FBArray, FB30Array;
283
284		const
285		ISQL_COUNTERS = 'CurrentMemory, MaxMemory, RealTime, UserTime, Buffers, Reads, Writes, Fetches';
#	Line 295 | Line 304 | end;
304
305		function TIBXSQLVAR.GetAliasName: AnsiString;
306		begin
307	<	with Firebird30ClientAPI do
307	>	with FFirebird30ClientAPI do
308		begin
309		result := strpas(TIBXSQLDA(Parent).MetaData.getAlias(StatusIntf,Index));
310		Check4DataBaseError;
#	Line 309 | Line 318 | end;
318
319		function TIBXSQLVAR.GetOwnerName: AnsiString;
320		begin
321	<	with Firebird30ClientAPI do
321	>	with FFirebird30ClientAPI do
322		begin
323		result := strpas(TIBXSQLDA(Parent).MetaData.getOwner(StatusIntf,Index));
324		Check4DataBaseError;
#	Line 343 | Line 352 | begin
352		else
353		result := FCharSetID;
354		end;
355	+	result := result;
356		end;
357
358		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
359		begin
360		result := CP_NONE;
361	<	with Firebird30ClientAPI do
361	>	with Statement.GetAttachment do
362		CharSetID2CodePage(GetCharSetID,result);
363		end;
364
365	+	function TIBXSQLVAR.GetCharSetWidth: integer;
366	+	begin
367	+	result := 1;
368	+	with Statement.GetAttachment DO
369	+	CharSetWidth(GetCharSetID,result);
370	+	end;
371	+
372		function TIBXSQLVAR.GetIsNull: Boolean;
373		begin
374		Result := IsNullable and (FSQLNullIndicator^ = -1);
#	Line 372 | Line 389 | begin
389		Result := FDataLength;
390		end;
391
392	+	function TIBXSQLVAR.GetSize: cardinal;
393	+	begin
394	+	Result := FMetadataSize;
395	+	end;
396	+
397		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
398		begin
399		if GetSQLType <> SQL_ARRAY then
#	Line 421 | Line 443 | begin
443		end
444		else
445		FSQLNullIndicator := nil;
446	+	Changed;
447		end;
448
449		procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
#	Line 430 | Line 453 | begin
453		FSQLData := AValue;
454		FDataLength := len;
455		FOwnsSQLData := false;
456	+	Changed;
457		end;
458
459		procedure TIBXSQLVAR.SetScale(aValue: integer);
460		begin
461		FScale := aValue;
462	+	Changed;
463		end;
464
465		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 442 | Line 467 | begin
467		if not FOwnsSQLData then
468		FSQLData := nil;
469		FDataLength := len;
470	<	with Firebird30ClientAPI do
470	>	with FFirebird30ClientAPI do
471		IBAlloc(FSQLData, 0, FDataLength);
472		FOwnsSQLData := true;
473	+	Changed;
474		end;
475
476		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
477		begin
478		FSQLType := aValue;
479	+	Changed;
480		end;
481
482		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
483		begin
484		FCharSetID := aValue;
485	+	Changed;
486		end;
487
488		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
489		begin
490		inherited Create(aParent,aIndex);
491		FStatement := aParent.Statement;
492	+	FFirebird30ClientAPI := aParent.FFirebird30ClientAPI;
493		end;
494
495		procedure TIBXSQLVAR.RowChange;
#	Line 606 | Line 635 | end;
635
636		function TIBXINPUTSQLDA.GetMetaData: Firebird.IMessageMetadata;
637		begin
638	<	PackBuffer;
638	>	BuildMetadata;
639		Result := FCurMetaData;
640		end;
641
#	Line 616 | Line 645 | begin
645		Result := FMsgLength;
646		end;
647
648	<	procedure TIBXINPUTSQLDA.PackBuffer;
648	>	procedure TIBXINPUTSQLDA.BuildMetadata;
649		var Builder: Firebird.IMetadataBuilder;
650		i: integer;
651		begin
652	<	if FMsgLength > 0 then Exit;
653	<
625	<	with Firebird30ClientAPI do
652	>	if FCurMetaData = nil then
653	>	with FFirebird30ClientAPI do
654		begin
655		Builder := inherited MetaData.getBuilder(StatusIntf);
656		Check4DataBaseError;
#	Line 646 | Line 674 | begin
674		finally
675		Builder.release;
676		end;
677	+	end;
678	+	end;
679	+
680	+	procedure TIBXINPUTSQLDA.PackBuffer;
681	+	var i: integer;
682	+	begin
683	+	BuildMetadata;
684
685	+	if FMsgLength = 0 then
686	+	with FFirebird30ClientAPI do
687	+	begin
688		FMsgLength := FCurMetaData.getMessageLength(StatusIntf);
689		Check4DataBaseError;
690
#	Line 655 | Line 693 | begin
693		for i := 0 to Count - 1 do
694		with TIBXSQLVar(Column[i]) do
695		begin
696	+	if not Modified then
697	+	IBError(ibxeUninitializedInputParameter,[i,Name]);
698	+
699		if IsNull then
700		FillChar((FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength,0)
701		else
702	+	if FSQLData <> nil then
703		Move(FSQLData^,(FMessageBuffer + FCurMetaData.getOffset(StatusIntf,i))^,FDataLength);
704		Check4DataBaseError;
705		if IsNullable then
#	Line 691 | Line 733 | procedure TIBXINPUTSQLDA.Bind(aMetaData:
733		var i: integer;
734		begin
735		FMetaData := aMetaData;
736	<	with Firebird30ClientAPI do
736	>	with FFirebird30ClientAPI do
737		begin
738		Count := metadata.getCount(StatusIntf);
739		Check4DataBaseError;
#	Line 710 | Line 752 | begin
752		else
753		FSQLSubType := 0;
754		FDataLength := aMetaData.getLength(StatusIntf,i);
755	+	FMetadataSize := FDataLength;
756		Check4DataBaseError;
757		case SQLType of
758		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
759		SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
760	<	SQL_LONG, SQL_INT64, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
760	>	SQL_LONG, SQL_INT64, SQL_INT128, SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT,
761	>	SQL_TIMESTAMP_TZ, SQL_TIME_TZ, SQL_DEC_FIXED, SQL_DEC16, SQL_DEC34,
762	>	SQL_TIMESTAMP_TZ_EX, SQL_TIME_TZ_EX:
763		begin
764		if (FDataLength = 0) then
765		{ Make sure you get a valid pointer anyway
#	Line 738 | Line 783 | begin
783		FSQLNullIndicator := nil;
784		FScale := aMetaData.getScale(StatusIntf,i);
785		Check4DataBaseError;
786	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
786	>	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
787		Check4DataBaseError;
788		end;
789		end;
#	Line 769 | Line 814 | procedure TIBXOUTPUTSQLDA.Bind(aMetaData
814		var i: integer;
815		begin
816		FMetaData := aMetaData;
817	<	with Firebird30ClientAPI do
817	>	with FFirebird30ClientAPI do
818		begin
819		Count := metadata.getCount(StatusIntf);
820		Check4DataBaseError;
#	Line 797 | Line 842 | begin
842		Check4DataBaseError;
843		FDataLength := aMetaData.getLength(StatusIntf,i);
844		Check4DataBaseError;
845	+	FMetadataSize := FDataLength;
846		FRelationName := strpas(aMetaData.getRelation(StatusIntf,i));
847		Check4DataBaseError;
848		FFieldName := strpas(aMetaData.getField(StatusIntf,i));
#	Line 812 | Line 858 | begin
858		FSQLNullIndicator := nil;
859		FScale := aMetaData.getScale(StatusIntf,i);
860		Check4DataBaseError;
861	<	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i);
861	>	FCharSetID :=  aMetaData.getCharSet(StatusIntf,i) and $FF;
862		Check4DataBaseError;
863		end;
864		end;
#	Line 829 | Line 875 | begin
875		len := FDataLength;
876		if not IsNull and (FSQLType = SQL_VARYING) then
877		begin
878	<	with Firebird30ClientAPI do
878	>	with FFirebird30ClientAPI do
879		len := DecodeInteger(data,2);
880		Inc(Data,2);
881		end;
#	Line 846 | Line 892 | constructor TIBXSQLDA.Create(aStatement:
892		begin
893		inherited Create;
894		FStatement := aStatement;
895	+	FFirebird30ClientAPI := aStatement.FFirebird30ClientAPI;
896		FSize := 0;
897		//  writeln('Creating ',ClassName);
898		end;
#	Line 962 | Line 1009 | end;
1009		procedure TFB30Statement.GetDSQLInfo(info_request: byte; buffer: ISQLInfoResults
1010		);
1011		begin
1012	<	with Firebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1012	>	with FFirebird30ClientAPI, buffer as TSQLInfoResultsBuffer do
1013		begin
1014		StatementIntf.getInfo(StatusIntf,1,BytePtr(@info_request),
1015		GetBufSize, BytePtr(Buffer));
#	Line 978 | Line 1025 | begin
1025		IBError(ibxeEmptyQuery, [nil]);
1026		try
1027		CheckTransaction(FTransactionIntf);
1028	<	with Firebird30ClientAPI do
1028	>	with FFirebird30ClientAPI do
1029		begin
1030		if FHasParamNames then
1031		begin
1032		if FProcessedSQL = '' then
1033	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1033	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
1034		FStatementIntf := (GetAttachment as TFB30Attachment).AttachmentIntf.prepare(StatusIntf,
1035		(FTransactionIntf as TFB30Transaction).TransactionIntf,
1036		Length(FProcessedSQL),
#	Line 1034 | Line 1081 | begin
1081		if (FStatementIntf <> nil) then
1082		FreeHandle;
1083		if E is EIBInterBaseError then
1084	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1085	<	EIBInterBaseError(E).IBErrorCode,
1039	<	EIBInterBaseError(E).Message +
1040	<	sSQLErrorSeparator + FSQL)
1041	<	else
1042	<	raise;
1084	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1085	>	raise;
1086		end;
1087		end;
1088		FPrepared := true;
#	Line 1075 | Line 1118 | begin
1118		IBError(ibxeInterfaceOutofDate,[nil]);
1119
1120		try
1121	<	with Firebird30ClientAPI do
1121	>	with FFirebird30ClientAPI do
1122		begin
1123		if FCollectStatistics then
1124		begin
#	Line 1125 | Line 1168 | begin
1168		RemoveMonitor(aTransaction as TFB30Transaction);
1169		end;
1170		FExecTransactionIntf := aTransaction;
1171	+	FSQLRecord.FTransaction := (aTransaction as TFB30Transaction);
1172	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1173		SignalActivity;
1174		Inc(FChangeSeqNo);
1175		end;
#	Line 1144 | Line 1189 | begin
1189		if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB30transaction).TransactionSeqNo) then
1190		IBError(ibxeInterfaceOutofDate,[nil]);
1191
1192	<	with Firebird30ClientAPI do
1192	>	with FFirebird30ClientAPI do
1193		begin
1194		if FCollectStatistics then
1195		begin
#	Line 1184 | Line 1229 | begin
1229		Inc(FChangeSeqNo);
1230		end;
1231
1232	+	procedure TFB30Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1233	+	var processedSQL: AnsiString);
1234	+	begin
1235	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames,processedSQL);
1236	+	end;
1237	+
1238		procedure TFB30Statement.FreeHandle;
1239		begin
1240		Close;
#	Line 1200 | Line 1251 | procedure TFB30Statement.InternalClose(F
1251		begin
1252		if (FStatementIntf <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1253		try
1254	<	with Firebird30ClientAPI do
1254	>	with FFirebird30ClientAPI do
1255		begin
1256		if FResultSet <> nil then
1257		begin
#	Line 1228 | Line 1279 | constructor TFB30Statement.Create(Attach
1279		Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer);
1280		begin
1281		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1282	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1283		FSQLParams := TIBXINPUTSQLDA.Create(self);
1284		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1285		InternalPrepare;
#	Line 1235 | Line 1287 | end;
1287
1288		constructor TFB30Statement.CreateWithParameterNames(
1289		Attachment: TFB30Attachment; Transaction: ITransaction; sql: AnsiString;
1290	<	aSQLDialect: integer; GenerateParamNames: boolean);
1290	>	aSQLDialect: integer; GenerateParamNames: boolean;
1291	>	CaseSensitiveParams: boolean);
1292		begin
1293		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1294	+	FFirebird30ClientAPI := Attachment.Firebird30ClientAPI;
1295		FSQLParams := TIBXINPUTSQLDA.Create(self);
1296	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1297		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1298		InternalPrepare;
1299		end;
#	Line 1259 | Line 1314 | begin
1314		if FEOF then
1315		IBError(ibxeEOF,[nil]);
1316
1317	<	with Firebird30ClientAPI do
1317	>	with FFirebird30ClientAPI do
1318		begin
1319		{ Go to the next record... }
1320		fetchResult := FResultSet.fetchNext(StatusIntf,FSQLRecord.MessageBuffer);
#	Line 1284 | Line 1339 | begin
1339		FBOF := false;
1340		result := true;
1341		end;
1342	+	if FCollectStatistics then
1343	+	begin
1344	+	UtilIntf.getPerfCounters(StatusIntf,
1345	+	(GetAttachment as TFB30Attachment).AttachmentIntf,
1346	+	ISQL_COUNTERS,@FAfterStats);
1347	+	Check4DataBaseError;
1348	+	FStatisticsAvailable := true;
1349	+	end;
1350		end;
1351		FSQLRecord.RowChange;
1352		SignalActivity;
#	Line 1315 | Line 1378 | begin
1378		SQLUpdate, SQLDelete])) then
1379		result := ''
1380		else
1381	<	with Firebird30ClientAPI do
1381	>	with FFirebird30ClientAPI do
1382		begin
1383		Result := FStatementIntf.getPlan(StatusIntf,true);
1384		Check4DataBaseError;

Diff Legend

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