ViewVC Help

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

root/public/ibx/branches/udr/client/FBSQLData.pas

Comparing:
ibx/branches/journaling/fbintf/client/FBSQLData.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 2021 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 372 by tony, Wed Jan 5 16:20:22 2022 UTC

#	Line 129 | Line 129 | type
129		procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
130		var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
131		protected
132	–	function AdjustScale(Value: Int64; aScale: Integer): Double;
133	–	function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
134	–	function AdjustScaleToStr(Value: Int64; aScale: Integer): AnsiString;
135	–	function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
136	–	function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
137	–	function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
132		procedure CheckActive; virtual;
133		procedure CheckTZSupport;
134		function GetAttachment: IAttachment; virtual; abstract;
135	+	function GetTransaction: ITransaction; virtual; abstract;
136		function GetSQLDialect: integer; virtual; abstract;
137		function GetTimeZoneServices: IExTimeZoneServices; virtual;
138		procedure Changed; virtual;
#	Line 155 | Line 150 | type
150		property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
151		public
152		constructor Create(api: TFBClientAPI);
153	+	function CanChangeMetaData: boolean; virtual;
154		function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
155		function GetSQLTypeName: AnsiString; overload;
156		class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
157		function GetStrDataLength: short;
158	+	function getColMetadata: IParamMetaData; virtual; abstract;
159		function GetName: AnsiString; virtual; abstract;
160		function GetScale: integer; virtual; abstract; {Current Field Data scale}
161		function GetAsBoolean: boolean;
#	Line 179 | Line 176 | type
176		function GetAsQuad: TISC_QUAD;
177		function GetAsShort: short;
178		function GetAsString: AnsiString; virtual;
179	+	function GetAsNumeric: IFBNumeric;
180		function GetIsNull: Boolean; virtual;
181		function GetIsNullable: boolean; virtual;
182		function GetAsVariant: Variant;
#	Line 206 | Line 204 | type
204		procedure SetAsShort(Value: short); virtual;
205		procedure SetAsString(Value: AnsiString); virtual;
206		procedure SetAsVariant(Value: Variant);
207	<	procedure SetAsNumeric(Value: Int64; aScale: integer); virtual;
207	>	procedure SetAsNumeric(Value: IFBNumeric); virtual;
208		procedure SetAsBcd(aValue: tBCD); virtual;
209		procedure SetIsNull(Value: Boolean); virtual;
210		procedure SetIsNullable(Value: Boolean); virtual;
#	Line 248 | Line 246 | type
246		FUniqueRelationName: AnsiString;
247		FColumnList: array of TSQLVarData;
248		function GetStatement: IStatement; virtual; abstract;
249	+	function GetAttachment: IAttachment; virtual;
250	+	function GetTransaction: ITransaction; virtual;
251		function GetPrepareSeqNo: integer; virtual; abstract;
252		function GetTransactionSeqNo: integer; virtual; abstract;
253		procedure SetCount(aValue: integer); virtual; abstract;
#	Line 268 | Line 268 | type
268		write FCaseSensitiveParams; {Only used when IsInputDataArea true}
269		function CanChangeMetaData: boolean; virtual; abstract;
270		property Count: integer read GetCount;
271	<	property Column[index: integer]: TSQLVarData read GetColumn;
271	>	property Column[index: integer]: TSQLVarData read GetColumn; default;
272		property UniqueRelationName: AnsiString read FUniqueRelationName;
273		property Statement: IStatement read GetStatement;
274	+	property Attachment: IAttachment read GetAttachment;
275		property PrepareSeqNo: integer read GetPrepareSeqNo;
276	+	property Transaction: ITransaction read GetTransaction;
277		property TransactionSeqNo: integer read GetTransactionSeqNo;
278		end;
279
#	Line 290 | Line 292 | type
292		procedure SetName(AValue: AnsiString);
293		protected
294		FArrayIntf: IArray;
295	<	function GetAttachment: IAttachment; virtual; abstract;
295	>	function GetAttachment: IAttachment;
296	>	function GetTransaction: ITransaction;
297		function GetSQLType: cardinal; virtual; abstract;
298		function GetSubtype: integer; virtual; abstract;
299		function GetAliasName: AnsiString;  virtual; abstract;
#	Line 299 | Line 302 | type
302		function GetRelationName: AnsiString;  virtual; abstract;
303		function GetScale: integer; virtual; abstract;
304		function GetCharSetID: cardinal; virtual; abstract;
305	<	function GetCharSetWidth: integer; virtual; abstract;
306	<	function GetCodePage: TSystemCodePage; virtual; abstract;
305	>	function GetCharSetWidth: integer;
306	>	function GetCodePage: TSystemCodePage;
307		function GetIsNull: Boolean;   virtual; abstract;
308		function GetIsNullable: boolean; virtual; abstract;
309		function GetSQLData: PByte;  virtual; abstract;
310		function GetDataLength: cardinal; virtual; abstract; {current field length}
311		function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
312		function GetDefaultTextSQLType: cardinal; virtual; abstract;
313	+	procedure InternalSetSQLType(aValue: cardinal); virtual; abstract;
314	+	procedure InternalSetScale(aValue: integer); virtual; abstract;
315	+	procedure InternalSetDataLength(len: cardinal); virtual; abstract;
316		procedure SetIsNull(Value: Boolean); virtual; abstract;
317		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
318		procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
319	<	procedure SetScale(aValue: integer); virtual; abstract;
320	<	procedure SetDataLength(len: cardinal); virtual; abstract;
321	<	procedure SetSQLType(aValue: cardinal); virtual; abstract;
319	>	procedure SetScale(aValue: integer);
320	>	procedure SetDataLength(len: cardinal);
321	>	procedure SetSQLType(aValue: cardinal);
322		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
323		procedure SetMetaSize(aValue: cardinal); virtual;
324		public
325		constructor Create(aParent: TSQLDataArea; aIndex: integer);
326	+	function CanChangeMetaData: boolean;
327		procedure SetString(aValue: AnsiString);
328		procedure Changed; virtual;
329		procedure RowChange; virtual;
#	Line 339 | Line 346 | type
346		property Index: integer read FIndex;
347		property Name: AnsiString read FName write SetName;
348		property CharSetID: cardinal read GetCharSetID write SetCharSetID;
349	+	property CodePage: TSystemCodePage read GetCodePage;
350		property SQLType: cardinal read GetSQLType write SetSQLType;
351		property SQLSubtype: integer read GetSubtype;
352		property SQLData: PByte read GetSQLData;
#	Line 354 | Line 362 | type
362
363		{ TColumnMetaData }
364
365	<	TColumnMetaData = class(TSQLDataItem,IColumnMetaData)
365	>	TColumnMetaData = class(TSQLDataItem,IColumnMetaData,IParamMetaData)
366		private
367		FIBXSQLVAR: TSQLVarData;
368		FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
#	Line 362 | Line 370 | type
370		FChangeSeqNo: integer;
371		protected
372		procedure CheckActive; override;
365	–	function GetAttachment: IAttachment; override;
373		function SQLData: PByte; override;
374		function GetDataLength: cardinal; override;
375		function GetCodePage: TSystemCodePage; override;
#	Line 371 | Line 378 | type
378		constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
379		destructor Destroy; override;
380		function GetSQLDialect: integer; override;
381	+	function getColMetadata: IParamMetaData; override;
382
383		public
384		{IColumnMetaData}
#	Line 390 | Line 398 | type
398		function GetArrayMetaData: IArrayMetaData;
399		function GetBlobMetaData: IBlobMetaData;
400		function GetStatement: IStatement;
401	<	function GetTransaction: ITransaction; virtual;
401	>	function GetTransaction: ITransaction; override;
402	>	function GetAttachment: IAttachment; override;
403		property Name: AnsiString read GetName;
404		property Size: cardinal read GetSize;
405		property CharSetID: cardinal read getCharSetID;
#	Line 403 | Line 412 | type
412		{ TIBSQLData }
413
414		TIBSQLData = class(TColumnMetaData,ISQLData)
406	–	private
407	–	FTransaction: ITransaction;
415		protected
416		procedure CheckActive; override;
417		public
411	–	function GetTransaction: ITransaction; override;
418		function GetIsNull: Boolean; override;
419		function GetAsArray: IArray;
420		function GetAsBlob: IBlob; overload;
#	Line 454 | Line 460 | type
460		procedure SetSQLType(aValue: cardinal); override;
461		public
462		procedure Clear;
463	<	function getColMetadata: IParamMetaData;
463	>	function CanChangeMetaData: boolean; override;
464	>	function getColMetadata: IParamMetaData; override;
465		function GetModified: boolean; override;
466		function GetAsPointer: Pointer;
467		function GetAsString: AnsiString; override;
#	Line 487 | Line 494 | type
494		procedure SetAsQuad(AValue: TISC_QUAD);
495		procedure SetCharSetID(aValue: cardinal);
496		procedure SetAsBcd(aValue: tBCD);
497	+	procedure SetAsNumeric(aValue: IFBNumeric);
498
499		property AsBlob: IBlob read GetAsBlob write SetAsBlob;
500		property IsNullable: Boolean read GetIsNullable write SetIsNullable;
#	Line 530 | Line 538 | type
538		function ByName(Idx: AnsiString): ISQLParam ;
539		function GetModified: Boolean;
540		function GetHasCaseSensitiveParams: Boolean;
541	+	function GetStatement: IStatement;
542	+	function GetTransaction: ITransaction;
543	+	function GetAttachment: IAttachment;
544	+	procedure Clear;
545		end;
546
547		{ TResults }
#	Line 552 | Line 564 | type
564		function getSQLData(index: integer): ISQLData;
565		procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
566		function GetStatement: IStatement;
567	<	function GetTransaction: ITransaction; virtual;
567	>	function GetTransaction: ITransaction;
568	>	function GetAttachment: IAttachment;
569		procedure SetRetainInterfaces(aValue: boolean);
570		end;
571
572		implementation
573
574	<	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
574	>	uses FBMessages, variants, IBUtils, FBTransaction, FBNumeric, DateUtils;
575
576		{ TSQLParamMetaData }
577
#	Line 628 | Line 641 | begin
641		Result := Length(FColumnList);
642		end;
643
644	+	function TSQLDataArea.GetTransaction: ITransaction;
645	+	begin
646	+	Result := GetStatement.GetTransaction;
647	+	end;
648	+
649	+	function TSQLDataArea.GetAttachment: IAttachment;
650	+	begin
651	+	Result := GetStatement.GetAttachment;
652	+	end;
653	+
654		procedure TSQLDataArea.SetUniqueRelationName;
655		var
656		i: Integer;
#	Line 760 | Line 783 | begin
783		FName := AValue;
784		end;
785
786	+	function TSQLVarData.GetAttachment: IAttachment;
787	+	begin
788	+	Result := Parent.Attachment;
789	+	end;
790	+
791	+	function TSQLVarData.GetTransaction: ITransaction;
792	+	begin
793	+	Result := Parent.Transaction;
794	+	end;
795	+
796	+	function TSQLVarData.GetCharSetWidth: integer;
797	+	begin
798	+	result := 1;
799	+	GetAttachment.CharSetWidth(GetCharSetID,result);
800	+	end;
801	+
802	+	function TSQLVarData.GetCodePage: TSystemCodePage;
803	+	begin
804	+	result := CP_NONE;
805	+	GetAttachment.CharSetID2CodePage(GetCharSetID,result);
806	+	end;
807	+
808	+	procedure TSQLVarData.SetScale(aValue: integer);
809	+	begin
810	+	if aValue = Scale then
811	+	Exit;
812	+	if not CanChangeMetaData  then
813	+	IBError(ibxeScaleCannotBeChanged,[]);
814	+	InternalSetScale(aValue);
815	+	end;
816	+
817	+	procedure TSQLVarData.SetDataLength(len: cardinal);
818	+	begin
819	+	if len = DataLength then
820	+	Exit;
821	+	InternalSetDataLength(len);
822	+	end;
823	+
824	+	procedure TSQLVarData.SetSQLType(aValue: cardinal);
825	+	begin
826	+	if aValue = SQLType then
827	+	Exit;
828	+	if not CanChangeMetaData then
829	+	IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(SQLType),
830	+	TSQLDataItem.GetSQLTypeName(aValue)]);
831	+	InternalSetSQLType(aValue);
832	+	end;
833	+
834		procedure TSQLVarData.SetMetaSize(aValue: cardinal);
835		begin
836		//Ignore
#	Line 783 | Line 854 | begin
854		FUniqueName := true;
855		end;
856
857	+	function TSQLVarData.CanChangeMetaData: boolean;
858	+	begin
859	+	Result := Parent.CanChangeMetaData;
860	+	end;
861	+
862		procedure TSQLVarData.SetString(aValue: AnsiString);
863		begin
864		{we take full advantage here of reference counted strings. When setting a string
#	Line 793 | Line 869 | begin
869		FVarString := aValue;
870		if SQLType = SQL_BLOB then
871		SetMetaSize(GetAttachment.GetInlineBlobLimit);
872	<	SQLType := GetDefaultTextSQLType;
872	>	if CanChangeMetaData then
873	>	SQLType := GetDefaultTextSQLType
874	>	else
875	>	if Length(aValue) > DataLength then
876	>	IBError(ibxeStringOverflow,[Length(aValue),DataLength]);
877		Scale := 0;
878	+	if  (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
879	+	IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
880		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
881		end;
882
#	Line 874 | Line 956 | end;
956
957		{TSQLDataItem}
958
877	–	function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
878	–	var
879	–	Scaling : Int64;
880	–	i: Integer;
881	–	Val: Double;
882	–	begin
883	–	Scaling := 1; Val := Value;
884	–	if aScale > 0 then
885	–	begin
886	–	for i := 1 to aScale do
887	–	Scaling := Scaling * 10;
888	–	result := Val * Scaling;
889	–	end
890	–	else
891	–	if aScale < 0 then
892	–	begin
893	–	for i := -1 downto aScale do
894	–	Scaling := Scaling * 10;
895	–	result := Val / Scaling;
896	–	end
897	–	else
898	–	result := Val;
899	–	end;
900	–
901	–	function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
902	–	var
903	–	Scaling : Int64;
904	–	i: Integer;
905	–	Val: Int64;
906	–	begin
907	–	Scaling := 1; Val := Value;
908	–	if aScale > 0 then begin
909	–	for i := 1 to aScale do Scaling := Scaling * 10;
910	–	result := Val * Scaling;
911	–	end else if aScale < 0 then begin
912	–	for i := -1 downto aScale do Scaling := Scaling * 10;
913	–	result := Val div Scaling;
914	–	end else
915	–	result := Val;
916	–	end;
917	–
918	–	function TSQLDataItem.AdjustScaleToStr(Value: Int64; aScale: Integer
919	–	): AnsiString;
920	–	var Scaling : AnsiString;
921	–	i: Integer;
922	–	begin
923	–	Result := IntToStr(Value);
924	–	Scaling := '';
925	–	if aScale > 0 then
926	–	begin
927	–	for i := 1 to aScale do
928	–	Result := Result + '0';
929	–	end
930	–	else
931	–	if aScale < 0 then
932	–	{$IF declared(DefaultFormatSettings)}
933	–	with DefaultFormatSettings do
934	–	{$ELSE}
935	–	{$IF declared(FormatSettings)}
936	–	with FormatSettings do
937	–	{$IFEND}
938	–	{$IFEND}
939	–	begin
940	–	if Length(Result) > -aScale then
941	–	system.Insert(DecimalSeparator,Result,Length(Result) + aScale)
942	–	else
943	–	begin
944	–	Scaling := '0' + DecimalSeparator;
945	–	for i := -1 downto aScale + Length(Result) do
946	–	Scaling := Scaling + '0';
947	–	Result := Scaling + Result;
948	–	end;
949	–	end;
950	–	end;
951	–
952	–	function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
953	–	): Currency;
954	–	var
955	–	Scaling : Int64;
956	–	i : Integer;
957	–	FractionText, PadText, CurrText: AnsiString;
958	–	begin
959	–	Result := 0;
960	–	Scaling := 1;
961	–	PadText := '';
962	–	if aScale > 0 then
963	–	begin
964	–	for i := 1 to aScale do
965	–	Scaling := Scaling * 10;
966	–	result := Value * Scaling;
967	–	end
968	–	else
969	–	if aScale < 0 then
970	–	begin
971	–	for i := -1 downto aScale do
972	–	Scaling := Scaling * 10;
973	–	FractionText := IntToStr(abs(Value mod Scaling));
974	–	for i := Length(FractionText) to -aScale -1 do
975	–	PadText := '0' + PadText;
976	–	{$IF declared(DefaultFormatSettings)}
977	–	with DefaultFormatSettings do
978	–	{$ELSE}
979	–	{$IF declared(FormatSettings)}
980	–	with FormatSettings do
981	–	{$IFEND}
982	–	{$IFEND}
983	–	if Value < 0 then
984	–	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
985	–	else
986	–	CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
987	–	try
988	–	result := StrToCurr(CurrText);
989	–	except
990	–	on E: Exception do
991	–	IBError(ibxeInvalidDataConversion, [nil]);
992	–	end;
993	–	end
994	–	else
995	–	result := Value;
996	–	end;
997	–
959		function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
960		begin
961		{$IF declared(DefaultFormatSettings)}
#	Line 1092 | Line 1053 | begin
1053		end;
1054		end;
1055
1095	–	function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1096	–	): Int64;
1097	–	var
1098	–	Scaling : Int64;
1099	–	i : Integer;
1100	–	begin
1101	–	Result := 0;
1102	–	Scaling := 1;
1103	–	if aScale < 0 then
1104	–	begin
1105	–	for i := -1 downto aScale do
1106	–	Scaling := Scaling * 10;
1107	–	result := trunc(Value * Scaling);
1108	–	end
1109	–	else
1110	–	if aScale > 0 then
1111	–	begin
1112	–	for i := 1 to aScale do
1113	–	Scaling := Scaling * 10;
1114	–	result := trunc(Value / Scaling);
1115	–	end
1116	–	else
1117	–	result := trunc(Value);
1118	–	end;
1119	–
1120	–	function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
1121	–	): Int64;
1122	–	var
1123	–	Scaling : Int64;
1124	–	i : Integer;
1125	–	begin
1126	–	Result := 0;
1127	–	Scaling := 1;
1128	–	if aScale < 0 then
1129	–	begin
1130	–	for i := -1 downto aScale do
1131	–	Scaling := Scaling * 10;
1132	–	result := trunc(Value * Scaling);
1133	–	end
1134	–	else
1135	–	if aScale > 0 then
1136	–	begin
1137	–	for i := 1 to aScale do
1138	–	Scaling := Scaling * 10;
1139	–	result := trunc(Value / Scaling);
1140	–	end
1141	–	else
1142	–	result := trunc(Value);
1143	–	//  writeln('Adjusted ',Value,' to ',Result);
1144	–	end;
1145	–
1056		procedure TSQLDataItem.CheckActive;
1057		begin
1058		//Do nothing by default
#	Line 1209 | Line 1119 | begin
1119		FFirebirdClientAPI := api;
1120		end;
1121
1122	+	function TSQLDataItem.CanChangeMetaData: boolean;
1123	+	begin
1124	+	Result := false;
1125	+	end;
1126	+
1127		function TSQLDataItem.GetSQLTypeName: AnsiString;
1128		begin
1129		Result := GetSQLTypeName(GetSQLType);
#	Line 1284 | Line 1199 | begin
1199		end;
1200		end;
1201		SQL_SHORT:
1202	<	result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1203	<	Scale);
1202	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1203	>	Scale).getAsCurrency;
1204		SQL_LONG:
1205	<	result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1206	<	Scale);
1205	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1206	>	Scale).getAsCurrency;
1207		SQL_INT64:
1208	<	result := AdjustScaleToCurrency(PInt64(SQLData)^,
1209	<	Scale);
1208	>	result := NumericFromRawValues(PInt64(SQLData)^,
1209	>	Scale).getAsCurrency;
1210		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1211		result := Round(AsDouble);
1212
#	Line 1322 | Line 1237 | begin
1237		end;
1238		end;
1239		SQL_SHORT:
1240	<	result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1241	<	Scale);
1240	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1241	>	Scale).getAsInt64;
1242		SQL_LONG:
1243	<	result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1244	<	Scale);
1243	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1244	>	Scale).getAsInt64;
1245		SQL_INT64:
1246	<	result := AdjustScaleToInt64(PInt64(SQLData)^,
1247	<	Scale);
1246	>	result := NumericFromRawValues(PInt64(SQLData)^,
1247	>	Scale).getAsInt64;
1248		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1249		result := Round(AsDouble);
1250		else
#	Line 1458 | Line 1373 | begin
1373		end;
1374		end;
1375		SQL_SHORT:
1376	<	result := AdjustScale(Int64(PShort(SQLData)^),
1377	<	Scale);
1376	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1377	>	Scale).getAsDouble;
1378		SQL_LONG:
1379	<	result := AdjustScale(Int64(PLong(SQLData)^),
1380	<	Scale);
1379	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1380	>	Scale).getAsDouble;
1381		SQL_INT64:
1382	<	result := AdjustScale(PInt64(SQLData)^, Scale);
1382	>	result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1383		SQL_FLOAT:
1384		result := PFloat(SQLData)^;
1385		SQL_DOUBLE, SQL_D_FLOAT:
#	Line 1510 | Line 1425 | begin
1425		end;
1426		end;
1427		SQL_SHORT:
1428	<	result := Round(AdjustScale(Int64(PShort(SQLData)^),
1429	<	Scale));
1428	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1429	>	Scale).getAsInteger;
1430		SQL_LONG:
1431	<	result := Round(AdjustScale(Int64(PLong(SQLData)^),
1432	<	Scale));
1431	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1432	>	Scale).getAsInteger;
1433		SQL_INT64:
1434	<	result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1434	>	result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1435	>
1436		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1437		result := Round(AsDouble);
1438		SQL_DEC_FIXED,
#	Line 1731 | Line 1647 | begin
1647		result := Int128ToStr(SQLData,scale);
1648
1649		else
1650	<	IBError(ibxeInvalidDataConversion, [nil]);
1650	>	IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1651		end;
1652		end;
1653
1654	+	function TSQLDataItem.GetAsNumeric: IFBNumeric;
1655	+	var aValue: Int64;
1656	+	begin
1657	+	case SQLType of
1658	+	SQL_TEXT, SQL_VARYING:
1659	+	Result := NewNumeric(GetAsString);
1660	+
1661	+	SQL_SHORT:
1662	+	Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1663	+
1664	+	SQL_LONG:
1665	+	Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1666	+
1667	+	SQL_INT64:
1668	+	Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1669	+
1670	+	SQL_DEC16,
1671	+	SQL_DEC34,
1672	+	SQL_DEC_FIXED,
1673	+	SQL_INT128:
1674	+	Result := NewNumeric(GetAsBCD);
1675	+
1676	+	else
1677	+	IBError(ibxeInvalidDataConversion, [nil]);
1678	+	end;
1679	+	end;
1680	+
1681		function TSQLDataItem.GetIsNull: Boolean;
1682		begin
1683		CheckActive;
#	Line 1873 | Line 1816 | begin
1816		if GetSQLDialect < 3 then
1817		AsDouble := Value
1818		else
1819	+	if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1820	+	SetAsNumeric(NewNumeric(Value))
1821	+	else
1822		begin
1823		Changing;
1824		if IsNullable then
#	Line 1888 | Line 1834 | end;
1834		procedure TSQLDataItem.SetAsInt64(Value: Int64);
1835		begin
1836		CheckActive;
1837	<	Changing;
1838	<	if IsNullable then
1839	<	IsNull := False;
1837	>	if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1838	>	SetAsNumeric(NewNumeric(Value))
1839	>	else
1840	>	begin
1841	>	Changing;
1842	>	if IsNullable then
1843	>	IsNull := False;
1844
1845	<	SQLType := SQL_INT64;
1846	<	Scale := 0;
1847	<	DataLength := SizeOf(Int64);
1848	<	PInt64(SQLData)^ := Value;
1849	<	Changed;
1845	>	SQLType := SQL_INT64;
1846	>	Scale := 0;
1847	>	DataLength := SizeOf(Int64);
1848	>	PInt64(SQLData)^ := Value;
1849	>	Changed;
1850	>	end;
1851		end;
1852
1853		procedure TSQLDataItem.SetAsDate(Value: TDateTime);
#	Line 2059 | Line 2010 | end;
2010		procedure TSQLDataItem.SetAsLong(Value: Long);
2011		begin
2012		CheckActive;
2013	<	if IsNullable then
2014	<	IsNull := False;
2013	>	if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2014	>	SetAsNumeric(NewNumeric(Value))
2015	>	else
2016	>	begin
2017	>	if IsNullable then
2018	>	IsNull := False;
2019
2020	<	Changing;
2021	<	SQLType := SQL_LONG;
2022	<	DataLength := SizeOf(Long);
2023	<	Scale := 0;
2024	<	PLong(SQLData)^ := Value;
2025	<	Changed;
2020	>	Changing;
2021	>	SQLType := SQL_LONG;
2022	>	DataLength := SizeOf(Long);
2023	>	Scale := 0;
2024	>	PLong(SQLData)^ := Value;
2025	>	Changed;
2026	>	end;
2027		end;
2028
2029		procedure TSQLDataItem.SetAsPointer(Value: Pointer);
#	Line 2102 | Line 2058 | end;
2058		procedure TSQLDataItem.SetAsShort(Value: short);
2059		begin
2060		CheckActive;
2061	<	Changing;
2062	<	if IsNullable then
2063	<	IsNull := False;
2061	>	if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2062	>	SetAsNumeric(NewNumeric(Value))
2063	>	else
2064	>	begin
2065	>	Changing;
2066	>	if IsNullable then
2067	>	IsNull := False;
2068
2069	<	SQLType := SQL_SHORT;
2070	<	DataLength := SizeOf(Short);
2071	<	Scale := 0;
2072	<	PShort(SQLData)^ := Value;
2073	<	Changed;
2069	>	SQLType := SQL_SHORT;
2070	>	DataLength := SizeOf(Short);
2071	>	Scale := 0;
2072	>	PShort(SQLData)^ := Value;
2073	>	Changed;
2074	>	end;
2075		end;
2076
2077		procedure TSQLDataItem.SetAsString(Value: AnsiString);
#	Line 2130 | Line 2091 | begin
2091		varEmpty, varNull:
2092		IsNull := True;
2093		varSmallint, varInteger, varByte,
2094	<	varWord, varShortInt:
2095	<	AsLong := Value;
2135	<	varInt64:
2136	<	AsInt64 := Value;
2094	>	varWord, varShortInt, varInt64:
2095	>	SetAsNumeric(NewNumeric(Int64(Value)));
2096		varSingle, varDouble:
2097		AsDouble := Value;
2098		varCurrency:
2099	<	AsCurrency := Value;
2099	>	SetAsNumeric(NewNumeric(Currency(Value)));
2100		varBoolean:
2101		AsBoolean := Value;
2102		varDate:
#	Line 2156 | Line 2115 | begin
2115		end;
2116		end;
2117
2118	<	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2118	>	procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2119		begin
2120		CheckActive;
2121		Changing;
2122		if IsNullable then
2123		IsNull := False;
2124
2125	<	SQLType := SQL_INT64;
2126	<	Scale := aScale;
2127	<	DataLength := SizeOf(Int64);
2128	<	PInt64(SQLData)^ := Value;
2125	>	if CanChangeMetadata then
2126	>	begin
2127	>	{Restore original values}
2128	>	SQLType := getColMetadata.GetSQLType;
2129	>	Scale := getColMetadata.getScale;
2130	>	SetDataLength(getColMetadata.GetSize);
2131	>	end;
2132	>
2133	>	with FFirebirdClientAPI do
2134	>	case GetSQLType of
2135	>	SQL_LONG:
2136	>	PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
2137	>	SQL_SHORT:
2138	>	PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
2139	>	SQL_INT64:
2140	>	PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
2141	>	SQL_TEXT, SQL_VARYING:
2142	>	SetAsString(Value.getAsString);
2143	>	SQL_D_FLOAT,
2144	>	SQL_DOUBLE:
2145	>	PDouble(SQLData)^ := Value.getAsDouble;
2146	>	SQL_FLOAT:
2147	>	PSingle(SQLData)^ := Value.getAsDouble;
2148	>	SQL_DEC_FIXED,
2149	>	SQL_DEC16,
2150	>	SQL_DEC34:
2151	>	SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2152	>	SQL_INT128:
2153	>	StrToInt128(Scale,Value.getAsString,SQLData);
2154	>	else
2155	>	IBError(ibxeInvalidDataConversion, [nil]);
2156	>	end;
2157		Changed;
2158		end;
2159
#	Line 2177 | Line 2164 | begin
2164		if IsNullable then
2165		IsNull := False;
2166
2167	+	if not CanChangeMetaData then
2168	+	begin
2169	+	SetAsNumeric(NewNumeric(aValue));
2170	+	Exit;
2171	+	end;
2172
2173		with FFirebirdClientAPI do
2174		if aValue.Precision <= 16 then
#	Line 2246 | Line 2238 | end;
2238
2239		function TColumnMetaData.GetAttachment: IAttachment;
2240		begin
2241	<	Result := GetStatement.GetAttachment;
2241	>	Result := FIBXSQLVAR.GetAttachment;
2242		end;
2243
2244		function TColumnMetaData.SQLData: PByte;
#	Line 2266 | Line 2258 | end;
2258
2259		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2260		begin
2261	<	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2261	>	inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2262		FIBXSQLVAR := aIBXSQLVAR;
2263		FOwner := aOwner;
2264		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 2282 | Line 2274 | end;
2274
2275		function TColumnMetaData.GetSQLDialect: integer;
2276		begin
2277	<	Result := FIBXSQLVAR.Statement.GetSQLDialect;
2277	>	Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2278	>	end;
2279	>
2280	>	function TColumnMetaData.getColMetadata: IParamMetaData;
2281	>	begin
2282	>	Result := self;
2283		end;
2284
2285		function TColumnMetaData.GetIndex: integer;
#	Line 2381 | Line 2378 | end;
2378
2379		function TColumnMetaData.GetTransaction: ITransaction;
2380		begin
2381	<	Result := GetStatement.GetTransaction;
2381	>	Result := FIBXSQLVAR.GetTransaction;
2382		end;
2383
2384		{ TIBSQLData }
#	Line 2403 | Line 2400 | begin
2400		IBError(ibxeBOF,[nil]);
2401		end;
2402
2406	–	function TIBSQLData.GetTransaction: ITransaction;
2407	–	begin
2408	–	if FTransaction = nil then
2409	–	Result := inherited GetTransaction
2410	–	else
2411	–	Result := FTransaction;
2412	–	end;
2413	–
2403		function TIBSQLData.GetIsNull: Boolean;
2404		begin
2405		CheckActive;
#	Line 2473 | Line 2462 | begin
2462		if IsNullable then
2463		IsNull := False;
2464		with FFirebirdClientAPI do
2465	<	case getColMetaData.SQLTYPE of
2465	>	case SQLTYPE of
2466		SQL_BOOLEAN:
2467		if AnsiCompareText(Value,STrue) = 0 then
2468		AsBoolean := true
#	Line 2503 | Line 2492 | begin
2492		SQL_LONG,
2493		SQL_INT64:
2494		if TryStrToNumeric(Value,Int64Value,aScale) then
2495	<	SetAsNumeric(Int64Value,aScale)
2495	>	SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2496		else
2497		DoSetString;
2498
#	Line 2512 | Line 2501 | begin
2501		SQL_DEC34,
2502		SQL_INT128:
2503		if TryStrToBCD(Value,BCDValue) then
2504	<	SetAsBCD(BCDValue)
2504	>	SetAsNumeric(NewNumeric(BCDValue))
2505		else
2506		DoSetString;
2507
#	Line 2520 | Line 2509 | begin
2509		SQL_DOUBLE,
2510		SQL_FLOAT:
2511		if TryStrToNumeric(Value,Int64Value,aScale) then
2512	<	SetAsDouble(NumericToDouble(Int64Value,aScale))
2512	>	SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2513		else
2514		DoSetString;
2515
#	Line 2595 | Line 2584 | begin
2584		IsNull := true;
2585		end;
2586
2587	+	function TSQLParam.CanChangeMetaData: boolean;
2588	+	begin
2589	+	Result := FIBXSQLVAR.CanChangeMetaData;
2590	+	end;
2591	+
2592		function TSQLParam.getColMetadata: IParamMetaData;
2593		begin
2594		Result := FIBXSQLVAR.getColMetadata;
#	Line 3150 | Line 3144 | begin
3144		end;
3145		end;
3146
3147	+	procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3148	+	var i: integer;
3149	+	OldSQLVar: TSQLVarData;
3150	+	begin
3151	+	if FIBXSQLVAR.UniqueName then
3152	+	inherited SetAsNumeric(AValue)
3153	+	else
3154	+	with FIBXSQLVAR.Parent do
3155	+	begin
3156	+	for i := 0 to Count - 1 do
3157	+	if Column[i].Name = Name then
3158	+	begin
3159	+	OldSQLVar := FIBXSQLVAR;
3160	+	FIBXSQLVAR := Column[i];
3161	+	try
3162	+	inherited SetAsNumeric(AValue);
3163	+	finally
3164	+	FIBXSQLVAR := OldSQLVar;
3165	+	end;
3166	+	end;
3167	+	end;
3168	+	end;
3169	+
3170		{ TMetaData }
3171
3172		procedure TMetaData.CheckActive;
#	Line 3171 | Line 3188 | end;
3188
3189		destructor TMetaData.Destroy;
3190		begin
3191	<	(FStatement as TInterfaceOwner).Remove(self);
3191	>	if FStatement <> nil then
3192	>	(FStatement as TInterfaceOwner).Remove(self);
3193		inherited Destroy;
3194		end;
3195
#	Line 3237 | Line 3255 | end;
3255
3256		destructor TSQLParams.Destroy;
3257		begin
3258	<	(FStatement as TInterfaceOwner).Remove(self);
3258	>	if FStatement <> nil then
3259	>	(FStatement as TInterfaceOwner).Remove(self);
3260		inherited Destroy;
3261		end;
3262
#	Line 3293 | Line 3312 | begin
3312		Result := FSQLParams.CaseSensitiveParams;
3313		end;
3314
3315	+	function TSQLParams.GetStatement: IStatement;
3316	+	begin
3317	+	Result := FSQLParams.GetStatement;
3318	+	end;
3319	+
3320	+	function TSQLParams.GetTransaction: ITransaction;
3321	+	begin
3322	+	Result := FSQLParams.GetTransaction;
3323	+	end;
3324	+
3325	+	function TSQLParams.GetAttachment: IAttachment;
3326	+	begin
3327	+	Result := FSQLParams.GetAttachment;
3328	+	end;
3329	+
3330	+	procedure TSQLParams.Clear;
3331	+	var i: integer;
3332	+	begin
3333	+	for i := 0 to getCount - 1 do
3334	+	getSQLParam(i).Clear;
3335	+	end;
3336	+
3337		{ TResults }
3338
3339		procedure TResults.CheckActive;
#	Line 3317 | Line 3358 | begin
3358		IBError(ibxeInvalidColumnIndex,[nil]);
3359
3360		if not HasInterface(aIBXSQLVAR.Index) then
3361	<	AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3362	<	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3363	<	col.FTransaction := GetTransaction;
3361	>	begin
3362	>	col := TIBSQLData.Create(self,aIBXSQLVAR);
3363	>	AddInterface(aIBXSQLVAR.Index, col);
3364	>	end
3365	>	else
3366	>	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3367		Result := col;
3368		end;
3369
#	Line 3384 | Line 3428 | end;
3428
3429		function TResults.GetTransaction: ITransaction;
3430		begin
3431	<	Result := FStatement.GetTransaction;
3431	>	Result := FResults.GetTransaction;
3432	>	end;
3433	>
3434	>	function TResults.GetAttachment: IAttachment;
3435	>	begin
3436	>	Result := FResults.GetAttachment;
3437		end;
3438
3439		procedure TResults.SetRetainInterfaces(aValue: boolean);

Diff Legend

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