ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/fbintf/client/2.5/FB25Statement.pas

Comparing ibx/trunk/fbintf/client/2.5/FB25Statement.pas (file contents):
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 347 by tony, Mon Sep 20 22:08:20 2021 UTC

#	Line 121 | Line 121 | type
121		TIBXSQLVAR = class(TSQLVarData)
122		private
123		FStatement: TFB25Statement;
124	+	FFirebird25ClientAPI: TFB25ClientAPI;
125		FBlob: IBlob;             {Cache references}
126		FArray: IArray;
127		FNullIndicator: short;
128		FOwnsSQLData: boolean;
129		FBlobMetaData: IBlobMetaData;
130		FArrayMetaData: IArrayMetaData;
131	+	FMetadataSize: short; {size of field from metadata}
132		FXSQLVAR: PXSQLVAR;       { Points to the PXSQLVAR in the owner object }
133		protected
134		function GetSQLType: cardinal; override;
#	Line 138 | Line 140 | type
140		function GetScale: integer; override;
141		function GetCharSetID: cardinal; override;
142		function GetCodePage: TSystemCodePage; override;
143	+	function GetCharSetWidth: integer; override;
144		function GetIsNull: Boolean;   override;
145		function GetIsNullable: boolean; override;
146		function GetSQLData: PByte;  override;
147		function GetDataLength: cardinal; override;
148	+	function GetSize: cardinal; override;
149	+	function GetAttachment: IAttachment; override;
150	+	function GetDefaultTextSQLType: cardinal; override;
151		procedure SetIsNull(Value: Boolean); override;
152		procedure SetIsNullable(Value: Boolean);  override;
153		procedure SetSQLData(AValue: PByte; len: cardinal); override;
#	Line 161 | Line 167 | type
167		procedure Initialize; override;
168
169		property Statement: TFB25Statement read FStatement;
170	+	property SQLType: cardinal read GetSQLType write SetSQLType;
171		end;
172
173		TIBXINPUTSQLDA = class;
#	Line 177 | Line 184 | type
184		function GetXSQLDA: PXSQLDA;
185		protected
186		FStatement: TFB25Statement;
187	+	FFirebird25ClientAPI: TFB25ClientAPI;
188		function GetTransactionSeqNo: integer; override;
189		procedure FreeXSQLDA;
190		function GetStatement: IStatement; override;
#	Line 241 | Line 249 | type
249		private
250		FDBHandle: TISC_DB_HANDLE;
251		FHandle: TISC_STMT_HANDLE;
252	+	FFirebird25ClientAPI: TFB25ClientAPI;
253		FSQLParams: TIBXINPUTSQLDA;
254		FSQLRecord: TIBXOUTPUTSQLDA;
255		FCursor: AnsiString;               { Cursor name...}
#	Line 252 | Line 261 | type
261		procedure InternalPrepare; override;
262		function InternalExecute(aTransaction: ITransaction): IResults; override;
263		function InternalOpenCursor(aTransaction: ITransaction): IResultSet; override;
264	+	procedure ProcessSQL(sql: AnsiString; GenerateParamNames: boolean; var processedSQL: AnsiString); override;
265		procedure FreeHandle; override;
266		procedure InternalClose(Force: boolean); override;
267		public
268		constructor Create(Attachment: TFB25Attachment; Transaction: ITransaction;
269		sql: AnsiString; aSQLDialect: integer);
270		constructor CreateWithParameterNames(Attachment: TFB25Attachment;
271	<	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean);
271	>	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
272	>	CaseSensitiveParams: boolean=false);
273		destructor Destroy; override;
274		function FetchNext: boolean;
275
#	Line 335 | Line 346 | begin
346		SQL_BLOB:
347		if (SQLSubType = 1)  then
348		{see http://firebirdsql.org/rlsnotesh/rlsnotes210.html}
349	<	result := FXSQLVAR^.sqlscale;
349	>	result := FXSQLVAR^.sqlscale and $FF;
350
351		SQL_ARRAY:
352		if (GetRelationName <> '') and (GetFieldName <> '') then
#	Line 346 | Line 357 | end;
357		function TIBXSQLVAR.GetCodePage: TSystemCodePage;
358		begin
359		result := CP_NONE;
360	<	with FirebirdClientAPI do
360	>	with Statement.GetAttachment do
361		CharSetID2CodePage(GetCharSetID,result);
362		end;
363
364	+	function TIBXSQLVAR.GetCharSetWidth: integer;
365	+	begin
366	+	result := 1;
367	+	with Statement.GetAttachment DO
368	+	CharSetWidth(GetCharSetID,result);
369	+	end;
370	+
371		function TIBXSQLVAR.GetIsNull: Boolean;
372		begin
373		result := IsNullable and (FNullIndicator = -1);
#	Line 370 | Line 388 | begin
388		Result := FXSQLVAR^.sqllen;
389		end;
390
391	+	function TIBXSQLVAR.GetSize: cardinal;
392	+	begin
393	+	Result := FMetadataSize;
394	+	end;
395	+
396	+	function TIBXSQLVAR.GetAttachment: IAttachment;
397	+	begin
398	+	Result := FStatement.GetAttachment;
399	+	end;
400	+
401		function TIBXSQLVAR.GetArrayMetaData: IArrayMetaData;
402		begin
403		if GetSQLType <> SQL_ARRAY then
#	Line 441 | Line 469 | procedure TIBXSQLVAR.Initialize;
469		begin
470		inherited Initialize;
471		FOwnsSQLData := true;
472	<	with FirebirdClientAPI, FXSQLVar^ do
472	>	with FFirebird25ClientAPI, FXSQLVar^ do
473		begin
474	+	FMetadataSize := sqllen;
475		case sqltype and (not 1) of
476		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
477		SQL_BLOB, SQL_ARRAY, SQL_QUAD, SQL_SHORT, SQL_BOOLEAN,
#	Line 502 | Line 531 | begin
531		FXSQLVAR^.sqlind := nil;
532		end;
533		end;
534	+	Changed;
535		end;
536
537		procedure TIBXSQLVAR.SetSQLData(AValue: PByte; len: cardinal);
#	Line 511 | Line 541 | begin
541		FXSQLVAR^.sqldata := AValue;
542		FXSQLVAR^.sqllen := len;
543		FOwnsSQLData := false;
544	+	Changed;
545		end;
546
547		procedure TIBXSQLVAR.SetScale(aValue: integer);
548		begin
549		FXSQLVAR^.sqlscale := aValue;
550	+	Changed;
551		end;
552
553		procedure TIBXSQLVAR.SetDataLength(len: cardinal);
#	Line 523 | Line 555 | begin
555		if not FOwnsSQLData then
556		FXSQLVAR^.sqldata := nil;
557		FXSQLVAR^.sqllen := len;
558	<	with FirebirdClientAPI do
558	>	with FFirebird25ClientAPI do
559		IBAlloc(FXSQLVAR^.sqldata, 0, FXSQLVAR^.sqllen);
560		FOwnsSQLData := true;
561	+	Changed;
562		end;
563
564		procedure TIBXSQLVAR.SetSQLType(aValue: cardinal);
565		begin
566		FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
567	+	Changed;
568		end;
569
570		procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
571		begin
572		if aValue <> GetCharSetID then
573	<	case SQLType of
574	<	SQL_VARYING, SQL_TEXT:
575	<	FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
576	<
577	<	SQL_BLOB,
578	<	SQL_ARRAY:
579	<	IBError(ibxeInvalidDataConversion,[nil]);
573	>	begin
574	>	case SQLType of
575	>	SQL_VARYING, SQL_TEXT:
576	>	FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
577	>
578	>	SQL_BLOB,
579	>	SQL_ARRAY:
580	>	IBError(ibxeInvalidDataConversion,[nil]);
581	>	end;
582	>	Changed;
583		end;
584		end;
585
586	+	function TIBXSQLVAR.GetDefaultTextSQLType: cardinal;
587	+	begin
588	+	Result := SQL_TEXT;
589	+	end;
590	+
591		constructor TIBXSQLVAR.Create(aParent: TIBXSQLDA; aIndex: integer);
592		begin
593		inherited Create(aParent,aIndex);
594		FStatement := aParent.Statement;
595	+	FFirebird25ClientAPI := aParent.FFirebird25ClientAPI;
596		end;
597
598		procedure TIBXSQLVAR.FreeSQLData;
#	Line 620 | Line 663 | procedure TIBXINPUTSQLDA.Bind;
663		begin
664		if Count = 0 then
665		Count := 1;
666	<	with Firebird25ClientAPI do
666	>	with FFirebird25ClientAPI do
667		begin
668		if (FXSQLDA <> nil) then
669		if isc_dsql_describe_bind(StatusVector, @(FStatement.Handle), FStatement.SQLDialect,
#	Line 652 | Line 695 | procedure TIBXOUTPUTSQLDA.Bind;
695		begin
696		{ Allocate an initial output descriptor (with one column) }
697		Count := 1;
698	<	with Firebird25ClientAPI do
698	>	with FFirebird25ClientAPI do
699		begin
700		{ Using isc_dsql_describe, get the right size for the columns... }
701		if isc_dsql_describe(StatusVector, @(FStatement.Handle), FStatement.SQLDialect, FXSQLDA) > 0 then
#	Line 687 | Line 730 | begin
730		len := sqllen;
731		if not IsNull and ((sqltype and (not 1)) = SQL_VARYING) then
732		begin
733	<	with FirebirdClientAPI do
733	>	with FFirebird25ClientAPI do
734		len := DecodeInteger(data,2);
735		Inc(data,2);
736		end;
#	Line 704 | Line 747 | constructor TIBXSQLDA.Create(aStatement:
747		begin
748		inherited Create;
749		FStatement := aStatement;
750	+	FFirebird25ClientAPI := aStatement.FFirebird25ClientAPI;
751		FSize := 0;
752		//  writeln('Creating ',ClassName);
753		end;
#	Line 790 | Line 834 | begin
834		OldSize := 0;
835		if Count > FSize then
836		begin
837	<	Firebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
837	>	FFirebird25ClientAPI.IBAlloc(FXSQLDA, OldSize, XSQLDA_LENGTH(Count));
838		SetLength(FColumnList, FCount);
839		FXSQLDA^.version := SQLDA_VERSION1;
840		p := @FXSQLDA^.sqlvar[0];
#	Line 888 | Line 932 | end;
932		procedure TFB25Statement.GetDsqlInfo(info_request: byte; buffer: ISQLInfoResults
933		);
934		begin
935	<	with Firebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
935	>	with FFirebird25ClientAPI, buffer as TSQLInfoResultsBuffer do
936		if isc_dsql_sql_info(StatusVector, @(FHandle), 1, @info_request,
937		GetBufSize, Buffer) > 0 then
938		IBDatabaseError;
#	Line 905 | Line 949 | begin
949		IBError(ibxeEmptyQuery, [nil]);
950		try
951		CheckTransaction(FTransactionIntf);
952	<	with Firebird25ClientAPI do
952	>	with FFirebird25ClientAPI do
953		begin
954		Call(isc_dsql_alloc_statement2(StatusVector, @(FDBHandle),
955		@FHandle), True);
#	Line 913 | Line 957 | begin
957		if FHasParamNames then
958		begin
959		if FProcessedSQL = '' then
960	<	FSQLParams.PreprocessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
960	>	ProcessSQL(FSQL,FGenerateParamNames,FProcessedSQL);
961		Call(isc_dsql_prepare(StatusVector, @(TRHandle), @FHandle, 0,
962		PAnsiChar(FProcessedSQL), FSQLDialect, nil), True);
963		end
#	Line 957 | Line 1001 | begin
1001		if (FHandle <> nil) then
1002		FreeHandle;
1003		if E is EIBInterBaseError then
1004	<	raise EIBInterBaseError.Create(EIBInterBaseError(E).SQLCode,
1005	<	EIBInterBaseError(E).IBErrorCode,
962	<	EIBInterBaseError(E).Message +
963	<	sSQLErrorSeparator + FSQL)
964	<	else
965	<	raise;
1004	>	E.Message := E.Message + sSQLErrorSeparator + FSQL;
1005	>	raise;
1006		end;
1007		end;
1008		FPrepared := true;
#	Line 994 | Line 1034 | begin
1034		CheckHandle;
1035		if aTransaction <> FTransactionIntf then
1036		AddMonitor(aTransaction as TFB25Transaction);
1037	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1037	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1038		IBError(ibxeInterfaceOutofDate,[nil]);
1039
1040		try
1041		TRHandle := (aTransaction as TFB25Transaction).Handle;
1042	<	with Firebird25ClientAPI do
1042	>	with FFirebird25ClientAPI do
1043		begin
1044		if FCollectStatistics then
1045		GetPerfCounters(FBeforeStats);
#	Line 1038 | Line 1078 | begin
1078		RemoveMonitor(aTransaction as TFB25Transaction);
1079		end;
1080		FExecTransactionIntf := aTransaction;
1081	+	FSQLRecord.FTransaction := aTransaction as TFB25Transaction;
1082	+	FSQLRecord.FTransactionSeqNo := FSQLRecord.FTransaction.TransactionSeqNo;
1083		Inc(FChangeSeqNo);
1084		end;
1085
#	Line 1055 | Line 1097 | begin
1097		CheckHandle;
1098		if aTransaction <> FTransactionIntf then
1099		AddMonitor(aTransaction as TFB25Transaction);
1100	<	if (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1100	>	if FStaleReferenceChecks and (FSQLParams.FTransactionSeqNo < (FTransactionIntf as TFB25transaction).TransactionSeqNo) then
1101		IBError(ibxeInterfaceOutofDate,[nil]);
1102
1103	<	with Firebird25ClientAPI do
1103	>	with FFirebird25ClientAPI do
1104		begin
1105		if FCollectStatistics then
1106		GetPerfCounters(FBeforeStats);
#	Line 1097 | Line 1139 | begin
1139		Inc(FChangeSeqNo);
1140		end;
1141
1142	+	procedure TFB25Statement.ProcessSQL(sql: AnsiString; GenerateParamNames: boolean;
1143	+	var processedSQL: AnsiString);
1144	+	begin
1145	+	FSQLParams.PreprocessSQL(sql,GenerateParamNames, processedSQL);
1146	+	end;
1147	+
1148		procedure TFB25Statement.FreeHandle;
1149		var
1150		isc_res: ISC_STATUS;
#	Line 1105 | Line 1153 | begin
1153		ReleaseInterfaces;
1154		try
1155		if FHandle <> nil then
1156	<	with Firebird25ClientAPI do
1156	>	with FFirebird25ClientAPI do
1157		begin
1158		isc_res :=
1159		Call(isc_dsql_free_statement(StatusVector, @FHandle, DSQL_drop), False);
#	Line 1125 | Line 1173 | var
1173		begin
1174		if (FHandle <> nil) and (SQLStatementType = SQLSelect) and FOpen then
1175		try
1176	<	with Firebird25ClientAPI do
1176	>	with FFirebird25ClientAPI do
1177		begin
1178		isc_res := Call(
1179		isc_dsql_free_statement(StatusVector, @FHandle, DSQL_close),
#	Line 1150 | Line 1198 | constructor TFB25Statement.Create(Attach
1198		begin
1199		inherited Create(Attachment,Transaction,sql,aSQLDialect);
1200		FDBHandle := Attachment.Handle;
1201	+	FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1202	+	OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1203		FSQLParams := TIBXINPUTSQLDA.Create(self);
1204		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1205		InternalPrepare;
1206		end;
1207
1208	<	constructor TFB25Statement.CreateWithParameterNames(Attachment: TFB25Attachment;
1209	<	Transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1210	<	GenerateParamNames: boolean);
1208	>	constructor TFB25Statement.CreateWithParameterNames(
1209	>	Attachment: TFB25Attachment; Transaction: ITransaction; sql: AnsiString;
1210	>	aSQLDialect: integer; GenerateParamNames: boolean;
1211	>	CaseSensitiveParams: boolean);
1212		begin
1213		inherited CreateWithParameterNames(Attachment,Transaction,sql,aSQLDialect,GenerateParamNames);
1214		FDBHandle := Attachment.Handle;
1215	+	FFirebird25ClientAPI := Attachment.Firebird25ClientAPI;
1216	+	OnDatabaseError := FFirebird25ClientAPI.IBDataBaseError;
1217		FSQLParams := TIBXINPUTSQLDA.Create(self);
1218	+	FSQLParams.CaseSensitiveParams := CaseSensitiveParams;
1219		FSQLRecord := TIBXOUTPUTSQLDA.Create(self);
1220		InternalPrepare;
1221		end;
#	Line 1183 | Line 1237 | begin
1237		if FEOF then
1238		IBError(ibxeEOF,[nil]);
1239
1240	<	with Firebird25ClientAPI do
1240	>	with FFirebird25ClientAPI do
1241		begin
1242		{ Go to the next record... }
1243		fetch_res :=
#	Line 1209 | Line 1263 | begin
1263		FBOF := false;
1264		result := true;
1265		end;
1266	+	if FCollectStatistics then
1267	+	begin
1268	+	GetPerfCounters(FAfterStats);
1269	+	FStatisticsAvailable := true;
1270	+	end;
1271		end;
1272		FSQLRecord.RowChange;
1273		if FEOF then
#	Line 1241 | Line 1300 | begin
1300		result := ''
1301		else
1302		begin
1303	<	RB := TSQLInfoResultsBuffer.Create(4*4096);
1303	>	RB := TSQLInfoResultsBuffer.Create(FFirebird25ClientAPI,4*4096);
1304		GetDsqlInfo(isc_info_sql_get_plan,RB);
1305		if RB.Count > 0 then
1306		Result := RB[0].GetAsString;

Diff Legend

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