ViewVC Help

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

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

Comparing:
ibx/trunk/fbintf/client/FBArray.pas (file contents), Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
ibx/branches/udr/client/FBArray.pas (file contents), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

#	Line 38 | Line 38 | unit FBArray;
38		interface
39
40		uses
41	<	Classes, SysUtils, IB, IBHeader, FBTransaction,
42	<	FBSQLData,  FBClientAPI, IBExternals, FBActivityMonitor;
41	>	Classes, SysUtils, IBHeader, IB,  FBTransaction,
42	>	FBSQLData,  FBClientAPI, IBExternals, FBActivityMonitor, FmtBCD;
43
44		(*
45
#	Line 75 | Line 75 | type
75		FBufPtr: PByte;
76		FArray: TFBArray;
77		protected
78	+	function GetAttachment: IAttachment; override;
79		function GetSQLDialect: integer; override;
80		procedure Changing; override;
81		procedure Changed; override;
#	Line 99 | Line 100 | type
100		procedure SetAsDouble(Value: Double); override;
101		procedure SetAsFloat(Value: Float); override;
102		procedure SetAsCurrency(Value: Currency); override;
103	+	procedure SetAsBcd(aValue: tBCD); override;
104	+	procedure SetAsNumeric(Value: IFBNumeric); override;
105		end;
106
107		{ TFBArrayMetaData }
#	Line 138 | Line 141 | type
141
142		{ TFBArray }
143
144	<	TFBArray = class(TActivityReporter,IArray)
144	>	TFBArray = class(TActivityReporter,IArray,ITransactionUser)
145		private
146		FFirebirdClientAPI: TFBClientAPI;
147		FMetaData: IArrayMetaData;
#	Line 175 | Line 178 | type
178		aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
179		destructor Destroy; override;
180		function GetSQLDialect: integer;
181	+
182	+	public
183	+	{ITransactionUser}
184		procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
185
186		public
#	Line 200 | Line 206 | type
206		function GetAsBoolean(index: array of integer): boolean;
207		function GetAsCurrency(index: array of integer): Currency;
208		function GetAsInt64(index: array of integer): Int64;
209	<	function GetAsDateTime(index: array of integer): TDateTime;
209	>	function GetAsDateTime(index: array of integer): TDateTime; overload;
210	>	procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
211	>	procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
212	>	procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
213	>	procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
214	>	function GetAsUTCDateTime(index: array of integer): TDateTime;
215		function GetAsDouble(index: array of integer): Double;
216		function GetAsFloat(index: array of integer): Float;
217		function GetAsLong(index: array of integer): Long;
218		function GetAsShort(index: array of integer): Short;
219		function GetAsString(index: array of integer): AnsiString;
220		function GetAsVariant(index: array of integer): Variant;
221	+	function GetAsBCD(index: array of integer): tBCD;
222		procedure SetAsInteger(index: array of integer; AValue: integer);
223		procedure SetAsBoolean(index: array of integer; AValue: boolean);
224		procedure SetAsCurrency(index: array of integer; Value: Currency);
225		procedure SetAsInt64(index: array of integer; Value: Int64);
226		procedure SetAsDate(index: array of integer; Value: TDateTime);
227		procedure SetAsLong(index: array of integer; Value: Long);
228	<	procedure SetAsTime(index: array of integer; Value: TDateTime);
229	<	procedure SetAsDateTime(index: array of integer; Value: TDateTime);
228	>	procedure SetAsTime(index: array of integer; Value: TDateTime); overload;
229	>	procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
230	>	procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
231	>	procedure SetAsDateTime(index: array of integer; Value: TDateTime); overload;
232	>	procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
233	>	procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZone: AnsiString); overload;
234	>	procedure SetAsUTCDateTime(index: array of integer; aUTCTime: TDateTime);
235		procedure SetAsDouble(index: array of integer; Value: Double);
236		procedure SetAsFloat(index: array of integer; Value: Float);
237		procedure SetAsShort(index: array of integer; Value: Short);
238		procedure SetAsString(index: array of integer; Value: AnsiString);
239		procedure SetAsVariant(index: array of integer; Value: Variant);
240	+	procedure SetAsBcd(index: array of integer; aValue: tBCD);
241		procedure SetBounds(dim, UpperBound, LowerBound: integer);
242		function GetAttachment: IAttachment;
243		function GetTransaction: ITransaction;
#	Line 229 | Line 247 | type
247
248		implementation
249
250	<	uses FBMessages;
250	>	uses FBMessages, IBUtils, FBNumeric;
251
252		{ TFBArrayElement }
253
254	+	function TFBArrayElement.GetAttachment: IAttachment;
255	+	begin
256	+	Result := FArray.GetAttachment;
257	+	end;
258	+
259		function TFBArrayElement.GetSQLDialect: integer;
260		begin
261		Result := FArray.GetSQLDialect;
#	Line 344 | Line 367 | begin
367		CheckActive;
368		case GetSQLType of
369		SQL_LONG:
370	<	PLong(SQLData)^ := Value;
370	>	PLong(SQLData)^ := NumericFromRawValues(Value,getScale).getRawValue;
371		SQL_SHORT:
372	<	PShort(SQLData)^ := Value;
372	>	PShort(SQLData)^ := NumericFromRawValues(Value,getScale).getRawValue;
373		SQL_INT64:
374	<	PInt64(SQLData)^ := Value;
374	>	PInt64(SQLData)^ := NumericFromRawValues(Value,getScale).getRawValue;
375		SQL_TEXT, SQL_VARYING:
376		SetAsString(IntToStr(Value));
377		SQL_D_FLOAT,
#	Line 365 | Line 388 | end;
388		procedure TFBArrayElement.SetAsString(Value: AnsiString);
389		var len: integer;
390		ElementSize: integer;
391	+	Int64Value: Int64;
392	+	aScale: integer;
393		begin
394		CheckActive;
395		case GetSQLType of
#	Line 405 | Line 430 | begin
430		SQL_SHORT,
431		SQL_LONG,
432		SQL_INT64:
433	<	if trim(Value) = '' then
434	<	SetAsInt64(0)
433	>	if TryStrToNumeric(Value,Int64Value,aScale) then
434	>	SetAsNumeric(NumericFromRawValues(Int64Value,aScale))
435		else
436	<	SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
436	>	SetAsCurrency(StrToCurr(Value));
437
438		SQL_D_FLOAT,
439		SQL_DOUBLE,
440		SQL_FLOAT:
441	<	if trim(Value) = '' then
442	<	SetAsDouble(0)
443	<	else
444	<	SetAsDouble(StrToFloat(Value));
441	>	if TryStrToNumeric(Value,Int64Value,aScale) then
442	>	SetAsDouble(NumericToDouble(Int64Value,AScale))
443	>	else
444	>	IBError(ibxeInvalidDataConversion,[nil]);
445	>
446	>	SQL_DEC_FIXED,
447	>	SQL_DEC16,
448	>	SQL_DEC34,
449	>	SQL_INT128:
450	>	SetAsBCD(StrToBCD(Value));
451
452		SQL_TIMESTAMP:
453		SetAsDateTime(StrToDateTime(Value));
#	Line 443 | Line 474 | begin
474		PSingle(SQLData)^ := Value;
475		SQL_SHORT:
476		if Scale < 0 then
477	<	PShort(SQLData)^ := AdjustScaleFromDouble(Value,Scale)
477	>	PShort(SQLData)^ := SafeSmallInt(NewNumeric(Value,Scale).getRawValue)
478		else
479		IBError(ibxeInvalidDataConversion, [nil]);
480		SQL_LONG:
481		if Scale < 0 then
482	<	PLong(SQLData)^ := AdjustScaleFromDouble(Value,Scale)
482	>	PLong(SQLData)^ := SafeInteger(NewNumeric(Value,Scale).getRawValue)
483		else
484		IBError(ibxeInvalidDataConversion, [nil]);
485		SQL_INT64:
486		if Scale < 0 then
487	<	PInt64(SQLData)^ := AdjustScaleFromDouble(Value,Scale)
487	>	PInt64(SQLData)^ := NewNumeric(Value,Scale).getRawValue
488		else
489		IBError(ibxeInvalidDataConversion, [nil]);
490		SQL_TEXT, SQL_VARYING:
#	Line 479 | Line 510 | begin
510		if Scale = -4 then
511		PCurrency(SQLData)^ := Value
512		else
513	<	PInt64(SQLData)^ := AdjustScaleFromCurrency(Value,Scale);
513	>	PInt64(SQLData)^ := NewNumeric(Value).clone(Scale).getRawValue;
514		Changed;
515		end
516		end;
517
518	+	procedure TFBArrayElement.SetAsBcd(aValue: tBCD);
519	+	var C: Currency;
520	+	begin
521	+	CheckActive;
522	+	with FirebirdClientAPI do
523	+	case SQLType of
524	+	SQL_DEC_FIXED,
525	+	SQL_DEC16,
526	+	SQL_DEC34:
527	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
528	+
529	+	SQL_INT128:
530	+	StrToInt128(Scale,BcdToStr(aValue),SQLData);
531	+
532	+	else
533	+	begin
534	+	BCDToCurr(aValue,C);
535	+	SetAsCurrency(C);
536	+	end;
537	+	end;
538	+	Changed;
539	+	end;
540	+
541	+	procedure TFBArrayElement.SetAsNumeric(Value: IFBNumeric);
542	+	begin
543	+	CheckActive;
544	+	case GetSQLType of
545	+	SQL_LONG:
546	+	PLong(SQLData)^ := SafeInteger(Value.clone(Scale).getRawValue);
547	+	SQL_SHORT:
548	+	PShort(SQLData)^ := SafeSmallInt(Value.clone(Scale).getRawValue);
549	+	SQL_INT64:
550	+	PInt64(SQLData)^ := Value.clone(Scale).getRawValue;
551	+	SQL_TEXT, SQL_VARYING:
552	+	SetAsString(Value.getAsString);
553	+	SQL_D_FLOAT,
554	+	SQL_DOUBLE:
555	+	PDouble(SQLData)^ := Value.getAsDouble;
556	+	SQL_FLOAT:
557	+	PSingle(SQLData)^ := Value.getAsDouble;
558	+	else
559	+	IBError(ibxeInvalidDataConversion, [nil]);
560	+	end;
561	+	Changed;
562	+	end;
563	+
564		procedure TFBArrayElement.SetSQLType(aValue: cardinal);
565		begin
566	<	if aValue = GetSQLType then
566	>	if aValue <> GetSQLType then
567		IBError(ibxeInvalidDataConversion, [nil]);
568		end;
569
#	Line 553 | Line 630 | begin
630		Result :=  SQL_TYPE_TIME;
631		blr_int64:
632		Result := SQL_INT64;
633	+	blr_sql_time_tz:
634	+	Result := SQL_TIME_TZ;
635	+	blr_timestamp_tz:
636	+	Result := SQL_TIMESTAMP_TZ;
637	+	blr_ex_time_tz:
638	+	Result := SQL_TIME_TZ_EX;
639	+	blr_ex_timestamp_tz:
640	+	Result := SQL_TIMESTAMP_TZ_EX;
641	+	blr_dec64:
642	+	Result := SQL_DEC16;
643	+	blr_dec128:
644	+	Result := SQL_DEC34;
645	+	blr_int128:
646	+	Result := SQL_INT128;
647		end;
648		end;
649
#	Line 563 | Line 654 | end;
654
655		function TFBArrayMetaData.GetScale: integer;
656		begin
657	<	Result := byte(FArrayDesc.array_desc_scale);
657	>	Result := FArrayDesc.array_desc_scale;
658		end;
659
660		function TFBArrayMetaData.GetSize: cardinal;
#	Line 626 | Line 717 | begin
717		Result :=  blr_sql_time;
718		SQL_INT64:
719		Result := blr_int64;
720	+	SQL_TIME_TZ:
721	+	Result := blr_sql_time_tz;
722	+	SQL_TIMESTAMP_TZ:
723	+	Result := blr_timestamp_tz;
724	+	SQL_TIME_TZ_EX:
725	+	Result := blr_ex_time_tz;
726	+	SQL_TIMESTAMP_TZ_EX:
727	+	Result := blr_ex_timestamp_tz;
728	+	SQL_DEC16:
729	+	Result := blr_dec64;
730	+	SQL_DEC34:
731	+	Result := blr_dec128;
732	+	SQL_INT128:
733	+	Result := blr_int128;
734		end;
735		end;
736
#	Line 717 | Line 822 | begin
822		InternalPutSlice(Force);
823		FModified := false;
824		FIsNew := false;
825	+	FLoaded := true;
826		end;
827
828		function TFBArray.GetOffset(index: array of integer): PByte;
#	Line 835 | Line 941 | end;
941		procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean
942		);
943		begin
944	<	if (aTransaction = FTransactionIntf) and FModified and not FIsNew then
944	>	if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then
945		PutArraySlice(Force);
946		end;
947
#	Line 924 | Line 1030 | begin
1030		Result := FElement.GetAsDateTime;
1031		end;
1032
1033	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1034	+	var aDateTime: TDateTime; var dstOffset: smallint;
1035	+	var aTimezoneID: TFBTimeZoneID);
1036	+	begin
1037	+	GetArraySlice;
1038	+	FElement.FBufPtr := GetOffset(index);
1039	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID);
1040	+	end;
1041	+
1042	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1043	+	var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString);
1044	+	begin
1045	+	GetArraySlice;
1046	+	FElement.FBufPtr := GetOffset(index);
1047	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone);
1048	+	end;
1049	+
1050	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1051	+	var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1052	+	begin
1053	+	GetArraySlice;
1054	+	FElement.FBufPtr := GetOffset(index);
1055	+	FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate);
1056	+	end;
1057	+
1058	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1059	+	var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime);
1060	+	begin
1061	+	GetArraySlice;
1062	+	FElement.FBufPtr := GetOffset(index);
1063	+	FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate);
1064	+	end;
1065	+
1066	+	function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime;
1067	+	begin
1068	+	GetArraySlice;
1069	+	FElement.FBufPtr := GetOffset(index);
1070	+	Result := FElement.GetAsUTCDateTime;
1071	+	end;
1072	+
1073		function TFBArray.GetAsDouble(index: array of integer): Double;
1074		begin
1075		GetArraySlice;
#	Line 966 | Line 1112 | begin
1112		Result := FElement.GetAsVariant;
1113		end;
1114
1115	+	function TFBArray.GetAsBCD(index: array of integer): tBCD;
1116	+	begin
1117	+	GetArraySlice;
1118	+	FElement.FBufPtr := GetOffset(index);
1119	+	Result := FElement.GetAsBCD;
1120	+	end;
1121	+
1122		procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer);
1123		begin
1124		FElement.FBufPtr := GetOffset(index);
#	Line 1008 | Line 1161 | begin
1161		FElement.SetAsTime(Value);
1162		end;
1163
1164	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1165	+	aTimeZoneID: TFBTimeZoneID);
1166	+	begin
1167	+	FElement.FBufPtr := GetOffset(index);
1168	+	FElement.SetAsTime(aValue,OnDate,aTimeZoneID);
1169	+	end;
1170	+
1171	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1172	+	aTimeZone: AnsiString);
1173	+	begin
1174	+	FElement.FBufPtr := GetOffset(index);
1175	+	FElement.SetAsTime(aValue,OnDate, aTimeZone);
1176	+	end;
1177	+
1178		procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime);
1179		begin
1180		FElement.FBufPtr := GetOffset(index);
1181		FElement.SetAsDateTime(Value);
1182		end;
1183
1184	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1185	+	aTimeZoneID: TFBTimeZoneID);
1186	+	begin
1187	+	FElement.FBufPtr := GetOffset(index);
1188	+	FElement.SetAsDateTime(aValue,aTimeZoneID);
1189	+	end;
1190	+
1191	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1192	+	aTimeZone: AnsiString);
1193	+	begin
1194	+	FElement.FBufPtr := GetOffset(index);
1195	+	FElement.SetAsDateTime(aValue,aTimeZone);
1196	+	end;
1197	+
1198	+	procedure TFBArray.SetAsUTCDateTime(index: array of integer;
1199	+	aUTCTime: TDateTime);
1200	+	begin
1201	+	FElement.FBufPtr := GetOffset(index);
1202	+	FElement.SetAsUTCDateTime(aUTCTime);
1203	+	end;
1204	+
1205		procedure TFBArray.SetAsDouble(index: array of integer; Value: Double);
1206		begin
1207		FElement.FBufPtr := GetOffset(index);
#	Line 1044 | Line 1232 | begin
1232		FElement.SetAsVariant(Value);
1233		end;
1234
1235	+	procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD);
1236	+	begin
1237	+	FElement.FBufPtr := GetOffset(index);
1238	+	FElement.SetAsBcd(aValue);
1239	+	end;
1240	+
1241		procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer);
1242		begin
1243		with (FMetaData as TFBArrayMetaData) do

Comparing:
ibx/trunk/fbintf/client/FBArray.pas (property svn:eol-style), Revision 309 by tony, Tue Jul 21 08:00:42 2020 UTC vs.
ibx/branches/udr/client/FBArray.pas (property svn:eol-style), Revision 379 by tony, Mon Jan 10 10:08:03 2022 UTC

#	Line 0 | Line 1
1	+	native

Diff Legend

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