ViewVC Help

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

root/public/ibx/branches/journaling/fbintf/client/FBSQLData.pas

Comparing ibx/trunk/fbintf/client/FBSQLData.pas (file contents):
Revision 308 by tony, Sat Jul 18 10:26:30 2020 UTC vs.
Revision 349 by tony, Mon Oct 18 08:39:40 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;
157	>	function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
158		function GetSQLTypeName: AnsiString; overload;
159	<	class function GetSQLTypeName(SQLType: short): AnsiString; overload;
159	>	class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
160		function GetStrDataLength: short;
161		function GetName: AnsiString; virtual; abstract;
162	<	function GetScale: integer; virtual; abstract;
162	>	function GetScale: integer; virtual; abstract; {Current Field Data scale}
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;
190		procedure SetAsCurrency(Value: Currency); virtual;
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 154 | 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 212 | Line 265 | type
265		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
266		property CaseSensitiveParams: boolean read FCaseSensitiveParams
267		write FCaseSensitiveParams; {Only used when IsInputDataArea true}
268	+	function CanChangeMetaData: boolean; virtual; abstract;
269		property Count: integer read GetCount;
270		property Column[index: integer]: TSQLVarData read GetColumn;
271		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 230 | Line 284 | type
284		FModified: boolean;
285		FUniqueName: boolean;
286		FVarString: RawByteString;
287	+	FColMetaData: IParamMetaData;
288		function GetStatement: IStatement;
289		procedure SetName(AValue: AnsiString);
290		protected
291	+	function GetAttachment: IAttachment; virtual; abstract;
292		function GetSQLType: cardinal; virtual; abstract;
293		function GetSubtype: integer; virtual; abstract;
294		function GetAliasName: AnsiString;  virtual; abstract;
#	Line 241 | Line 297 | type
297		function GetRelationName: AnsiString;  virtual; abstract;
298		function GetScale: integer; virtual; abstract;
299		function GetCharSetID: cardinal; virtual; abstract;
300	+	function GetCharSetWidth: integer; virtual; abstract;
301		function GetCodePage: TSystemCodePage; virtual; abstract;
302		function GetIsNull: Boolean;   virtual; abstract;
303		function GetIsNullable: boolean; virtual; abstract;
304		function GetSQLData: PByte;  virtual; abstract;
305	<	function GetDataLength: cardinal; virtual; abstract;
305	>	function GetDataLength: cardinal; virtual; abstract; {current field length}
306	>	function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
307	>	function GetDefaultTextSQLType: cardinal; virtual; abstract;
308		procedure SetIsNull(Value: Boolean); virtual; abstract;
309		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
310		procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
#	Line 253 | Line 312 | type
312		procedure SetDataLength(len: cardinal); virtual; abstract;
313		procedure SetSQLType(aValue: cardinal); virtual; abstract;
314		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
315	+	procedure SetMetaSize(aValue: cardinal); virtual;
316		public
317		constructor Create(aParent: TSQLDataArea; aIndex: integer);
318		procedure SetString(aValue: AnsiString);
#	Line 263 | Line 323 | type
323		function CreateBlob: IBlob; virtual; abstract;
324		function GetArrayMetaData: IArrayMetaData; virtual; abstract;
325		function GetBlobMetaData: IBlobMetaData; virtual; abstract;
326	+	function getColMetadata: IParamMetaData;
327		procedure Initialize; virtual;
328	+	procedure SaveMetaData;
329
330		public
331		property AliasName: AnsiString read GetAliasName;
#	Line 297 | Line 359 | type
359		FChangeSeqNo: integer;
360		protected
361		procedure CheckActive; override;
362	+	function GetAttachment: IAttachment; override;
363		function SQLData: PByte; override;
364		function GetDataLength: cardinal; override;
365		function GetCodePage: TSystemCodePage; override;
#	Line 320 | Line 383 | type
383		function getCharSetID: cardinal; override;
384		function GetIsNullable: boolean; override;
385		function GetSize: cardinal; override;
386	+	function GetCharSetWidth: integer; override;
387		function GetArrayMetaData: IArrayMetaData;
388		function GetBlobMetaData: IBlobMetaData;
389		function GetStatement: IStatement;
#	Line 350 | Line 414 | type
414		property AsBlob: IBlob read GetAsBlob;
415		end;
416
417	+	{ TSQLParamMetaData }
418	+
419	+	TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
420	+	private
421	+	FSQLType: cardinal;
422	+	FSQLSubType: integer;
423	+	FScale: integer;
424	+	FCharSetID: cardinal;
425	+	FNullable: boolean;
426	+	FSize: cardinal;
427	+	FCodePage: TSystemCodePage;
428	+	public
429	+	constructor Create(src: TSQLVarData);
430	+	{IParamMetaData}
431	+	function GetSQLType: cardinal;
432	+	function GetSQLTypeName: AnsiString;
433	+	function getSubtype: integer;
434	+	function getScale: integer;
435	+	function getCharSetID: cardinal;
436	+	function getCodePage: TSystemCodePage;
437	+	function getIsNullable: boolean;
438	+	function GetSize: cardinal;
439	+	property SQLType: cardinal read GetSQLType;
440	+	end;
441	+
442		{ TSQLParam }
443
444	<	TSQLParam = class(TIBSQLData,ISQLParam)
444	>	TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
445		protected
446		procedure CheckActive; override;
447		procedure Changed; override;
#	Line 362 | Line 451 | type
451		procedure SetSQLType(aValue: cardinal); override;
452		public
453		procedure Clear;
454	+	function getColMetadata: IParamMetaData;
455		function GetModified: boolean; override;
456		function GetAsPointer: Pointer;
457	+	function GetAsString: AnsiString; override;
458		procedure SetName(Value: AnsiString); override;
459		procedure SetIsNull(Value: Boolean);  override;
460		procedure SetIsNullable(Value: Boolean); override;
#	Line 375 | Line 466 | type
466		procedure SetAsInt64(AValue: Int64);
467		procedure SetAsDate(AValue: TDateTime);
468		procedure SetAsLong(AValue: Long);
469	<	procedure SetAsTime(AValue: TDateTime);
470	<	procedure SetAsDateTime(AValue: TDateTime);
469	>	procedure SetAsTime(AValue: TDateTime); overload;
470	>	procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
471	>	procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
472	>	procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
473	>	procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
474	>	procedure SetAsDateTime(AValue: TDateTime); overload;
475	>	procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
476	>	procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
477		procedure SetAsDouble(AValue: Double);
478		procedure SetAsFloat(AValue: Float);
479		procedure SetAsPointer(AValue: Pointer);
#	Line 386 | Line 483 | type
483		procedure SetAsBlob(aValue: IBlob);
484		procedure SetAsQuad(AValue: TISC_QUAD);
485		procedure SetCharSetID(aValue: cardinal);
486	+	procedure SetAsBcd(aValue: tBCD);
487
488		property AsBlob: IBlob read GetAsBlob write SetAsBlob;
489		property IsNullable: Boolean read GetIsNullable write SetIsNullable;
#	Line 459 | Line 557 | implementation
557
558		uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
559
560	+	{ TSQLParamMetaData }
561	+
562	+	constructor TSQLParamMetaData.Create(src: TSQLVarData);
563	+	begin
564	+	inherited Create;
565	+	FSQLType := src.GetSQLType;
566	+	FSQLSubType := src.getSubtype;
567	+	FScale := src.GetScale;
568	+	FCharSetID := src.getCharSetID;
569	+	FNullable := src.GetIsNullable;
570	+	FSize := src.GetSize;
571	+	FCodePage := src.GetCodePage;
572	+	end;
573	+
574	+	function TSQLParamMetaData.GetSQLType: cardinal;
575	+	begin
576	+	Result := FSQLType;
577	+	end;
578	+
579	+	function TSQLParamMetaData.GetSQLTypeName: AnsiString;
580	+	begin
581	+	Result := TSQLDataItem.GetSQLTypeName(FSQLType);
582	+	end;
583	+
584	+	function TSQLParamMetaData.getSubtype: integer;
585	+	begin
586	+	Result := FSQLSubType;
587	+	end;
588	+
589	+	function TSQLParamMetaData.getScale: integer;
590	+	begin
591	+	Result := FScale;
592	+	end;
593	+
594	+	function TSQLParamMetaData.getCharSetID: cardinal;
595	+	begin
596	+	Result := FCharSetID;
597	+	end;
598	+
599	+	function TSQLParamMetaData.getCodePage: TSystemCodePage;
600	+	begin
601	+	Result :=  FCodePage;
602	+	end;
603	+
604	+	function TSQLParamMetaData.getIsNullable: boolean;
605	+	begin
606	+	Result :=  FNullable;
607	+	end;
608	+
609	+	function TSQLParamMetaData.GetSize: cardinal;
610	+	begin
611	+	Result := FSize;
612	+	end;
613	+
614		{ TSQLDataArea }
615
616		function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
#	Line 605 | Line 757 | begin
757		FName := AValue;
758		end;
759
760	+	procedure TSQLVarData.SetMetaSize(aValue: cardinal);
761	+	begin
762	+	//Ignore
763	+	end;
764	+
765	+	procedure TSQLVarData.SaveMetaData;
766	+	begin
767	+	FColMetaData := TSQLParamMetaData.Create(self);
768	+	end;
769	+
770		constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
771		begin
772		inherited Create;
#	Line 621 | Line 783 | begin
783		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
784
785		FVarString := aValue;
786	<	SQLType := SQL_TEXT;
786	>	if SQLType = SQL_BLOB then
787	>	SetMetaSize(GetAttachment.GetInlineBlobLimit);
788	>	SQLType := GetDefaultTextSQLType;
789		Scale := 0;
790		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
791		end;
#	Line 637 | Line 801 | begin
801		FVarString := '';
802		end;
803
804	+	function TSQLVarData.getColMetadata: IParamMetaData;
805	+	begin
806	+	Result := FColMetaData;
807	+	end;
808	+
809		procedure TSQLVarData.Initialize;
810
811		function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
#	Line 812 | Line 981 | begin
981		with FormatSettings do
982		{$IFEND}
983		{$IFEND}
984	<	Result := LongTimeFormat;
984	>	Result := 'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';;
985		end;
986
987		function TSQLDataItem.GetTimestampFormatStr: AnsiString;
#	Line 824 | Line 993 | begin
993		with FormatSettings do
994		{$IFEND}
995		{$IFEND}
996	<	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
996	>	Result := ShortDateFormat + ' ' +  'hh' + TimeSeparator + 'nn' + TimeSeparator + 'ss' + '.zzzz';
997		end;
998
999		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
#	Line 832 | Line 1001 | begin
1001		SetAsLong(aValue);
1002		end;
1003
1004	+	procedure TSQLDataItem.InternalGetAsDateTime(var aDateTime: TDateTime;
1005	+	var dstOffset: smallint; var aTimezone: AnsiString;
1006	+	var aTimeZoneID: TFBTimeZoneID);
1007	+	begin
1008	+	CheckActive;
1009	+	aDateTime := 0;
1010	+	dstOffset := 0;
1011	+	aTimezone := '';
1012	+	aTimeZoneID := TimeZoneID_GMT;
1013	+	if not IsNull then
1014	+	with FFirebirdClientAPI do
1015	+	case SQLType of
1016	+	SQL_TEXT, SQL_VARYING:
1017	+	if not ParseDateTimeTZString(AsString,aDateTime,aTimeZone) then
1018	+	IBError(ibxeInvalidDataConversion, [nil]);
1019	+	SQL_TYPE_DATE:
1020	+	aDateTime := SQLDecodeDate(SQLData);
1021	+	SQL_TYPE_TIME:
1022	+	aDateTime := SQLDecodeTime(SQLData);
1023	+	SQL_TIMESTAMP:
1024	+	aDateTime := SQLDecodeDateTime(SQLData);
1025	+	SQL_TIMESTAMP_TZ:
1026	+	begin
1027	+	GetTimeZoneServices.DecodeTimestampTZ(SQLData,aDateTime,dstOffset,aTimeZone);
1028	+	aTimeZoneID := PISC_TIMESTAMP_TZ(SQLData)^.time_zone;
1029	+	end;
1030	+	SQL_TIMESTAMP_TZ_EX:
1031	+	begin
1032	+	GetTimeZoneServices.DecodeTimestampTZEx(SQLData,aDateTime,dstOffset,aTimeZone);
1033	+	aTimeZoneID := PISC_TIMESTAMP_TZ_EX(SQLData)^.time_zone;
1034	+	end;
1035	+	SQL_TIME_TZ:
1036	+	with GetTimeZoneServices do
1037	+	begin
1038	+	DecodeTimeTZ(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1039	+	aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1040	+	end;
1041	+	SQL_TIME_TZ_EX:
1042	+	with GetTimeZoneServices do
1043	+	begin
1044	+	DecodeTimeTZEx(SQLData,GetTimeTZDate,aDateTime,dstOffset,aTimeZone);
1045	+	aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1046	+	end;
1047	+	else
1048	+	IBError(ibxeInvalidDataConversion, [nil]);
1049	+	end;
1050	+	end;
1051	+
1052		function TSQLDataItem.AdjustScaleFromCurrency(Value: Currency; aScale: Integer
1053		): Int64;
1054		var
#	Line 880 | Line 1097 | begin
1097		end
1098		else
1099		result := trunc(Value);
1100	+	//  writeln('Adjusted ',Value,' to ',Result);
1101		end;
1102
1103		procedure TSQLDataItem.CheckActive;
#	Line 887 | Line 1105 | begin
1105		//Do nothing by default
1106		end;
1107
1108	+	procedure TSQLDataItem.CheckTZSupport;
1109	+	begin
1110	+	if not FFirebirdClientAPI.HasTimeZoneSupport then
1111	+	IBError(ibxeNoTimezoneSupport,[]);
1112	+	end;
1113	+
1114	+	function TSQLDataItem.GetTimeZoneServices: IExTimeZoneServices;
1115	+	begin
1116	+	if FTimeZoneServices = nil then
1117	+	begin
1118	+	if not GetAttachment.HasTimeZoneSupport then
1119	+	IBError(ibxeNoTimezoneSupport,[]);
1120	+	GetAttachment.GetTimeZoneServices.QueryInterface(IExTimeZoneServices,FTimeZoneServices);
1121	+	end;
1122	+	Result := FTimeZoneServices;
1123	+	end;
1124	+
1125		procedure TSQLDataItem.Changed;
1126		begin
1127		//Do nothing by default
#	Line 936 | Line 1171 | begin
1171		Result := GetSQLTypeName(GetSQLType);
1172		end;
1173
1174	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1174	>	class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1175		begin
1176		Result := 'Unknown';
1177		case SQLType of
#	Line 947 | Line 1182 | begin
1182		SQL_LONG:             Result := 'SQL_LONG';
1183		SQL_SHORT:            Result := 'SQL_SHORT';
1184		SQL_TIMESTAMP:        Result := 'SQL_TIMESTAMP';
1185	+	SQL_TIMESTAMP_TZ:     Result := 'SQL_TIMESTAMP_TZ';
1186	+	SQL_TIMESTAMP_TZ_EX:  Result := 'SQL_TIMESTAMP_TZ_EX';
1187		SQL_BLOB:             Result := 'SQL_BLOB';
1188		SQL_D_FLOAT:          Result := 'SQL_D_FLOAT';
1189		SQL_ARRAY:            Result := 'SQL_ARRAY';
#	Line 954 | Line 1191 | begin
1191		SQL_TYPE_TIME:        Result := 'SQL_TYPE_TIME';
1192		SQL_TYPE_DATE:        Result := 'SQL_TYPE_DATE';
1193		SQL_INT64:            Result := 'SQL_INT64';
1194	+	SQL_TIME_TZ:          Result := 'SQL_TIME_TZ';
1195	+	SQL_TIME_TZ_EX:       Result := 'SQL_TIME_TZ_EX';
1196	+	SQL_DEC_FIXED:        Result := 'SQL_DEC_FIXED';
1197	+	SQL_DEC16:            Result := 'SQL_DEC16';
1198	+	SQL_DEC34:            Result := 'SQL_DEC34';
1199	+	SQL_INT128:           Result := 'SQL_INT128';
1200	+	SQL_NULL:             Result := 'SQL_NULL';
1201	+	SQL_BOOLEAN:          Result := 'SQL_BOOLEAN';
1202		end;
1203		end;
1204
#	Line 1005 | Line 1250 | begin
1250		result := AdjustScaleToCurrency(PInt64(SQLData)^,
1251		Scale);
1252		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1253	<	result := Trunc(AsDouble);
1253	>	result := Round(AsDouble);
1254	>
1255	>	SQL_DEC_FIXED,
1256	>	SQL_DEC16,
1257	>	SQL_DEC34,
1258	>	SQL_INT128:
1259	>	if not BCDToCurr(GetAsBCD,Result) then
1260	>	IBError(ibxeInvalidDataConversion, [nil]);
1261	>
1262		else
1263		IBError(ibxeInvalidDataConversion, [nil]);
1264		end;
#	Line 1035 | Line 1288 | begin
1288		result := AdjustScaleToInt64(PInt64(SQLData)^,
1289		Scale);
1290		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1291	<	result := Trunc(AsDouble);
1291	>	result := Round(AsDouble);
1292		else
1293		IBError(ibxeInvalidDataConversion, [nil]);
1294		end;
1295		end;
1296
1297		function TSQLDataItem.GetAsDateTime: TDateTime;
1298	+	var aTimezone: AnsiString;
1299	+	aTimeZoneID: TFBTimeZoneID;
1300	+	dstOffset: smallint;
1301	+	begin
1302	+	InternalGetAsDateTime(Result,dstOffset,aTimeZone,aTimeZoneID);
1303	+	end;
1304	+
1305	+	procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime;
1306	+	var dstOffset: smallint; var aTimezone: AnsiString);
1307	+	var aTimeZoneID: TFBTimeZoneID;
1308	+	begin
1309	+	InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1310	+	end;
1311	+
1312	+	procedure TSQLDataItem.GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
1313	+	var aTimezoneID: TFBTimeZoneID);
1314	+	var aTimezone: AnsiString;
1315	+	begin
1316	+	InternalGetAsDateTime(aDateTime,dstOffset,aTimeZone,aTimeZoneID);
1317	+	end;
1318	+
1319	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1320	+	var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1321	+	var aTimeZone: AnsiString;
1322		begin
1323		CheckActive;
1324	<	result := 0;
1324	>	aTime := 0;
1325	>	dstOffset := 0;
1326		if not IsNull then
1327		with FFirebirdClientAPI do
1328		case SQLType of
1329	<	SQL_TEXT, SQL_VARYING: begin
1330	<	try
1331	<	result := StrToDate(AsString);
1332	<	except
1055	<	on E: EConvertError do IBError(ibxeInvalidDataConversion, [nil]);
1329	>	SQL_TIME_TZ:
1330	>	begin
1331	>	GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1332	>	aTimeZoneID := PISC_TIME_TZ(SQLData)^.time_zone;
1333		end;
1334	+	SQL_TIME_TZ_EX:
1335	+	begin
1336	+	GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1337	+	aTimeZoneID := PISC_TIME_TZ_EX(SQLData)^.time_zone;
1338	+	end;
1339	+	else
1340	+	IBError(ibxeInvalidDataConversion, [nil]);
1341	+	end;
1342	+	end;
1343	+
1344	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1345	+	var aTimezone: AnsiString; OnDate: TDateTime);
1346	+	begin
1347	+	CheckActive;
1348	+	aTime := 0;
1349	+	dstOffset := 0;
1350	+	if not IsNull then
1351	+	with FFirebirdClientAPI do
1352	+	case SQLType of
1353	+	SQL_TIME_TZ:
1354	+	GetTimeZoneServices.DecodeTimeTZ(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1355	+	SQL_TIME_TZ_EX:
1356	+	GetTimeZoneServices.DecodeTimeTZEx(SQLData,OnDate,aTime,dstOffset,aTimeZone);
1357	+	else
1358	+	IBError(ibxeInvalidDataConversion, [nil]);
1359	+	end;
1360	+	end;
1361	+
1362	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1363	+	var aTimezoneID: TFBTimeZoneID);
1364	+	begin
1365	+	GetAsTime(aTime,dstOffset,aTimeZoneID,GetTimeZoneServices.GetTimeTZDate);
1366	+	end;
1367	+
1368	+	procedure TSQLDataItem.GetAsTime(var aTime: TDateTime; var dstOffset: smallint;
1369	+	var aTimezone: AnsiString);
1370	+	begin
1371	+	GetAsTime(aTime,dstOffset,aTimeZone,GetTimeZoneServices.GetTimeTZDate);
1372	+	end;
1373	+
1374	+	function TSQLDataItem.GetAsUTCDateTime: TDateTime;
1375	+	var aTimezone: AnsiString;
1376	+	begin
1377	+	CheckActive;
1378	+	result := 0;
1379	+	aTimezone := '';
1380	+	if not IsNull then
1381	+	with FFirebirdClientAPI do
1382	+	case SQLType of
1383	+	SQL_TEXT, SQL_VARYING:
1384	+	begin
1385	+	if not ParseDateTimeTZString(AsString,Result,aTimeZone) then
1386	+	IBError(ibxeInvalidDataConversion, [nil]);
1387	+	Result := GetTimeZoneServices.LocalTimeToGMT(Result,aTimeZone);
1388		end;
1389		SQL_TYPE_DATE:
1390		result := SQLDecodeDate(SQLData);
1391	<	SQL_TYPE_TIME:
1391	>	SQL_TYPE_TIME,
1392	>	SQL_TIME_TZ,
1393	>	SQL_TIME_TZ_EX:
1394		result := SQLDecodeTime(SQLData);
1395	<	SQL_TIMESTAMP:
1395	>	SQL_TIMESTAMP,
1396	>	SQL_TIMESTAMP_TZ,
1397	>	SQL_TIMESTAMP_TZ_EX:
1398		result := SQLDecodeDateTime(SQLData);
1399		else
1400		IBError(ibxeInvalidDataConversion, [nil]);
1401	<	end;
1401	>	end;
1402		end;
1403
1404		function TSQLDataItem.GetAsDouble: Double;
#	Line 1091 | Line 1426 | begin
1426		result := PFloat(SQLData)^;
1427		SQL_DOUBLE, SQL_D_FLOAT:
1428		result := PDouble(SQLData)^;
1429	+	SQL_DEC_FIXED,
1430	+	SQL_DEC16,
1431	+	SQL_DEC34,
1432	+	SQL_INT128:
1433	+	Result := BCDToDouble(GetAsBCD);
1434		else
1435		IBError(ibxeInvalidDataConversion, [nil]);
1436		end;
#	Line 1127 | Line 1467 | begin
1467		end;
1468		end;
1469		SQL_SHORT:
1470	<	result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1470	>	result := Round(AdjustScale(Int64(PShort(SQLData)^),
1471		Scale));
1472		SQL_LONG:
1473	<	result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1473	>	result := Round(AdjustScale(Int64(PLong(SQLData)^),
1474		Scale));
1475		SQL_INT64:
1476	<	result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1476	>	result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1477		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1478	<	result := Trunc(AsDouble);
1478	>	result := Round(AsDouble);
1479	>	SQL_DEC_FIXED,
1480	>	SQL_DEC16,
1481	>	SQL_DEC34,
1482	>	SQL_INT128:
1483	>	Result := BCDToInteger(GetAsBCD);
1484		else
1485	<	IBError(ibxeInvalidDataConversion, [nil]);
1485	>	IBError(ibxeInvalidDataConversion, [GetSQLTypeName]);
1486		end;
1487		end;
1488
#	Line 1178 | Line 1523 | end;
1523		{Copied from LazUTF8}
1524
1525		function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1526	<	const TopBitSetMask   = $8000; {%10000000}
1527	<	Top2BitsSetMask = $C000; {%11000000}
1528	<	Top3BitsSetMask = $E000; {%11100000}
1529	<	Top4BitsSetMask = $F000; {%11110000}
1530	<	Top5BitsSetMask = $F800; {%11111000}
1526	>	const TopBitSetMask   = $80; {%10000000}
1527	>	Top2BitsSetMask = $C0; {%11000000}
1528	>	Top3BitsSetMask = $E0; {%11100000}
1529	>	Top4BitsSetMask = $F0; {%11110000}
1530	>	Top5BitsSetMask = $F8; {%11111000}
1531		begin
1532		case p^ of
1533		#0..#191: // %11000000
#	Line 1222 | Line 1567 | end;
1567
1568		{Returns the byte length of a UTF8 string with a fixed charwidth}
1569
1570	<	function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1570	>	function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1571		var i: integer;
1572		cplen: integer;
1573	+	s: AnsiString;
1574		begin
1575		Result := 0;
1576	<	for i := 1 to CharWidth do
1576	>	s := strpas(p);
1577	>	for i := 1 to FieldWidth do
1578		begin
1579		cplen := UTF8CodepointSizeFull(p);
1580		Inc(p,cplen);
#	Line 1245 | Line 1592 | var
1592		sz: PByte;
1593		str_len: Integer;
1594		rs: RawByteString;
1595	+	aTimeZone: AnsiString;
1596	+	aDateTime: TDateTime;
1597	+	dstOffset: smallint;
1598		begin
1599		CheckActive;
1600		result := '';
#	Line 1264 | Line 1614 | begin
1614		if (SQLType = SQL_TEXT) then
1615		begin
1616		if GetCodePage = cp_utf8 then
1617	<	str_len := GetStrLen(PAnsiChar(sz),GetSize,DataLength)
1617	>	str_len := GetStrLen(PAnsiChar(sz),GetSize div GetCharSetWidth,DataLength)
1618		else
1619		str_len := DataLength
1620		end
#	Line 1276 | Line 1626 | begin
1626		SetCodePage(rs,GetCodePage,false);
1627		Result := rs;
1628		end;
1629	+
1630		SQL_TYPE_DATE:
1631	<	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1281	<	SQL_TYPE_TIME :
1282	<	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1631	>	Result := DateToStr(GetAsDateTime);
1632		SQL_TIMESTAMP:
1633	<	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1633	>	Result := FBFormatDateTime(GetTimestampFormatStr,GetAsDateTime);
1634	>	SQL_TYPE_TIME:
1635	>	Result := FBFormatDateTime(GetTimeFormatStr,GetAsDateTime);
1636	>	SQL_TIMESTAMP_TZ,
1637	>	SQL_TIMESTAMP_TZ_EX:
1638	>	with GetAttachment.GetTimeZoneServices do
1639	>	begin
1640	>	if GetTZTextOption = tzGMT then
1641	>	Result := FBFormatDateTime(GetTimestampFormatStr,GetAsUTCDateTime)
1642	>	else
1643	>	begin
1644	>	GetAsDateTime(aDateTime,dstOffset,aTimeZone);
1645	>	if GetTZTextOption = tzOffset then
1646	>	Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1647	>	else
1648	>	Result := FBFormatDateTime(GetTimestampFormatStr,aDateTime) + ' ' + aTimeZone;
1649	>	end;
1650	>	end;
1651	>	SQL_TIME_TZ,
1652	>	SQL_TIME_TZ_EX:
1653	>	with GetAttachment.GetTimeZoneServices do
1654	>	begin
1655	>	if GetTZTextOption = tzGMT then
1656	>	Result := FBFormatDateTime(GetTimeFormatStr,GetAsUTCDateTime)
1657	>	else
1658	>	begin
1659	>	GetAsTime(aDateTime,dstOffset,aTimeZone,GetTimeTZDate);
1660	>	if GetTZTextOption = tzOffset then
1661	>	Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + FormatTimeZoneOffset(dstOffset)
1662	>	else
1663	>	Result := FBFormatDateTime(GetTimeFormatStr,aDateTime) + ' ' + aTimeZone;
1664	>	end;
1665	>	end;
1666	>
1667		SQL_SHORT, SQL_LONG:
1668		if Scale = 0 then
1669		result := IntToStr(AsLong)
#	Line 1298 | Line 1680 | begin
1680		result := FloatToStr(AsDouble);
1681		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1682		result := FloatToStr(AsDouble);
1683	+
1684	+	SQL_DEC16,
1685	+	SQL_DEC34:
1686	+	result := BCDToStr(GetAsBCD);
1687	+
1688	+	SQL_DEC_FIXED,
1689	+	SQL_INT128:
1690	+	result := Int128ToStr(SQLData,scale);
1691	+
1692		else
1693		IBError(ibxeInvalidDataConversion, [nil]);
1694		end;
#	Line 1316 | Line 1707 | begin
1707		end;
1708
1709		function TSQLDataItem.GetAsVariant: Variant;
1710	+	var ts: TDateTime;
1711	+	dstOffset: smallint;
1712	+	timezone: AnsiString;
1713		begin
1714		CheckActive;
1715		if IsNull then
#	Line 1329 | Line 1723 | begin
1723		result := AsString;
1724		SQL_TIMESTAMP, SQL_TYPE_DATE, SQL_TYPE_TIME:
1725		result := AsDateTime;
1726	+	SQL_TIMESTAMP_TZ,
1727	+	SQL_TIME_TZ,
1728	+	SQL_TIMESTAMP_TZ_EX,
1729	+	SQL_TIME_TZ_EX:
1730	+	begin
1731	+	GetAsDateTime(ts,dstOffset,timezone);
1732	+	result := VarArrayOf([ts,dstOffset,timezone]);
1733	+	end;
1734		SQL_SHORT, SQL_LONG:
1735		if Scale = 0 then
1736		result := AsLong
#	Line 1347 | Line 1749 | begin
1749		result := AsDouble;
1750		SQL_BOOLEAN:
1751		result := AsBoolean;
1752	+	SQL_DEC_FIXED,
1753	+	SQL_DEC16,
1754	+	SQL_DEC34,
1755	+	SQL_INT128:
1756	+	result := VarFmtBCDCreate(GetAsBcd);
1757		else
1758		IBError(ibxeInvalidDataConversion, [nil]);
1759		end;
#	Line 1367 | Line 1774 | begin
1774		Result := Length(GetDateFormatStr(true));
1775		dfTime:
1776		Result := Length(GetTimeFormatStr);
1777	+	dfTimestampTZ:
1778	+	Result := Length(GetTimestampFormatStr) + 6; {assume time offset format}
1779	+	dfTimeTZ:
1780	+	Result := Length(GetTimeFormatStr)+ 6;
1781		else
1782		Result := 0;
1783	+	end;end;
1784	+
1785	+	function TSQLDataItem.GetAsBCD: tBCD;
1786	+
1787	+	begin
1788	+	CheckActive;
1789	+	if IsNull then
1790	+	with Result do
1791	+	begin
1792	+	FillChar(Result,sizeof(Result),0);
1793	+	Precision := 1;
1794	+	exit;
1795	+	end;
1796	+
1797	+	case SQLType of
1798	+	SQL_DEC16,
1799	+	SQL_DEC34:
1800	+	with FFirebirdClientAPI do
1801	+	Result := SQLDecFloatDecode(SQLType,  SQLData);
1802	+
1803	+	SQL_DEC_FIXED,
1804	+	SQL_INT128:
1805	+	with FFirebirdClientAPI do
1806	+	Result := StrToBCD(Int128ToStr(SQLData,scale));
1807	+	else
1808	+	if not CurrToBCD(GetAsCurrency,Result) then
1809	+	IBError(ibxeBadBCDConversion,[]);
1810		end;
1811		end;
1812
#	Line 1460 | Line 1898 | begin
1898		Changed;
1899		end;
1900
1901	+	procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
1902	+	begin
1903	+	CheckActive;
1904	+	CheckTZSupport;
1905	+	if GetSQLDialect < 3 then
1906	+	begin
1907	+	AsDateTime := aValue;
1908	+	exit;
1909	+	end;
1910	+
1911	+	Changing;
1912	+	if IsNullable then
1913	+	IsNull := False;
1914	+
1915	+	SQLType := SQL_TIME_TZ;
1916	+	DataLength := SizeOf(ISC_TIME_TZ);
1917	+	GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZoneID,OnDate,SQLData);
1918	+	Changed;
1919	+	end;
1920	+
1921	+	procedure TSQLDataItem.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
1922	+	begin
1923	+	CheckActive;
1924	+	CheckTZSupport;
1925	+	if GetSQLDialect < 3 then
1926	+	begin
1927	+	AsDateTime := aValue;
1928	+	exit;
1929	+	end;
1930	+
1931	+	Changing;
1932	+	if IsNullable then
1933	+	IsNull := False;
1934	+
1935	+	SQLType := SQL_TIME_TZ;
1936	+	DataLength := SizeOf(ISC_TIME_TZ);
1937	+	GetTimeZoneServices.EncodeTimeTZ(aValue, aTimeZone,OnDate,SQLData);
1938	+	Changed;
1939	+	end;
1940	+
1941		procedure TSQLDataItem.SetAsDateTime(Value: TDateTime);
1942		begin
1943		CheckActive;
#	Line 1474 | Line 1952 | begin
1952		Changed;
1953		end;
1954
1955	+	procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime;
1956	+	aTimeZoneID: TFBTimeZoneID);
1957	+	begin
1958	+	CheckActive;
1959	+	CheckTZSupport;
1960	+	if IsNullable then
1961	+	IsNull := False;
1962	+
1963	+	Changing;
1964	+	SQLType := SQL_TIMESTAMP_TZ;
1965	+	DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1966	+	GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZoneID,SQLData);
1967	+	Changed;
1968	+	end;
1969	+
1970	+	procedure TSQLDataItem.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString
1971	+	);
1972	+	begin
1973	+	CheckActive;
1974	+	CheckTZSupport;
1975	+	if IsNullable then
1976	+	IsNull := False;
1977	+
1978	+	Changing;
1979	+	SQLType := SQL_TIMESTAMP_TZ;
1980	+	DataLength := SizeOf(ISC_TIMESTAMP_TZ);
1981	+	GetTimeZoneServices.EncodeTimestampTZ(aValue,aTimeZone,SQLData);
1982	+	Changed;
1983	+	end;
1984	+
1985	+	procedure TSQLDataItem.SetAsUTCDateTime(aUTCTime: TDateTime);
1986	+	begin
1987	+	SetAsDateTime(aUTCTime,TimeZoneID_GMT);
1988	+	end;
1989	+
1990		procedure TSQLDataItem.SetAsDouble(Value: Double);
1991		begin
1992		CheckActive;
#	Line 1569 | Line 2082 | begin
2082		CheckActive;
2083		if VarIsNull(Value) then
2084		IsNull := True
2085	+	else
2086	+	if VarIsArray(Value) then {must be datetime plus timezone}
2087	+	SetAsDateTime(Value[0],AnsiString(Value[1]))
2088		else case VarType(Value) of
2089		varEmpty, varNull:
2090		IsNull := True;
#	Line 1591 | Line 2107 | begin
2107		IBError(ibxeNotSupported, [nil]);
2108		varByRef, varDispatch, varError, varUnknown, varVariant:
2109		IBError(ibxeNotPermitted, [nil]);
2110	+	else
2111	+	if VarIsFmtBCD(Value) then
2112	+	SetAsBCD(VarToBCD(Value))
2113	+	else
2114	+	IBError(ibxeNotSupported, [nil]);
2115		end;
2116		end;
2117
#	Line 1608 | Line 2129 | begin
2129		Changed;
2130		end;
2131
2132	+	procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2133	+	var C: Currency;
2134	+	begin
2135	+	CheckActive;
2136	+	Changing;
2137	+	if IsNullable then
2138	+	IsNull := False;
2139	+
2140	+
2141	+	with FFirebirdClientAPI do
2142	+	if aValue.Precision <= 16 then
2143	+	begin
2144	+	if not HasDecFloatSupport then
2145	+	IBError(ibxeDecFloatNotSupported,[]);
2146	+
2147	+	SQLType := SQL_DEC16;
2148	+	DataLength := 8;
2149	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
2150	+	end
2151	+	else
2152	+	if aValue.Precision <= 34 then
2153	+	begin
2154	+	if not HasDecFloatSupport then
2155	+	IBError(ibxeDecFloatNotSupported,[]);
2156	+
2157	+	SQLType := SQL_DEC34;
2158	+	DataLength := 16;
2159	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
2160	+	end
2161	+	else
2162	+	if aValue.Precision <= 38 then
2163	+	begin
2164	+	if not HasInt128Support then
2165	+	IBError(ibxeInt128NotSupported,[]);
2166	+
2167	+	SQLType := SQL_INT128;
2168	+	DataLength := 16;
2169	+	StrToInt128(scale,BcdToStr(aValue),SQLData);
2170	+	end
2171	+	else
2172	+	IBError(ibxeBCDOverflow,[BCDToStr(aValue)]);
2173	+
2174	+	Changed;
2175	+	end;
2176	+
2177		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
2178		begin
2179		CheckActive;
#	Line 1638 | Line 2204 | begin
2204		IBError(ibxeStatementNotPrepared, [nil]);
2205		end;
2206
2207	+	function TColumnMetaData.GetAttachment: IAttachment;
2208	+	begin
2209	+	Result := GetStatement.GetAttachment;
2210	+	end;
2211	+
2212		function TColumnMetaData.SQLData: PByte;
2213		begin
2214		Result := FIBXSQLVAR.SQLData;
#	Line 1742 | Line 2313 | end;
2313		function TColumnMetaData.GetSize: cardinal;
2314		begin
2315		CheckActive;
2316	<	result := FIBXSQLVAR.DataLength;
2316	>	result := FIBXSQLVAR.GetSize;
2317	>	end;
2318	>
2319	>	function TColumnMetaData.GetCharSetWidth: integer;
2320	>	begin
2321	>	CheckActive;
2322	>	result := FIBXSQLVAR.GetCharSetWidth;
2323		end;
2324
2325		function TColumnMetaData.GetArrayMetaData: IArrayMetaData;
#	Line 1847 | Line 2424 | end;
2424
2425		var b: IBlob;
2426		dt: TDateTime;
2427	<	CurrValue: Currency;
2428	<	FloatValue: single;
2427	>	timezone: AnsiString;
2428	>	FloatValue: Double;
2429	>	Int64Value: Int64;
2430	>	BCDValue: TBCD;
2431	>	aScale: integer;
2432		begin
2433		CheckActive;
2434		if IsNullable then
2435		IsNull := False;
2436	<	case SQLTYPE of
2436	>	with FFirebirdClientAPI do
2437	>	case getColMetaData.SQLTYPE of
2438		SQL_BOOLEAN:
2439		if AnsiCompareText(Value,STrue) = 0 then
2440		AsBoolean := true
#	Line 1864 | Line 2445 | begin
2445		IBError(ibxeInvalidDataConversion,[nil]);
2446
2447		SQL_BLOB:
2448	+	if Length(Value) < GetAttachment.GetInlineBlobLimit then
2449	+	DoSetString
2450	+	else
2451		begin
2452		Changing;
2453		b := FIBXSQLVAR.CreateBlob;
#	Line 1876 | Line 2460 | begin
2460		SQL_TEXT:
2461		DoSetString;
2462
2463	<	SQL_SHORT,
2464	<	SQL_LONG,
2465	<	SQL_INT64:
2466	<	if TryStrToCurr(Value,CurrValue) then
2467	<	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2468	<	else
2469	<	DoSetString;
2470	<
2471	<	SQL_D_FLOAT,
1888	<	SQL_DOUBLE,
1889	<	SQL_FLOAT:
2463	>	SQL_SHORT,
2464	>	SQL_LONG,
2465	>	SQL_INT64:
2466	>	{If the string contains an integer then convert and set directly}
2467	>	if TryStrToInt64(Value,Int64Value) then
2468	>	SetAsInt64(Int64Value)
2469	>	else
2470	>	if getColMetaData.getScale = 0 then {integer expected but non-integer string}
2471	>	begin
2472		if TryStrToFloat(Value,FloatValue) then
2473	<	SetAsDouble(FloatValue)
2473	>	{truncate it if the column is limited to an integer}
2474	>	SetAsInt64(Trunc(FloatValue))
2475		else
2476		DoSetString;
2477	+	end
2478	+	else
2479	+	if TryStrToFloat(Value,FloatValue) then
2480	+	begin
2481	+	aScale := getColMetaData.getScale;
2482	+	{Set as int64 with adjusted scale}
2483	+	SetAsNumeric(AdjustScaleFromDouble(FloatValue,aScale),aScale)
2484	+	end
2485	+	else
2486	+	DoSetString;
2487	+
2488	+	SQL_DEC_FIXED,
2489	+	SQL_DEC16,
2490	+	SQL_DEC34,
2491	+	SQL_INT128:
2492	+	if TryStrToBCD(Value,BCDValue) then
2493	+	SetAsBCD(BCDValue)
2494	+	else
2495	+	DoSetString;
2496
2497	<	SQL_TIMESTAMP:
2497	>	SQL_D_FLOAT,
2498	>	SQL_DOUBLE,
2499	>	SQL_FLOAT:
2500	>	if TryStrToFloat(Value,FloatValue) then
2501	>	SetAsDouble(FloatValue)
2502	>	else
2503	>	DoSetString;
2504	>
2505	>	SQL_TIMESTAMP:
2506		if TryStrToDateTime(Value,dt) then
2507		SetAsDateTime(dt)
2508		else
2509		DoSetString;
2510
2511	<	SQL_TYPE_DATE:
2511	>	SQL_TYPE_DATE:
2512		if TryStrToDateTime(Value,dt) then
2513		SetAsDate(dt)
2514		else
2515		DoSetString;
2516
2517	<	SQL_TYPE_TIME:
2517	>	SQL_TYPE_TIME:
2518		if TryStrToDateTime(Value,dt) then
2519		SetAsTime(dt)
2520		else
2521		DoSetString;
2522
2523	<	else
2524	<	IBError(ibxeInvalidDataConversion,[nil]);
2523	>	SQL_TIMESTAMP_TZ,
2524	>	SQL_TIMESTAMP_TZ_EX:
2525	>	if ParseDateTimeTZString(value,dt,timezone) then
2526	>	SetAsDateTime(dt,timezone)
2527	>	else
2528	>	DoSetString;
2529	>
2530	>	SQL_TIME_TZ,
2531	>	SQL_TIME_TZ_EX:
2532	>	if ParseDateTimeTZString(value,dt,timezone,true) then
2533	>	SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2534	>	else
2535	>	DoSetString;
2536	>
2537	>	else
2538	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2539		end;
2540		end;
2541
#	Line 1949 | Line 2573 | begin
2573		IsNull := true;
2574		end;
2575
2576	+	function TSQLParam.getColMetadata: IParamMetaData;
2577	+	begin
2578	+	Result := FIBXSQLVAR.getColMetadata;
2579	+	end;
2580	+
2581		function TSQLParam.GetModified: boolean;
2582		begin
2583		CheckActive;
#	Line 1962 | Line 2591 | begin
2591		Result := inherited GetAsPointer;
2592		end;
2593
2594	+	function TSQLParam.GetAsString: AnsiString;
2595	+	var rs: RawByteString;
2596	+	begin
2597	+	Result := '';
2598	+	if (SQLType = SQL_VARYING) and not IsNull then
2599	+	{SQLData points to start of string - default is to length word}
2600	+	begin
2601	+	CheckActive;
2602	+	SetString(rs,PAnsiChar(SQLData),DataLength);
2603	+	SetCodePage(rs,GetCodePage,false);
2604	+	Result := rs;
2605	+	end
2606	+	else
2607	+	Result := inherited GetAsString;
2608	+	end;
2609	+
2610		procedure TSQLParam.SetName(Value: AnsiString);
2611		begin
2612		CheckActive;
#	Line 2153 | Line 2798 | begin
2798		end;
2799		end;
2800
2801	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID);
2802	+	var i: integer;
2803	+	OldSQLVar: TSQLVarData;
2804	+	begin
2805	+	if FIBXSQLVAR.UniqueName then
2806	+	inherited SetAsTime(AValue,OnDate, aTimeZoneID)
2807	+	else
2808	+	with FIBXSQLVAR.Parent do
2809	+	begin
2810	+	for i := 0 to Count - 1 do
2811	+	if Column[i].Name = Name then
2812	+	begin
2813	+	OldSQLVar := FIBXSQLVAR;
2814	+	FIBXSQLVAR := Column[i];
2815	+	try
2816	+	inherited SetAsTime(AValue,OnDate, aTimeZoneID);
2817	+	finally
2818	+	FIBXSQLVAR := OldSQLVar;
2819	+	end;
2820	+	end;
2821	+	end;
2822	+	end;
2823	+
2824	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString);
2825	+	var i: integer;
2826	+	OldSQLVar: TSQLVarData;
2827	+	begin
2828	+	if FIBXSQLVAR.UniqueName then
2829	+	inherited SetAsTime(AValue,OnDate,aTimeZone)
2830	+	else
2831	+	with FIBXSQLVAR.Parent do
2832	+	begin
2833	+	for i := 0 to Count - 1 do
2834	+	if Column[i].Name = Name then
2835	+	begin
2836	+	OldSQLVar := FIBXSQLVAR;
2837	+	FIBXSQLVAR := Column[i];
2838	+	try
2839	+	inherited SetAsTime(AValue,OnDate,aTimeZone);
2840	+	finally
2841	+	FIBXSQLVAR := OldSQLVar;
2842	+	end;
2843	+	end;
2844	+	end;
2845	+	end;
2846	+
2847	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID);
2848	+	begin
2849	+	SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZoneID);
2850	+	end;
2851	+
2852	+	procedure TSQLParam.SetAsTime(aValue: TDateTime; aTimeZone: AnsiString);
2853	+	begin
2854	+	SetAsTime(aValue,GetTimeZoneServices.GetTimeTZDate,aTimeZone);
2855	+	end;
2856	+
2857		procedure TSQLParam.SetAsDateTime(AValue: TDateTime);
2858		var i: integer;
2859		OldSQLVar: TSQLVarData;
#	Line 2176 | Line 2877 | begin
2877		end;
2878		end;
2879
2880	+	procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID
2881	+	);
2882	+	var i: integer;
2883	+	OldSQLVar: TSQLVarData;
2884	+	begin
2885	+	if FIBXSQLVAR.UniqueName then
2886	+	inherited SetAsDateTime(AValue,aTimeZoneID)
2887	+	else
2888	+	with FIBXSQLVAR.Parent do
2889	+	begin
2890	+	for i := 0 to Count - 1 do
2891	+	if Column[i].Name = Name then
2892	+	begin
2893	+	OldSQLVar := FIBXSQLVAR;
2894	+	FIBXSQLVAR := Column[i];
2895	+	try
2896	+	inherited SetAsDateTime(AValue,aTimeZoneID);
2897	+	finally
2898	+	FIBXSQLVAR := OldSQLVar;
2899	+	end;
2900	+	end;
2901	+	end;
2902	+	end;
2903	+
2904	+	procedure TSQLParam.SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString);
2905	+	var i: integer;
2906	+	OldSQLVar: TSQLVarData;
2907	+	begin
2908	+	if FIBXSQLVAR.UniqueName then
2909	+	inherited SetAsDateTime(AValue,aTimeZone)
2910	+	else
2911	+	with FIBXSQLVAR.Parent do
2912	+	begin
2913	+	for i := 0 to Count - 1 do
2914	+	if Column[i].Name = Name then
2915	+	begin
2916	+	OldSQLVar := FIBXSQLVAR;
2917	+	FIBXSQLVAR := Column[i];
2918	+	try
2919	+	inherited SetAsDateTime(AValue,aTimeZone);
2920	+	finally
2921	+	FIBXSQLVAR := OldSQLVar;
2922	+	end;
2923	+	end;
2924	+	end;
2925	+	end;
2926	+
2927		procedure TSQLParam.SetAsDouble(AValue: Double);
2928		var i: integer;
2929		OldSQLVar: TSQLVarData;
#	Line 2356 | Line 3104 | begin
3104		FIBXSQLVAR.SetCharSetID(aValue);
3105		end;
3106
3107	+	procedure TSQLParam.SetAsBcd(aValue: tBCD);
3108	+	var i: integer;
3109	+	OldSQLVar: TSQLVarData;
3110	+	begin
3111	+	if FIBXSQLVAR.UniqueName then
3112	+	inherited SetAsBcd(AValue)
3113	+	else
3114	+	with FIBXSQLVAR.Parent do
3115	+	begin
3116	+	for i := 0 to Count - 1 do
3117	+	if Column[i].Name = Name then
3118	+	begin
3119	+	OldSQLVar := FIBXSQLVAR;
3120	+	FIBXSQLVAR := Column[i];
3121	+	try
3122	+	inherited SetAsBcd(AValue);
3123	+	finally
3124	+	FIBXSQLVAR := OldSQLVar;
3125	+	end;
3126	+	end;
3127	+	end;
3128	+	end;
3129	+
3130		{ TMetaData }
3131
3132		procedure TMetaData.CheckActive;
#	Line 2511 | Line 3282 | begin
3282		if not FResults.CheckStatementStatus(ssPrepared)  then
3283		IBError(ibxeStatementNotPrepared, [nil]);
3284
3285	<	with GetTransaction as TFBTransaction do
3285	>	with GetTransaction do
3286		if not InTransaction or (FResults.TransactionSeqNo <> FTransactionSeqNo) then
3287		IBError(ibxeInterfaceOutofDate,[nil]);
3288		end;

Diff Legend

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