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 314 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
Revision 315 by tony, Thu Feb 25 11:56:36 2021 UTC

#	Line 80 | Line 80 | unit FBSQLData;
80		interface
81
82		uses
83	<	Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI;
83	>	Classes, SysUtils, IBExternals, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI,
84	>	FmtBCD;
85
86		type
87
88	<	{ TSQLDataItem }
88	>	{The IExTimeZoneServices is only available in FB4 and onwards}
89	>
90	>	IExTimeZoneServices = interface(ITimeZoneServices)
91	>	['{789c2eeb-c4a7-4fed-837e-0cbdef775904}']
92	>	{encode/decode - used to encode/decode the wire protocol}
93	>	procedure EncodeTimestampTZ(timestamp: TDateTime; timezoneID: TFBTimeZoneID;
94	>	bufptr: PByte); overload;
95	>	procedure EncodeTimestampTZ(timestamp: TDateTime; timezone: AnsiString;
96	>	bufptr: PByte); overload;
97	>	procedure EncodeTimeTZ(time: TDateTime; timezoneID: TFBTimeZoneID; OnDate: TDateTime;
98	>	bufptr: PByte); overload;
99	>	procedure EncodeTimeTZ(time: TDateTime; timezone: AnsiString; OnDate: TDateTime;
100	>	bufptr: PByte); overload;
101	>	procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
102	>	var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
103	>	procedure DecodeTimestampTZ(bufptr: PByte; var timestamp: TDateTime;
104	>	var dstOffset: smallint; var timezone: AnsiString); overload;
105	>	procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
106	>	var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
107	>	procedure DecodeTimestampTZEx(bufptr: PByte; var timestamp: TDateTime;
108	>	var dstOffset: smallint; var timezone: AnsiString); overload;
109	>	procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
110	>	var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
111	>	procedure DecodeTimeTZ(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
112	>	var dstOffset: smallint; var timezone: AnsiString); overload;
113	>	procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
114	>	var dstOffset: smallint; var timezoneID: TFBTimeZoneID); overload;
115	>	procedure DecodeTimeTZEx(bufptr: PByte; OnDate: TDateTime; var time: TDateTime;
116	>	var dstOffset: smallint; var timezone: AnsiString); overload;
117	>	end;
118	>
119	>	{ TSQLDataItem }
120
121		TSQLDataItem = class(TFBInterfacedObject)
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;
95	–	function GetTimestampFormatStr: AnsiString;
128		function GetDateFormatStr(IncludeTime: boolean): AnsiString;
129		function GetTimeFormatStr: AnsiString;
130	+	function GetTimestampFormatStr: AnsiString;
131		procedure SetAsInteger(AValue: Integer);
132	+	procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
133	+	var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
134		protected
135		function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
136		function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
137		procedure CheckActive; virtual;
138	+	procedure CheckTZSupport;
139	+	function GetAttachment: IAttachment; virtual; abstract;
140		function GetSQLDialect: integer; virtual; abstract;
141	+	function GetTimeZoneServices: IExTimeZoneServices; virtual;
142		procedure Changed; virtual;
143		procedure Changing; virtual;
144		procedure InternalSetAsString(Value: AnsiString); virtual;
#	Line 113 | Line 151 | type
151		procedure SetDataLength(len: cardinal); virtual;
152		procedure SetSQLType(aValue: cardinal); virtual;
153		property DataLength: cardinal read GetDataLength write SetDataLength;
154	<
154	>	property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
155		public
156		constructor Create(api: TFBClientAPI);
157		function GetSQLType: cardinal; virtual; abstract;
#	Line 125 | Line 163 | type
163		function GetAsBoolean: boolean;
164		function GetAsCurrency: Currency;
165		function GetAsInt64: Int64;
166	<	function GetAsDateTime: TDateTime;
166	>	function GetAsDateTime: TDateTime; overload;
167	>	procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
168	>	procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
169	>	procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
170	>	procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
171	>	procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
172	>	procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
173	>	function GetAsUTCDateTime: TDateTime;
174		function GetAsDouble: Double;
175		function GetAsFloat: Float;
176		function GetAsLong: Long;
#	Line 138 | Line 183 | type
183		function GetAsVariant: Variant;
184		function GetModified: boolean; virtual;
185		function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
186	+	function GetAsBCD: tBCD;
187		function GetSize: cardinal; virtual; abstract;
188		function GetCharSetWidth: integer; virtual; abstract;
189		procedure SetAsBoolean(AValue: boolean); virtual;
#	Line 145 | Line 191 | type
191		procedure SetAsInt64(Value: Int64); virtual;
192		procedure SetAsDate(Value: TDateTime); virtual;
193		procedure SetAsLong(Value: Long); virtual;
194	<	procedure SetAsTime(Value: TDateTime); virtual;
195	<	procedure SetAsDateTime(Value: TDateTime);
194	>	procedure SetAsTime(Value: TDateTime); overload;
195	>	procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime;aTimeZoneID: TFBTimeZoneID); overload;
196	>	procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
197	>	procedure SetAsDateTime(Value: TDateTime); overload;
198	>	procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
199	>	procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
200	>	procedure SetAsUTCDateTime(aUTCTime: TDateTime);
201		procedure SetAsDouble(Value: Double); virtual;
202		procedure SetAsFloat(Value: Float); virtual;
203		procedure SetAsPointer(Value: Pointer);
#	Line 155 | Line 206 | type
206		procedure SetAsString(Value: AnsiString); virtual;
207		procedure SetAsVariant(Value: Variant);
208		procedure SetAsNumeric(Value: Int64; aScale: integer);
209	+	procedure SetAsBcd(aValue: tBCD); virtual;
210		procedure SetIsNull(Value: Boolean); virtual;
211		procedure SetIsNullable(Value: Boolean); virtual;
212		procedure SetName(aValue: AnsiString); virtual;
#	Line 247 | Line 299 | type
299		function GetIsNull: Boolean;   virtual; abstract;
300		function GetIsNullable: boolean; virtual; abstract;
301		function GetSQLData: PByte;  virtual; abstract;
302	<	function GetDataLength: cardinal; virtual; abstract;
302	>	function GetDataLength: cardinal; virtual; abstract; {current field length}
303	>	function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
304		procedure SetIsNull(Value: Boolean); virtual; abstract;
305		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
306		procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
#	Line 299 | Line 352 | type
352		FChangeSeqNo: integer;
353		protected
354		procedure CheckActive; override;
355	+	function GetAttachment: IAttachment; override;
356		function SQLData: PByte; override;
357		function GetDataLength: cardinal; override;
358		function GetCodePage: TSystemCodePage; override;
#	Line 355 | Line 409 | type
409
410		{ TSQLParam }
411
412	<	TSQLParam = class(TIBSQLData,ISQLParam)
412	>	TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
413		protected
414		procedure CheckActive; override;
415		procedure Changed; override;
#	Line 378 | Line 432 | type
432		procedure SetAsInt64(AValue: Int64);
433		procedure SetAsDate(AValue: TDateTime);
434		procedure SetAsLong(AValue: Long);
435	<	procedure SetAsTime(AValue: TDateTime);
436	<	procedure SetAsDateTime(AValue: TDateTime);
435	>	procedure SetAsTime(AValue: TDateTime); overload;
436	>	procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
437	>	procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
438	>	procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
439	>	procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
440	>	procedure SetAsDateTime(AValue: TDateTime); overload;
441	>	procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
442	>	procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
443		procedure SetAsDouble(AValue: Double);
444		procedure SetAsFloat(AValue: Float);
445		procedure SetAsPointer(AValue: Pointer);
#	Line 389 | Line 449 | type
449		procedure SetAsBlob(aValue: IBlob);
450		procedure SetAsQuad(AValue: TISC_QUAD);
451		procedure SetCharSetID(aValue: cardinal);
452	+	procedure SetAsBcd(aValue: tBCD);
453
454		property AsBlob: IBlob read GetAsBlob write SetAsBlob;
455		property IsNullable: Boolean read GetIsNullable write SetIsNullable;
#	Line 815 | Line 876 | begin
876		with FormatSettings do
877		{$IFEND}
878		{$IFEND}
879	<	Result := LongTimeFormat;
879	>	Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
880		end;
881
882		function TSQLDataItem.GetTimestampFormatStr: AnsiString;
#	Line 827 | Line 888 | begin
888		with FormatSettings do
889		{$IFEND}
890		{$IFEND}
891	<	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
891	>	Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
892		end;
893
894		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
#	Line 835 | Line 896 | begin
896		SetAsLong(aValue);
897		end;
898
899	+	procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
900	+	var dstOffset: smallint; var aTimezone: AnsiString;
901	+	var aTimeZoneID: TFBTimeZoneID);
902	+	begin
903	+	CheckActive;
904	+	aDateTime := 0;
905	+	dstOffset := 0;
906	+	aTimezone := '';
907	+	aTimeZoneID := TimeZoneID_GMT;
908	+	if not IsNull then
909	+	with FFirebirdClientAPI do
910	+	case SQLType of
911	+	SQL_TEXT, SQL_VARYING:
912	+	if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
913	+	IBError(ibxeInvalidDataConversion, [nil]);
914	+	SQL_TYPE_DATE:
915	+	aDateTime := SQLDecodeDate(SQLData);
916	+	SQL_TYPE_TIME:
917	+	aDateTime := SQLDecodeTime(SQLData);
918	+	SQL_TIMESTAMP:
919	+	aDateTime := SQLDecodeDateTime(SQLData);
920	+	SQL_TIMESTAMP_TZ:
921	+	begin
922	+	GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
923	+	aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
924	+	end;
925	+	SQL_TIMESTAMP_TZ_EX:
926	+	begin
927	+	GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
928	+	aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
929	+	end;
930	+	SQL_TIME_TZ:
931	+	with GetTimeZoneServices do
932	+	begin
933	+	DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
934	+	aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
935	+	end;
936	+	SQL_TIME_TZ_EX:
937	+	with GetTimeZoneServices do
938	+	begin
939	+	DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
940	+	aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
941	+	end;
942	+	else
943	+	IBError(ibxeInvalidDataConversion, [nil]);
944	+	end;
945	+	end;
946	+
947		function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
948		): Int64;
949		var
#	Line 890 | Line 999 | begin
999		//Do nothing by default
1000		end;
1001
1002	+	procedure TSQLDataItem.CheckTZSupport;
1003	+	begin
1004	+	if not FFirebirdClientAPI.HasTimeZoneSupport then
1005	+	IBError(ibxeNoTimezoneSupport,[]);
1006	+	end;
1007	+
1008	+	function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1009	+	begin
1010	+	if FTimeZoneServices = nil then
1011	+	begin
1012	+	if not GetAttachment.HasTimeZoneSupport then
1013	+	IBError(ibxeNoTimezoneSupport,[]);
1014	+	GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1015	+	end;
1016	+	Result := FTimeZoneServices;
1017	+	end;
1018	+
1019		procedure TSQLDataItem.Changed;
1020		begin
1021		//Do nothing by default
#	Line 950 | Line 1076 | begin
1076		SQL_LONG:             Result := 'SQL_LONG';
1077		SQL_SHORT:            Result := 'SQL_SHORT';
1078		SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1079	+	SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1080	+	SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1081		SQL_BLOB:             Result := 'SQL_BLOB';
1082		SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1083		SQL_ARRAY:            Result := 'SQL_ARRAY';
#	Line 957 | Line 1085 | begin
1085		SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1086		SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1087		SQL_INT64:            Result := 'SQL_INT64';
1088	+	SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1089	+	SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1090	+	SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1091	+	SQL_DEC16:            Result := 'SQL_DEC16';
1092	+	SQL_DEC34:            Result := 'SQL_DEC34';
1093	+	SQL_INT128:           Result := 'SQL_INT128';
1094	+	SQL_NULL:             Result := 'SQL_NULL';
1095	+	SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1096		end;
1097		end;
1098
#	Line 1009 | Line 1145 | begin
1145		Scale);
1146		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1147		result := Trunc(AsDouble);
1148	+
1149	+	SQL_DEC_FIXED,
1150	+	SQL_DEC16,
1151	+	SQL_DEC34,
1152	+	SQL_INT128:
1153	+	if not BCDToCurr(GetAsBCD,Result) then
1154	+	IBError(ibxeInvalidDataConversion, [nil]);
1155	+
1156		else
1157		IBError(ibxeInvalidDataConversion, [nil]);
1158		end;
#	Line 1045 | Line 1189 | begin
1189		end;
1190
1191		function TSQLDataItem.GetAsDateTime: TDateTime;
1192	+	var aTimezone: AnsiString;
1193	+	aTimeZoneID: TFBTimeZoneID;
1194	+	dstOffset: smallint;
1195	+	begin
1196	+	InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1197	+	end;
1198	+
1199	+	procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1200	+	var dstOffset: smallint; var aTimezone: AnsiString);
1201	+	var aTimeZoneID: TFBTimeZoneID;
1202	+	begin
1203	+	InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1204	+	end;
1205	+
1206	+	procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1207	+	var aTimezoneID: TFBTimeZoneID);
1208	+	var aTimezone: AnsiString;
1209	+	begin
1210	+	InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1211	+	end;
1212	+
1213	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1214	+	var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1215	+	var aTimeZone: AnsiString;
1216		begin
1217		CheckActive;
1218	<	result := 0;
1218	>	aTime := 0;
1219	>	dstOffset := 0;
1220		if not IsNull then
1221		with FFirebirdClientAPI do
1222		case SQLType of
1223	<	SQL_TEXT, SQL_VARYING: begin
1224	<	try
1225	<	result := StrToDate(AsString);
1226	<	except
1227	<	on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1223	>	SQL_TIME_TZ:
1224	>	begin
1225	>	GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1226	>	aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1227	>	end;
1228	>	SQL_TIME_TZ_EX:
1229	>	begin
1230	>	GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1231	>	aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1232		end;
1233	+	else
1234	+	IBError(ibxeInvalidDataConversion, [nil]);
1235	+	end;
1236	+	end;
1237	+
1238	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1239	+	var aTimezone: AnsiString; OnDate: TDateTime);
1240	+	begin
1241	+	CheckActive;
1242	+	aTime := 0;
1243	+	dstOffset := 0;
1244	+	if not IsNull then
1245	+	with FFirebirdClientAPI do
1246	+	case SQLType of
1247	+	SQL_TIME_TZ:
1248	+	GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1249	+	SQL_TIME_TZ_EX:
1250	+	GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1251	+	else
1252	+	IBError(ibxeInvalidDataConversion, [nil]);
1253	+	end;
1254	+	end;
1255	+
1256	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1257	+	var aTimezoneID: TFBTimeZoneID);
1258	+	begin
1259	+	GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1260	+	end;
1261	+
1262	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1263	+	var aTimezone: AnsiString);
1264	+	begin
1265	+	GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1266	+	end;
1267	+
1268	+	function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1269	+	var aTimezone: AnsiString;
1270	+	begin
1271	+	CheckActive;
1272	+	result := 0;
1273	+	aTimezone := '';
1274	+	if not IsNull then
1275	+	with FFirebirdClientAPI do
1276	+	case SQLType of
1277	+	SQL_TEXT, SQL_VARYING:
1278	+	begin
1279	+	if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1280	+	IBError(ibxeInvalidDataConversion, [nil]);
1281	+	Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1282		end;
1283		SQL_TYPE_DATE:
1284		result := SQLDecodeDate(SQLData);
1285	<	SQL_TYPE_TIME:
1285	>	SQL_TYPE_TIME,
1286	>	SQL_TIME_TZ,
1287	>	SQL_TIME_TZ_EX:
1288		result := SQLDecodeTime(SQLData);
1289	<	SQL_TIMESTAMP:
1289	>	SQL_TIMESTAMP,
1290	>	SQL_TIMESTAMP_TZ,
1291	>	SQL_TIMESTAMP_TZ_EX:
1292		result := SQLDecodeDateTime(SQLData);
1293		else
1294		IBError(ibxeInvalidDataConversion, [nil]);
1295	<	end;
1295	>	end;
1296		end;
1297
1298		function TSQLDataItem.GetAsDouble: Double;
#	Line 1094 | Line 1320 | begin
1320		result := PFloat(SQLData)^;
1321		SQL_DOUBLE, SQL_D_FLOAT:
1322		result := PDouble(SQLData)^;
1323	+	SQL_DEC_FIXED,
1324	+	SQL_DEC16,
1325	+	SQL_DEC34,
1326	+	SQL_INT128:
1327	+	Result := BCDToDouble(GetAsBCD);
1328		else
1329		IBError(ibxeInvalidDataConversion, [nil]);
1330		end;
#	Line 1139 | Line 1370 | begin
1370		result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1371		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1372		result := Trunc(AsDouble);
1373	+	SQL_DEC_FIXED,
1374	+	SQL_DEC16,
1375	+	SQL_DEC34,
1376	+	SQL_INT128:
1377	+	Result := BCDToInteger(GetAsBCD);
1378		else
1379	<	IBError(ibxeInvalidDataConversion, [nil]);
1379	>	IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1380		end;
1381		end;
1382
#	Line 1225 | Line 1461 | end;
1461
1462		{Returns the byte length of a UTF8 string with a fixed charwidth}
1463
1464	<	function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1464	>	function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1465		var i: integer;
1466		cplen: integer;
1467		s: AnsiString;
1468		begin
1469		Result := 0;
1470		s := strpas(p);
1471	<	for i := 1 to CharWidth do
1471	>	for i := 1 to FieldWidth do
1472		begin
1473		cplen := UTF8CodepointSizeFull(p);
1474		Inc(p,cplen);
#	Line 1250 | Line 1486 | var
1486		sz: PByte;
1487		str_len: Integer;
1488		rs: RawByteString;
1489	+	aTimeZone: AnsiString;
1490	+	aDateTime: TDateTime;
1491	+	dstOffset: smallint;
1492		begin
1493		CheckActive;
1494		result := '';
#	Line 1281 | Line 1520 | begin
1520		SetCodePage(rs,GetCodePage,false);
1521		Result := rs;
1522		end;
1523	+
1524		SQL_TYPE_DATE:
1525	<	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1286	<	SQL_TYPE_TIME :
1287	<	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1525	>	Result := DateToStr(GetAsDateTime);
1526		SQL_TIMESTAMP:
1527	<	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1527	>	Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1528	>	SQL_TYPE_TIME:
1529	>	Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1530	>	SQL_TIMESTAMP_TZ,
1531	>	SQL_TIMESTAMP_TZ_EX:
1532	>	with GetAttachment.GetTimeZoneServices do
1533	>	begin
1534	>	if GetTZTextOption = tzGMT then
1535	>	Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1536	>	else
1537	>	begin
1538	>	GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1539	>	if GetTZTextOption = tzOffset then
1540	>	Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1541	>	else
1542	>	Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1543	>	end;
1544	>	end;
1545	>	SQL_TIME_TZ,
1546	>	SQL_TIME_TZ_EX:
1547	>	with GetAttachment.GetTimeZoneServices do
1548	>	begin
1549	>	if GetTZTextOption = tzGMT then
1550	>	Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1551	>	else
1552	>	begin
1553	>	GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1554	>	if GetTZTextOption = tzOffset then
1555	>	Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1556	>	else
1557	>	Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1558	>	end;
1559	>	end;
1560	>
1561		SQL_SHORT, SQL_LONG:
1562		if Scale = 0 then
1563		result := IntToStr(AsLong)
#	Line 1303 | Line 1574 | begin
1574		result := FloatToStr(AsDouble);
1575		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1576		result := FloatToStr(AsDouble);
1577	+
1578	+	SQL_DEC16,
1579	+	SQL_DEC34:
1580	+	result := BCDToStr(GetAsBCD);
1581	+
1582	+	SQL_DEC_FIXED,
1583	+	SQL_INT128:
1584	+	result := Int128ToStr(SQLData,scale);
1585	+
1586		else
1587		IBError(ibxeInvalidDataConversion, [nil]);
1588		end;
#	Line 1321 | Line 1601 | begin
1601		end;
1602
1603		function TSQLDataItem.GetAsVariant: Variant;
1604	+	var ts: TDateTime;
1605	+	dstOffset: smallint;
1606	+	timezone: AnsiString;
1607		begin
1608		CheckActive;
1609		if IsNull then
#	Line 1334 | Line 1617 | begin
1617		result := AsString;
1618		SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1619		result := AsDateTime;
1620	+	SQL_TIMESTAMP_TZ,
1621	+	SQL_TIME_TZ,
1622	+	SQL_TIMESTAMP_TZ_EX,
1623	+	SQL_TIME_TZ_EX:
1624	+	begin
1625	+	GetAsDateTime(ts,dstOffset,timezone);
1626	+	result := VarArrayOf([ts,dstOffset,timezone]);
1627	+	end;
1628		SQL_SHORT, SQL_LONG:
1629		if Scale = 0 then
1630		result := AsLong
#	Line 1352 | Line 1643 | begin
1643		result := AsDouble;
1644		SQL_BOOLEAN:
1645		result := AsBoolean;
1646	+	SQL_DEC_FIXED,
1647	+	SQL_DEC16,
1648	+	SQL_DEC34,
1649	+	SQL_INT128:
1650	+	result := VarFmtBCDCreate(GetAsBcd);
1651		else
1652		IBError(ibxeInvalidDataConversion, [nil]);
1653		end;
#	Line 1372 | Line 1668 | begin
1668		Result := Length(GetDateFormatStr(true));
1669		dfTime:
1670		Result := Length(GetTimeFormatStr);
1671	+	dfTimestampTZ:
1672	+	Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1673	+	dfTimeTZ:
1674	+	Result := Length(GetTimeFormatStr)+ 6;
1675		else
1676		Result := 0;
1677	+	end;end;
1678	+
1679	+	function TSQLDataItem.GetAsBCD: tBCD;
1680	+
1681	+	begin
1682	+	CheckActive;
1683	+	if IsNull then
1684	+	with Result do
1685	+	begin
1686	+	FillChar(Result,sizeof(Result),0);
1687	+	Precision := 1;
1688	+	exit;
1689	+	end;
1690	+
1691	+	case SQLType of
1692	+	SQL_DEC16,
1693	+	SQL_DEC34:
1694	+	with FFirebirdClientAPI do
1695	+	Result := SQLDecFloatDecode(SQLType,  SQLData);
1696	+
1697	+	SQL_DEC_FIXED,
1698	+	SQL_INT128:
1699	+	with FFirebirdClientAPI do
1700	+	Result := StrToBCD(Int128ToStr(SQLData,scale));
1701	+	else
1702	+	if not CurrToBCD(GetAsCurrency,Result) then
1703	+	IBError(ibxeBadBCDConversion,[]);
1704		end;
1705		end;
1706
#	Line 1465 | Line 1792 | begin
1792		Changed;
1793		end;
1794
1795	+	procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1796	+	begin
1797	+	CheckActive;
1798	+	CheckTZSupport;
1799	+	if GetSQLDialect < 3 then
1800	+	begin
1801	+	AsDateTime := aValue;
1802	+	exit;
1803	+	end;
1804	+
1805	+	Changing;
1806	+	if IsNullable then
1807	+	IsNull := False;
1808	+
1809	+	SQLType := SQL_TIME_TZ;
1810	+	DataLength := SizeOf(ISC_TIME_TZ);
1811	+	GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1812	+	Changed;
1813	+	end;
1814	+
1815	+	procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1816	+	begin
1817	+	CheckActive;
1818	+	CheckTZSupport;
1819	+	if GetSQLDialect < 3 then
1820	+	begin
1821	+	AsDateTime := aValue;
1822	+	exit;
1823	+	end;
1824	+
1825	+	Changing;
1826	+	if IsNullable then
1827	+	IsNull := False;
1828	+
1829	+	SQLType := SQL_TIME_TZ;
1830	+	DataLength := SizeOf(ISC_TIME_TZ);
1831	+	GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1832	+	Changed;
1833	+	end;
1834	+
1835		procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1836		begin
1837		CheckActive;
#	Line 1479 | Line 1846 | begin
1846		Changed;
1847		end;
1848
1849	+	procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1850	+	aTimeZoneID: TFBTimeZoneID);
1851	+	begin
1852	+	CheckActive;
1853	+	CheckTZSupport;
1854	+	if IsNullable then
1855	+	IsNull := False;
1856	+
1857	+	Changing;
1858	+	SQLType := SQL_TIMESTAMP_TZ;
1859	+	DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1860	+	GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1861	+	Changed;
1862	+	end;
1863	+
1864	+	procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1865	+	);
1866	+	begin
1867	+	CheckActive;
1868	+	CheckTZSupport;
1869	+	if IsNullable then
1870	+	IsNull := False;
1871	+
1872	+	Changing;
1873	+	SQLType := SQL_TIMESTAMP_TZ;
1874	+	DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1875	+	GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1876	+	Changed;
1877	+	end;
1878	+
1879	+	procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1880	+	begin
1881	+	SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1882	+	end;
1883	+
1884		procedure TSQLDataItem.SetAsDouble(Value: Double);
1885		begin
1886		CheckActive;
#	Line 1574 | Line 1976 | begin
1976		CheckActive;
1977		if VarIsNull(Value) then
1978		IsNull := True
1979	+	else
1980	+	if VarIsArray(Value) then {must be datetime plus timezone}
1981	+	SetAsDateTime(Value[0],AnsiString(Value[1]))
1982		else case VarType(Value) of
1983		varEmpty, varNull:
1984		IsNull := True;
#	Line 1596 | Line 2001 | begin
2001		IBError(ibxeNotSupported, [nil]);
2002		varByRef, varDispatch, varError, varUnknown, varVariant:
2003		IBError(ibxeNotPermitted, [nil]);
2004	+	else
2005	+	if VarIsFmtBCD(Value) then
2006	+	SetAsBCD(VarToBCD(Value))
2007	+	else
2008	+	IBError(ibxeNotSupported, [nil]);
2009		end;
2010		end;
2011
#	Line 1613 | Line 2023 | begin
2023		Changed;
2024		end;
2025
2026	+	procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2027	+	var C: Currency;
2028	+	begin
2029	+	CheckActive;
2030	+	Changing;
2031	+	if IsNullable then
2032	+	IsNull := False;
2033	+
2034	+
2035	+	with FFirebirdClientAPI do
2036	+	if aValue.Precision <= 16 then
2037	+	begin
2038	+	if not HasDecFloatSupport then
2039	+	IBError(ibxeDecFloatNotSupported,[]);
2040	+
2041	+	SQLType := SQL_DEC16;
2042	+	DataLength := 8;
2043	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
2044	+	end
2045	+	else
2046	+	if aValue.Precision <= 34 then
2047	+	begin
2048	+	if not HasDecFloatSupport then
2049	+	IBError(ibxeDecFloatNotSupported,[]);
2050	+
2051	+	SQLType := SQL_DEC34;
2052	+	DataLength := 16;
2053	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
2054	+	end
2055	+	else
2056	+	if aValue.Precision <= 38 then
2057	+	begin
2058	+	if not HasInt128Support then
2059	+	IBError(ibxeInt128NotSupported,[]);
2060	+
2061	+	SQLType := SQL_INT128;
2062	+	DataLength := 16;
2063	+	StrToInt128(scale,BcdToStr(aValue),SQLData);
2064	+	end
2065	+	else
2066	+	IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2067	+
2068	+	Changed;
2069	+	end;
2070	+
2071		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2072		begin
2073		CheckActive;
#	Line 1643 | Line 2098 | begin
2098		IBError(ibxeStatementNotPrepared, [nil]);
2099		end;
2100
2101	+	function TColumnMetaData.GetAttachment: IAttachment;
2102	+	begin
2103	+	Result := GetStatement.GetAttachment;
2104	+	end;
2105	+
2106		function TColumnMetaData.SQLData: PByte;
2107		begin
2108		Result := FIBXSQLVAR.SQLData;
#	Line 1747 | Line 2207 | end;
2207		function TColumnMetaData.GetSize: cardinal;
2208		begin
2209		CheckActive;
2210	<	result := FIBXSQLVAR.DataLength;
2210	>	result := FIBXSQLVAR.GetSize;
2211		end;
2212
2213		function TColumnMetaData.GetCharSetWidth: integer;
#	Line 1860 | Line 2320 | var b: IBlob;
2320		dt: TDateTime;
2321		CurrValue: Currency;
2322		FloatValue: single;
2323	+	timezone: AnsiString;
2324		begin
2325		CheckActive;
2326		if IsNullable then
2327		IsNull := False;
2328	+	with FFirebirdClientAPI do
2329		case SQLTYPE of
2330		SQL_BOOLEAN:
2331		if AnsiCompareText(Value,STrue) = 0 then
#	Line 1921 | Line 2383 | begin
2383		else
2384		DoSetString;
2385
2386	+	SQL_TIMESTAMP_TZ:
2387	+	if ParseDateTimeTZString(value,dt,timezone) then
2388	+	SetAsDateTime(dt,timezone)
2389	+	else
2390	+	DoSetString;
2391	+
2392	+	SQL_TIME_TZ:
2393	+	if ParseDateTimeTZString(value,dt,timezone,true) then
2394	+	SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2395	+	else
2396	+	DoSetString;
2397	+
2398	+	SQL_DEC_FIXED,
2399	+	SQL_DEC16,
2400	+	SQL_DEC34,
2401	+	SQL_INT128:
2402	+	SetAsBCD(StrToBCD(Value));
2403	+
2404		else
2405		IBError(ibxeInvalidDataConversion,[nil]);
2406		end;
#	Line 2164 | Line 2644 | begin
2644		end;
2645		end;
2646
2647	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2648	+	var i: integer;
2649	+	OldSQLVar: TSQLVarData;
2650	+	begin
2651	+	if FIBXSQLVAR.UniqueName then
2652	+	inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2653	+	else
2654	+	with FIBXSQLVAR.Parent do
2655	+	begin
2656	+	for i := 0 to Count - 1 do
2657	+	if Column[i].Name = Name then
2658	+	begin
2659	+	OldSQLVar := FIBXSQLVAR;
2660	+	FIBXSQLVAR := Column[i];
2661	+	try
2662	+	inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2663	+	finally
2664	+	FIBXSQLVAR := OldSQLVar;
2665	+	end;
2666	+	end;
2667	+	end;
2668	+	end;
2669	+
2670	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2671	+	var i: integer;
2672	+	OldSQLVar: TSQLVarData;
2673	+	begin
2674	+	if FIBXSQLVAR.UniqueName then
2675	+	inherited SetAsTime(AValue,OnDate,aTimeZone)
2676	+	else
2677	+	with FIBXSQLVAR.Parent do
2678	+	begin
2679	+	for i := 0 to Count - 1 do
2680	+	if Column[i].Name = Name then
2681	+	begin
2682	+	OldSQLVar := FIBXSQLVAR;
2683	+	FIBXSQLVAR := Column[i];
2684	+	try
2685	+	inherited SetAsTime(AValue,OnDate,aTimeZone);
2686	+	finally
2687	+	FIBXSQLVAR := OldSQLVar;
2688	+	end;
2689	+	end;
2690	+	end;
2691	+	end;
2692	+
2693	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2694	+	begin
2695	+	SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2696	+	end;
2697	+
2698	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2699	+	begin
2700	+	SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2701	+	end;
2702	+
2703		procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2704		var i: integer;
2705		OldSQLVar: TSQLVarData;
#	Line 2187 | Line 2723 | begin
2723		end;
2724		end;
2725
2726	+	procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2727	+	);
2728	+	var i: integer;
2729	+	OldSQLVar: TSQLVarData;
2730	+	begin
2731	+	if FIBXSQLVAR.UniqueName then
2732	+	inherited SetAsDateTime(AValue,aTimeZoneID)
2733	+	else
2734	+	with FIBXSQLVAR.Parent do
2735	+	begin
2736	+	for i := 0 to Count - 1 do
2737	+	if Column[i].Name = Name then
2738	+	begin
2739	+	OldSQLVar := FIBXSQLVAR;
2740	+	FIBXSQLVAR := Column[i];
2741	+	try
2742	+	inherited SetAsDateTime(AValue,aTimeZoneID);
2743	+	finally
2744	+	FIBXSQLVAR := OldSQLVar;
2745	+	end;
2746	+	end;
2747	+	end;
2748	+	end;
2749	+
2750	+	procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2751	+	var i: integer;
2752	+	OldSQLVar: TSQLVarData;
2753	+	begin
2754	+	if FIBXSQLVAR.UniqueName then
2755	+	inherited SetAsDateTime(AValue,aTimeZone)
2756	+	else
2757	+	with FIBXSQLVAR.Parent do
2758	+	begin
2759	+	for i := 0 to Count - 1 do
2760	+	if Column[i].Name = Name then
2761	+	begin
2762	+	OldSQLVar := FIBXSQLVAR;
2763	+	FIBXSQLVAR := Column[i];
2764	+	try
2765	+	inherited SetAsDateTime(AValue,aTimeZone);
2766	+	finally
2767	+	FIBXSQLVAR := OldSQLVar;
2768	+	end;
2769	+	end;
2770	+	end;
2771	+	end;
2772	+
2773		procedure TSQLParam.SetAsDouble(AValue: Double);
2774		var i: integer;
2775		OldSQLVar: TSQLVarData;
#	Line 2367 | Line 2950 | begin
2950		FIBXSQLVAR.SetCharSetID(aValue);
2951		end;
2952
2953	+	procedure TSQLParam.SetAsBcd(aValue: tBCD);
2954	+	var i: integer;
2955	+	OldSQLVar: TSQLVarData;
2956	+	begin
2957	+	if FIBXSQLVAR.UniqueName then
2958	+	inherited SetAsBcd(AValue)
2959	+	else
2960	+	with FIBXSQLVAR.Parent do
2961	+	begin
2962	+	for i := 0 to Count - 1 do
2963	+	if Column[i].Name = Name then
2964	+	begin
2965	+	OldSQLVar := FIBXSQLVAR;
2966	+	FIBXSQLVAR := Column[i];
2967	+	try
2968	+	inherited SetAsBcd(AValue);
2969	+	finally
2970	+	FIBXSQLVAR := OldSQLVar;
2971	+	end;
2972	+	end;
2973	+	end;
2974	+	end;
2975	+
2976		{ TMetaData }
2977
2978		procedure TMetaData.CheckActive;
#	Line 2522 | Line 3128 | begin
3128		if not FResults.CheckStatementStatus(ssPrepared)  then
3129		IBError(ibxeStatementNotPrepared, [nil]);
3130
3131	<	with GetTransaction as TFBTransaction do
3131	>	with GetTransaction do
3132		if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3133		IBError(ibxeInterfaceOutofDate,[nil]);
3134		end;

Diff Legend

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