ViewVC Help

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

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

Comparing:
ibx/trunk/fbintf/client/FBSQLData.pas (file contents), Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 371 by tony, Wed Jan 5 15:21:22 2022 UTC

#	Line 122 | Line 122 | type
122		private
123		FFirebirdClientAPI: TFBClientAPI;
124		FTimeZoneServices: IExTimeZoneServices;
125	–	function AdjustScale(Value: Int64; aScale: Integer): Double;
126	–	function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
127	–	function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
125		function GetDateFormatStr(IncludeTime: boolean): AnsiString;
126		function GetTimeFormatStr: AnsiString;
127		function GetTimestampFormatStr: AnsiString;
#	Line 132 | Line 129 | type
129		procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
130		var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
131		protected
135	–	function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
136	–	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 154 | 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 178 | 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 205 | 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);
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 247 | 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 267 | 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 288 | Line 291 | type
291		function GetStatement: IStatement;
292		procedure SetName(AValue: AnsiString);
293		protected
294	<	function GetAttachment: IAttachment; virtual; abstract;
294	>	FArrayIntf: IArray;
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 297 | 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;
330	<	function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
330	>	function GetAsArray: IArray; virtual; abstract;
331		function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
332		function CreateBlob: IBlob; virtual; abstract;
333		function GetArrayMetaData: IArrayMetaData; virtual; abstract;
#	Line 326 | Line 335 | type
335		function getColMetadata: IParamMetaData;
336		procedure Initialize; virtual;
337		procedure SaveMetaData;
338	+	procedure SetArray(AValue: IArray);
339
340		public
341		property AliasName: AnsiString read GetAliasName;
#	Line 336 | 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 351 | 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 359 | Line 370 | type
370		FChangeSeqNo: integer;
371		protected
372		procedure CheckActive; override;
362	–	function GetAttachment: IAttachment; override;
373		function SQLData: PByte; override;
374		function GetDataLength: cardinal; override;
375		function GetCodePage: TSystemCodePage; override;
#	Line 368 | 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 387 | 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 400 | Line 412 | type
412		{ TIBSQLData }
413
414		TIBSQLData = class(TColumnMetaData,ISQLData)
403	–	private
404	–	FTransaction: ITransaction;
415		protected
416		procedure CheckActive; override;
417		public
408	–	function GetTransaction: ITransaction; override;
418		function GetIsNull: Boolean; override;
419		function GetAsArray: IArray;
420		function GetAsBlob: IBlob; overload;
#	Line 451 | 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 484 | 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 527 | 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 549 | 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 625 | 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 757 | 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 767 | Line 841 | begin
841		FColMetaData := TSQLParamMetaData.Create(self);
842		end;
843
844	+	procedure TSQLVarData.SetArray(AValue: IArray);
845	+	begin
846	+	FArrayIntf := AValue;
847	+	end;
848	+
849		constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
850		begin
851		inherited Create;
#	Line 775 | 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 785 | 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		Scale := 0;
875	+	if  (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
876	+	IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
877		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
878		end;
879
#	Line 797 | Line 884 | end;
884
885		procedure TSQLVarData.RowChange;
886		begin
887	+	FArrayIntf := nil;
888		FModified := false;
889		FVarString := '';
890		end;
#	Line 865 | Line 953 | end;
953
954		{TSQLDataItem}
955
868	–	function TSQLDataItem.AdjustScale(Value: Int64; aScale: Integer): Double;
869	–	var
870	–	Scaling : Int64;
871	–	i: Integer;
872	–	Val: Double;
873	–	begin
874	–	Scaling := 1; Val := Value;
875	–	if aScale > 0 then
876	–	begin
877	–	for i := 1 to aScale do
878	–	Scaling := Scaling * 10;
879	–	result := Val * Scaling;
880	–	end
881	–	else
882	–	if aScale < 0 then
883	–	begin
884	–	for i := -1 downto aScale do
885	–	Scaling := Scaling * 10;
886	–	result := Val / Scaling;
887	–	end
888	–	else
889	–	result := Val;
890	–	end;
891	–
892	–	function TSQLDataItem.AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
893	–	var
894	–	Scaling : Int64;
895	–	i: Integer;
896	–	Val: Int64;
897	–	begin
898	–	Scaling := 1; Val := Value;
899	–	if aScale > 0 then begin
900	–	for i := 1 to aScale do Scaling := Scaling * 10;
901	–	result := Val * Scaling;
902	–	end else if aScale < 0 then begin
903	–	for i := -1 downto aScale do Scaling := Scaling * 10;
904	–	result := Val div Scaling;
905	–	end else
906	–	result := Val;
907	–	end;
908	–
909	–	function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
910	–	): Currency;
911	–	var
912	–	Scaling : Int64;
913	–	i : Integer;
914	–	FractionText, PadText, CurrText: AnsiString;
915	–	begin
916	–	Result := 0;
917	–	Scaling := 1;
918	–	PadText := '';
919	–	if aScale > 0 then
920	–	begin
921	–	for i := 1 to aScale do
922	–	Scaling := Scaling * 10;
923	–	result := Value * Scaling;
924	–	end
925	–	else
926	–	if aScale < 0 then
927	–	begin
928	–	for i := -1 downto aScale do
929	–	Scaling := Scaling * 10;
930	–	FractionText := IntToStr(abs(Value mod Scaling));
931	–	for i := Length(FractionText) to -aScale -1 do
932	–	PadText := '0' + PadText;
933	–	{$IF declared(DefaultFormatSettings)}
934	–	with DefaultFormatSettings do
935	–	{$ELSE}
936	–	{$IF declared(FormatSettings)}
937	–	with FormatSettings do
938	–	{$IFEND}
939	–	{$IFEND}
940	–	if Value < 0 then
941	–	CurrText := '-' + IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText
942	–	else
943	–	CurrText := IntToStr(Abs(Value div Scaling)) + DecimalSeparator + PadText + FractionText;
944	–	try
945	–	result := StrToCurr(CurrText);
946	–	except
947	–	on E: Exception do
948	–	IBError(ibxeInvalidDataConversion, [nil]);
949	–	end;
950	–	end
951	–	else
952	–	result := Value;
953	–	end;
954	–
956		function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
957		begin
958		{$IF declared(DefaultFormatSettings)}
#	Line 1049 | Line 1050 | begin
1050		end;
1051		end;
1052
1052	–	function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1053	–	): Int64;
1054	–	var
1055	–	Scaling : Int64;
1056	–	i : Integer;
1057	–	begin
1058	–	Result := 0;
1059	–	Scaling := 1;
1060	–	if aScale < 0 then
1061	–	begin
1062	–	for i := -1 downto aScale do
1063	–	Scaling := Scaling * 10;
1064	–	result := trunc(Value * Scaling);
1065	–	end
1066	–	else
1067	–	if aScale > 0 then
1068	–	begin
1069	–	for i := 1 to aScale do
1070	–	Scaling := Scaling * 10;
1071	–	result := trunc(Value / Scaling);
1072	–	end
1073	–	else
1074	–	result := trunc(Value);
1075	–	end;
1076	–
1077	–	function TSQLDataItem.AdjustScaleFromDouble(Value: Double; aScale: Integer
1078	–	): Int64;
1079	–	var
1080	–	Scaling : Int64;
1081	–	i : Integer;
1082	–	begin
1083	–	Result := 0;
1084	–	Scaling := 1;
1085	–	if aScale < 0 then
1086	–	begin
1087	–	for i := -1 downto aScale do
1088	–	Scaling := Scaling * 10;
1089	–	result := trunc(Value * Scaling);
1090	–	end
1091	–	else
1092	–	if aScale > 0 then
1093	–	begin
1094	–	for i := 1 to aScale do
1095	–	Scaling := Scaling * 10;
1096	–	result := trunc(Value / Scaling);
1097	–	end
1098	–	else
1099	–	result := trunc(Value);
1100	–	//  writeln('Adjusted ',Value,' to ',Result);
1101	–	end;
1102	–
1053		procedure TSQLDataItem.CheckActive;
1054		begin
1055		//Do nothing by default
#	Line 1166 | Line 1116 | begin
1116		FFirebirdClientAPI := api;
1117		end;
1118
1119	+	function TSQLDataItem.CanChangeMetaData: boolean;
1120	+	begin
1121	+	Result := false;
1122	+	end;
1123	+
1124		function TSQLDataItem.GetSQLTypeName: AnsiString;
1125		begin
1126		Result := GetSQLTypeName(GetSQLType);
#	Line 1241 | Line 1196 | begin
1196		end;
1197		end;
1198		SQL_SHORT:
1199	<	result := AdjustScaleToCurrency(Int64(PShort(SQLData)^),
1200	<	Scale);
1199	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1200	>	Scale).getAsCurrency;
1201		SQL_LONG:
1202	<	result := AdjustScaleToCurrency(Int64(PLong(SQLData)^),
1203	<	Scale);
1202	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1203	>	Scale).getAsCurrency;
1204		SQL_INT64:
1205	<	result := AdjustScaleToCurrency(PInt64(SQLData)^,
1206	<	Scale);
1205	>	result := NumericFromRawValues(PInt64(SQLData)^,
1206	>	Scale).getAsCurrency;
1207		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1208		result := Round(AsDouble);
1209
#	Line 1279 | Line 1234 | begin
1234		end;
1235		end;
1236		SQL_SHORT:
1237	<	result := AdjustScaleToInt64(Int64(PShort(SQLData)^),
1238	<	Scale);
1237	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1238	>	Scale).getAsInt64;
1239		SQL_LONG:
1240	<	result := AdjustScaleToInt64(Int64(PLong(SQLData)^),
1241	<	Scale);
1240	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1241	>	Scale).getAsInt64;
1242		SQL_INT64:
1243	<	result := AdjustScaleToInt64(PInt64(SQLData)^,
1244	<	Scale);
1243	>	result := NumericFromRawValues(PInt64(SQLData)^,
1244	>	Scale).getAsInt64;
1245		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1246		result := Round(AsDouble);
1247		else
#	Line 1415 | Line 1370 | begin
1370		end;
1371		end;
1372		SQL_SHORT:
1373	<	result := AdjustScale(Int64(PShort(SQLData)^),
1374	<	Scale);
1373	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1374	>	Scale).getAsDouble;
1375		SQL_LONG:
1376	<	result := AdjustScale(Int64(PLong(SQLData)^),
1377	<	Scale);
1376	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1377	>	Scale).getAsDouble;
1378		SQL_INT64:
1379	<	result := AdjustScale(PInt64(SQLData)^, Scale);
1379	>	result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsDouble;
1380		SQL_FLOAT:
1381		result := PFloat(SQLData)^;
1382		SQL_DOUBLE, SQL_D_FLOAT:
#	Line 1467 | Line 1422 | begin
1422		end;
1423		end;
1424		SQL_SHORT:
1425	<	result := Round(AdjustScale(Int64(PShort(SQLData)^),
1426	<	Scale));
1425	>	result := NumericFromRawValues(Int64(PShort(SQLData)^),
1426	>	Scale).getAsInteger;
1427		SQL_LONG:
1428	<	result := Round(AdjustScale(Int64(PLong(SQLData)^),
1429	<	Scale));
1428	>	result := NumericFromRawValues(Int64(PLong(SQLData)^),
1429	>	Scale).getAsInteger;
1430		SQL_INT64:
1431	<	result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1431	>	result := NumericFromRawValues(PInt64(SQLData)^, Scale).getAsInteger;
1432	>
1433		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1434		result := Round(AsDouble);
1435		SQL_DEC_FIXED,
#	Line 1570 | Line 1526 | end;
1526		function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1527		var i: integer;
1528		cplen: integer;
1573	–	s: AnsiString;
1529		begin
1530		Result := 0;
1576	–	s := strpas(p);
1531		for i := 1 to FieldWidth do
1532		begin
1533		cplen := UTF8CodepointSizeFull(p);
#	Line 1690 | Line 1644 | begin
1644		result := Int128ToStr(SQLData,scale);
1645
1646		else
1647	<	IBError(ibxeInvalidDataConversion, [nil]);
1647	>	IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1648		end;
1649		end;
1650
1651	+	function TSQLDataItem.GetAsNumeric: IFBNumeric;
1652	+	var aValue: Int64;
1653	+	begin
1654	+	case SQLType of
1655	+	SQL_TEXT, SQL_VARYING:
1656	+	Result := NewNumeric(GetAsString);
1657	+
1658	+	SQL_SHORT:
1659	+	Result := NumericFromRawValues(PShort(SQLData)^, Scale);
1660	+
1661	+	SQL_LONG:
1662	+	Result := NumericFromRawValues(PLong(SQLData)^, Scale);
1663	+
1664	+	SQL_INT64:
1665	+	Result := NumericFromRawValues(PInt64(SQLData)^, Scale);
1666	+
1667	+	SQL_DEC16,
1668	+	SQL_DEC34,
1669	+	SQL_DEC_FIXED,
1670	+	SQL_INT128:
1671	+	Result := NewNumeric(GetAsBCD);
1672	+
1673	+	else
1674	+	IBError(ibxeInvalidDataConversion, [nil]);
1675	+	end;
1676	+	end;
1677	+
1678		function TSQLDataItem.GetIsNull: Boolean;
1679		begin
1680		CheckActive;
#	Line 1832 | Line 1813 | begin
1813		if GetSQLDialect < 3 then
1814		AsDouble := Value
1815		else
1816	+	if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> -4)) then
1817	+	SetAsNumeric(NewNumeric(Value))
1818	+	else
1819		begin
1820		Changing;
1821		if IsNullable then
#	Line 1847 | Line 1831 | end;
1831		procedure TSQLDataItem.SetAsInt64(Value: Int64);
1832		begin
1833		CheckActive;
1834	<	Changing;
1835	<	if IsNullable then
1836	<	IsNull := False;
1834	>	if not CanChangeMetaData and ((SQLType <> SQL_INT64) or (Scale <> 0)) then
1835	>	SetAsNumeric(NewNumeric(Value))
1836	>	else
1837	>	begin
1838	>	Changing;
1839	>	if IsNullable then
1840	>	IsNull := False;
1841
1842	<	SQLType := SQL_INT64;
1843	<	Scale := 0;
1844	<	DataLength := SizeOf(Int64);
1845	<	PInt64(SQLData)^ := Value;
1846	<	Changed;
1842	>	SQLType := SQL_INT64;
1843	>	Scale := 0;
1844	>	DataLength := SizeOf(Int64);
1845	>	PInt64(SQLData)^ := Value;
1846	>	Changed;
1847	>	end;
1848		end;
1849
1850		procedure TSQLDataItem.SetAsDate(Value: TDateTime);
#	Line 2018 | Line 2007 | end;
2007		procedure TSQLDataItem.SetAsLong(Value: Long);
2008		begin
2009		CheckActive;
2010	<	if IsNullable then
2011	<	IsNull := False;
2010	>	if not CanChangeMetaData and ((SQLType <> SQL_LONG) or (Scale <> 0)) then
2011	>	SetAsNumeric(NewNumeric(Value))
2012	>	else
2013	>	begin
2014	>	if IsNullable then
2015	>	IsNull := False;
2016
2017	<	Changing;
2018	<	SQLType := SQL_LONG;
2019	<	DataLength := SizeOf(Long);
2020	<	Scale := 0;
2021	<	PLong(SQLData)^ := Value;
2022	<	Changed;
2017	>	Changing;
2018	>	SQLType := SQL_LONG;
2019	>	DataLength := SizeOf(Long);
2020	>	Scale := 0;
2021	>	PLong(SQLData)^ := Value;
2022	>	Changed;
2023	>	end;
2024		end;
2025
2026		procedure TSQLDataItem.SetAsPointer(Value: Pointer);
#	Line 2061 | Line 2055 | end;
2055		procedure TSQLDataItem.SetAsShort(Value: short);
2056		begin
2057		CheckActive;
2058	<	Changing;
2059	<	if IsNullable then
2060	<	IsNull := False;
2058	>	if not CanChangeMetaData and ((SQLType <> SQL_SHORT) or (Scale <> 0)) then
2059	>	SetAsNumeric(NewNumeric(Value))
2060	>	else
2061	>	begin
2062	>	Changing;
2063	>	if IsNullable then
2064	>	IsNull := False;
2065
2066	<	SQLType := SQL_SHORT;
2067	<	DataLength := SizeOf(Short);
2068	<	Scale := 0;
2069	<	PShort(SQLData)^ := Value;
2070	<	Changed;
2066	>	SQLType := SQL_SHORT;
2067	>	DataLength := SizeOf(Short);
2068	>	Scale := 0;
2069	>	PShort(SQLData)^ := Value;
2070	>	Changed;
2071	>	end;
2072		end;
2073
2074		procedure TSQLDataItem.SetAsString(Value: AnsiString);
#	Line 2089 | Line 2088 | begin
2088		varEmpty, varNull:
2089		IsNull := True;
2090		varSmallint, varInteger, varByte,
2091	<	varWord, varShortInt:
2092	<	AsLong := Value;
2094	<	varInt64:
2095	<	AsInt64 := Value;
2091	>	varWord, varShortInt, varInt64:
2092	>	SetAsNumeric(NewNumeric(Int64(Value)));
2093		varSingle, varDouble:
2094		AsDouble := Value;
2095		varCurrency:
2096	<	AsCurrency := Value;
2096	>	SetAsNumeric(NewNumeric(Currency(Value)));
2097		varBoolean:
2098		AsBoolean := Value;
2099		varDate:
#	Line 2115 | Line 2112 | begin
2112		end;
2113		end;
2114
2115	<	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
2115	>	procedure TSQLDataItem.SetAsNumeric(Value: IFBNumeric);
2116		begin
2117		CheckActive;
2118		Changing;
2119		if IsNullable then
2120		IsNull := False;
2121
2122	<	SQLType := SQL_INT64;
2123	<	Scale := aScale;
2124	<	DataLength := SizeOf(Int64);
2125	<	PInt64(SQLData)^ := Value;
2122	>	if CanChangeMetadata then
2123	>	begin
2124	>	{Restore original values}
2125	>	SQLType := getColMetadata.GetSQLType;
2126	>	Scale := getColMetadata.getScale;
2127	>	SetDataLength(getColMetadata.GetSize);
2128	>	end;
2129	>
2130	>	with FFirebirdClientAPI do
2131	>	case GetSQLType of
2132	>	SQL_LONG:
2133	>	PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
2134	>	SQL_SHORT:
2135	>	PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
2136	>	SQL_INT64:
2137	>	PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
2138	>	SQL_TEXT, SQL_VARYING:
2139	>	SetAsString(Value.getAsString);
2140	>	SQL_D_FLOAT,
2141	>	SQL_DOUBLE:
2142	>	PDouble(SQLData)^ := Value.getAsDouble;
2143	>	SQL_FLOAT:
2144	>	PSingle(SQLData)^ := Value.getAsDouble;
2145	>	SQL_DEC_FIXED,
2146	>	SQL_DEC16,
2147	>	SQL_DEC34:
2148	>	SQLDecFloatEncode(Value.getAsBCD,SQLType,SQLData);
2149	>	SQL_INT128:
2150	>	StrToInt128(Scale,Value.getAsString,SQLData);
2151	>	else
2152	>	IBError(ibxeInvalidDataConversion, [nil]);
2153	>	end;
2154		Changed;
2155		end;
2156
2157		procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2133	–	var C: Currency;
2158		begin
2159		CheckActive;
2160		Changing;
2161		if IsNullable then
2162		IsNull := False;
2163
2164	+	if not CanChangeMetaData then
2165	+	begin
2166	+	SetAsNumeric(NewNumeric(aValue));
2167	+	Exit;
2168	+	end;
2169
2170		with FFirebirdClientAPI do
2171		if aValue.Precision <= 16 then
#	Line 2206 | Line 2235 | end;
2235
2236		function TColumnMetaData.GetAttachment: IAttachment;
2237		begin
2238	<	Result := GetStatement.GetAttachment;
2238	>	Result := FIBXSQLVAR.GetAttachment;
2239		end;
2240
2241		function TColumnMetaData.SQLData: PByte;
#	Line 2226 | Line 2255 | end;
2255
2256		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
2257		begin
2258	<	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
2258	>	inherited Create(aIBXSQLVAR.GetAttachment.getFirebirdAPI as TFBClientAPI);
2259		FIBXSQLVAR := aIBXSQLVAR;
2260		FOwner := aOwner;
2261		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 2242 | Line 2271 | end;
2271
2272		function TColumnMetaData.GetSQLDialect: integer;
2273		begin
2274	<	Result := FIBXSQLVAR.Statement.GetSQLDialect;
2274	>	Result := FIBXSQLVAR.GetAttachment.GetSQLDialect;
2275	>	end;
2276	>
2277	>	function TColumnMetaData.getColMetadata: IParamMetaData;
2278	>	begin
2279	>	Result := self;
2280		end;
2281
2282		function TColumnMetaData.GetIndex: integer;
#	Line 2341 | Line 2375 | end;
2375
2376		function TColumnMetaData.GetTransaction: ITransaction;
2377		begin
2378	<	Result := GetStatement.GetTransaction;
2378	>	Result := FIBXSQLVAR.GetTransaction;
2379		end;
2380
2381		{ TIBSQLData }
#	Line 2363 | Line 2397 | begin
2397		IBError(ibxeBOF,[nil]);
2398		end;
2399
2366	–	function TIBSQLData.GetTransaction: ITransaction;
2367	–	begin
2368	–	if FTransaction = nil then
2369	–	Result := inherited GetTransaction
2370	–	else
2371	–	Result := FTransaction;
2372	–	end;
2373	–
2400		function TIBSQLData.GetIsNull: Boolean;
2401		begin
2402		CheckActive;
#	Line 2380 | Line 2406 | end;
2406		function TIBSQLData.GetAsArray: IArray;
2407		begin
2408		CheckActive;
2409	<	result := FIBXSQLVAR.GetAsArray(AsQuad);
2409	>	result := FIBXSQLVAR.GetAsArray;
2410		end;
2411
2412		function TIBSQLData.GetAsBlob: IBlob;
#	Line 2422 | Line 2448 | begin
2448		Changed;
2449		end;
2450
2425	–	function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
2426	–	var i: integer;
2427	–	ds: integer;
2428	–	begin
2429	–	Result := false;
2430	–	ds := 0;
2431	–	S := Trim(S);
2432	–	{$IF declared(DefaultFormatSettings)}
2433	–	with DefaultFormatSettings do
2434	–	{$ELSE}
2435	–	{$IF declared(FormatSettings)}
2436	–	with FormatSettings do
2437	–	{$IFEND}
2438	–	{$IFEND}
2439	–	begin
2440	–	{ThousandSeparator not allowed as by Delphi specs}
2441	–	if (ThousandSeparator <> DecimalSeparator) and
2442	–	(Pos(ThousandSeparator, S) <> 0) then
2443	–	Exit;
2444	–
2445	–	for i := length(S) downto 1 do
2446	–	begin
2447	–	if S[i] = AnsiChar(DecimalSeparator) then
2448	–	begin
2449	–	if ds <> 0 then Exit; {only one allowed}
2450	–	ds := i-1;
2451	–	system.Delete(S,i,1);
2452	–	end
2453	–	else
2454	–	if (i > 1) and (S[i] in ['+','-']) then
2455	–	Exit
2456	–	else
2457	–	if not (S[i] in ['0'..'9']) then
2458	–	Exit; {bad character}
2459	–
2460	–	end;
2461	–	if ds = 0 then
2462	–	scale := 0
2463	–	else
2464	–	scale := ds - Length(S);
2465	–	Result := TryStrToInt64(S,Value);
2466	–	end;
2467	–	end;
2468	–
2451		var b: IBlob;
2452		dt: TDateTime;
2453		timezone: AnsiString;
2472	–	{$ifdef FPC_HAS_TYPE_EXTENDED}
2473	–	FloatValue: Extended;
2474	–	{$else}
2475	–	FloatValue: Double;
2476	–	{$endif}
2454		Int64Value: Int64;
2455		BCDValue: TBCD;
2456		aScale: integer;
#	Line 2482 | Line 2459 | begin
2459		if IsNullable then
2460		IsNull := False;
2461		with FFirebirdClientAPI do
2462	<	case getColMetaData.SQLTYPE of
2462	>	case SQLTYPE of
2463		SQL_BOOLEAN:
2464		if AnsiCompareText(Value,STrue) = 0 then
2465		AsBoolean := true
#	Line 2512 | Line 2489 | begin
2489		SQL_LONG,
2490		SQL_INT64:
2491		if TryStrToNumeric(Value,Int64Value,aScale) then
2492	<	begin
2516	<	if aScale = 0 then
2517	<	SetAsInt64(Int64Value)
2518	<	else
2519	<	SetAsNumeric(Int64Value,aScale);
2520	<	end
2521	<	else
2522	<	if TryStrToFloat(Value,FloatValue) then
2523	<	SetAsDouble(FloatValue)
2492	>	SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
2493		else
2494		DoSetString;
2495
#	Line 2529 | Line 2498 | begin
2498		SQL_DEC34,
2499		SQL_INT128:
2500		if TryStrToBCD(Value,BCDValue) then
2501	<	SetAsBCD(BCDValue)
2501	>	SetAsNumeric(NewNumeric(BCDValue))
2502		else
2503		DoSetString;
2504
2505		SQL_D_FLOAT,
2506		SQL_DOUBLE,
2507		SQL_FLOAT:
2508	<	if TryStrToFloat(Value,FloatValue) then
2509	<	SetAsDouble(FloatValue)
2508	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2509	>	SetAsNumeric(NumericFromRawValues(Int64Value,AScale))
2510		else
2511		DoSetString;
2512
#	Line 2612 | Line 2581 | begin
2581		IsNull := true;
2582		end;
2583
2584	+	function TSQLParam.CanChangeMetaData: boolean;
2585	+	begin
2586	+	Result := FIBXSQLVAR.CanChangeMetaData;
2587	+	end;
2588	+
2589		function TSQLParam.getColMetadata: IParamMetaData;
2590		begin
2591		Result := FIBXSQLVAR.getColMetadata;
#	Line 2691 | Line 2665 | begin
2665		if not FIBXSQLVAR.UniqueName then
2666		IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2667
2668	+	FIBXSQLVAR.SetArray(anArray); {save array interface}
2669		SetAsQuad(AnArray.GetArrayID);
2670		end;
2671
#	Line 3166 | Line 3141 | begin
3141		end;
3142		end;
3143
3144	+	procedure TSQLParam.SetAsNumeric(aValue: IFBNumeric);
3145	+	var i: integer;
3146	+	OldSQLVar: TSQLVarData;
3147	+	begin
3148	+	if FIBXSQLVAR.UniqueName then
3149	+	inherited SetAsNumeric(AValue)
3150	+	else
3151	+	with FIBXSQLVAR.Parent do
3152	+	begin
3153	+	for i := 0 to Count - 1 do
3154	+	if Column[i].Name = Name then
3155	+	begin
3156	+	OldSQLVar := FIBXSQLVAR;
3157	+	FIBXSQLVAR := Column[i];
3158	+	try
3159	+	inherited SetAsNumeric(AValue);
3160	+	finally
3161	+	FIBXSQLVAR := OldSQLVar;
3162	+	end;
3163	+	end;
3164	+	end;
3165	+	end;
3166	+
3167		{ TMetaData }
3168
3169		procedure TMetaData.CheckActive;
#	Line 3187 | Line 3185 | end;
3185
3186		destructor TMetaData.Destroy;
3187		begin
3188	<	(FStatement as TInterfaceOwner).Remove(self);
3188	>	if FStatement <> nil then
3189	>	(FStatement as TInterfaceOwner).Remove(self);
3190		inherited Destroy;
3191		end;
3192
#	Line 3253 | Line 3252 | end;
3252
3253		destructor TSQLParams.Destroy;
3254		begin
3255	<	(FStatement as TInterfaceOwner).Remove(self);
3255	>	if FStatement <> nil then
3256	>	(FStatement as TInterfaceOwner).Remove(self);
3257		inherited Destroy;
3258		end;
3259
#	Line 3309 | Line 3309 | begin
3309		Result := FSQLParams.CaseSensitiveParams;
3310		end;
3311
3312	+	function TSQLParams.GetStatement: IStatement;
3313	+	begin
3314	+	Result := FSQLParams.GetStatement;
3315	+	end;
3316	+
3317	+	function TSQLParams.GetTransaction: ITransaction;
3318	+	begin
3319	+	Result := FSQLParams.GetTransaction;
3320	+	end;
3321	+
3322	+	function TSQLParams.GetAttachment: IAttachment;
3323	+	begin
3324	+	Result := FSQLParams.GetAttachment;
3325	+	end;
3326	+
3327	+	procedure TSQLParams.Clear;
3328	+	var i: integer;
3329	+	begin
3330	+	for i := 0 to getCount - 1 do
3331	+	getSQLParam(i).Clear;
3332	+	end;
3333	+
3334		{ TResults }
3335
3336		procedure TResults.CheckActive;
#	Line 3333 | Line 3355 | begin
3355		IBError(ibxeInvalidColumnIndex,[nil]);
3356
3357		if not HasInterface(aIBXSQLVAR.Index) then
3358	<	AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
3359	<	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3360	<	col.FTransaction := GetTransaction;
3358	>	begin
3359	>	col := TIBSQLData.Create(self,aIBXSQLVAR);
3360	>	AddInterface(aIBXSQLVAR.Index, col);
3361	>	end
3362	>	else
3363	>	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
3364		Result := col;
3365		end;
3366
#	Line 3400 | Line 3425 | end;
3425
3426		function TResults.GetTransaction: ITransaction;
3427		begin
3428	<	Result := FStatement.GetTransaction;
3428	>	Result := FResults.GetTransaction;
3429	>	end;
3430	>
3431	>	function TResults.GetAttachment: IAttachment;
3432	>	begin
3433	>	Result := FResults.GetAttachment;
3434		end;
3435
3436		procedure TResults.SetRetainInterfaces(aValue: boolean);

Diff Legend

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