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.
Revision 349 by tony, Mon Oct 18 08:39:40 2021 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		end;
105
106		{ TFBArrayMetaData }
#	Line 138 | Line 140 | type
140
141		{ TFBArray }
142
143	<	TFBArray = class(TActivityReporter,IArray)
143	>	TFBArray = class(TActivityReporter,IArray,ITransactionUser)
144		private
145		FFirebirdClientAPI: TFBClientAPI;
146		FMetaData: IArrayMetaData;
#	Line 175 | Line 177 | type
177		aField: IArrayMetaData; ArrayID: TISC_QUAD); overload;
178		destructor Destroy; override;
179		function GetSQLDialect: integer;
180	+
181	+	public
182	+	{ITransactionUser}
183		procedure TransactionEnding(aTransaction: ITransaction; Force: boolean);
184
185		public
#	Line 200 | Line 205 | type
205		function GetAsBoolean(index: array of integer): boolean;
206		function GetAsCurrency(index: array of integer): Currency;
207		function GetAsInt64(index: array of integer): Int64;
208	<	function GetAsDateTime(index: array of integer): TDateTime;
208	>	function GetAsDateTime(index: array of integer): TDateTime; overload;
209	>	procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
210	>	procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
211	>	procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
212	>	procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
213	>	function GetAsUTCDateTime(index: array of integer): TDateTime;
214		function GetAsDouble(index: array of integer): Double;
215		function GetAsFloat(index: array of integer): Float;
216		function GetAsLong(index: array of integer): Long;
217		function GetAsShort(index: array of integer): Short;
218		function GetAsString(index: array of integer): AnsiString;
219		function GetAsVariant(index: array of integer): Variant;
220	+	function GetAsBCD(index: array of integer): tBCD;
221		procedure SetAsInteger(index: array of integer; AValue: integer);
222		procedure SetAsBoolean(index: array of integer; AValue: boolean);
223		procedure SetAsCurrency(index: array of integer; Value: Currency);
224		procedure SetAsInt64(index: array of integer; Value: Int64);
225		procedure SetAsDate(index: array of integer; Value: TDateTime);
226		procedure SetAsLong(index: array of integer; Value: Long);
227	<	procedure SetAsTime(index: array of integer; Value: TDateTime);
228	<	procedure SetAsDateTime(index: array of integer; Value: TDateTime);
227	>	procedure SetAsTime(index: array of integer; Value: TDateTime); overload;
228	>	procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
229	>	procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
230	>	procedure SetAsDateTime(index: array of integer; Value: TDateTime); overload;
231	>	procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
232	>	procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZone: AnsiString); overload;
233	>	procedure SetAsUTCDateTime(index: array of integer; aUTCTime: TDateTime);
234		procedure SetAsDouble(index: array of integer; Value: Double);
235		procedure SetAsFloat(index: array of integer; Value: Float);
236		procedure SetAsShort(index: array of integer; Value: Short);
237		procedure SetAsString(index: array of integer; Value: AnsiString);
238		procedure SetAsVariant(index: array of integer; Value: Variant);
239	+	procedure SetAsBcd(index: array of integer; aValue: tBCD);
240		procedure SetBounds(dim, UpperBound, LowerBound: integer);
241		function GetAttachment: IAttachment;
242		function GetTransaction: ITransaction;
#	Line 233 | Line 250 | uses FBMessages;
250
251		{ TFBArrayElement }
252
253	+	function TFBArrayElement.GetAttachment: IAttachment;
254	+	begin
255	+	Result := FArray.GetAttachment;
256	+	end;
257	+
258		function TFBArrayElement.GetSQLDialect: integer;
259		begin
260		Result := FArray.GetSQLDialect;
#	Line 365 | Line 387 | end;
387		procedure TFBArrayElement.SetAsString(Value: AnsiString);
388		var len: integer;
389		ElementSize: integer;
390	+	Int64Value: Int64;
391		begin
392		CheckActive;
393		case GetSQLType of
#	Line 408 | Line 431 | begin
431		if trim(Value) = '' then
432		SetAsInt64(0)
433		else
434	<	SetAsInt64(AdjustScaleFromCurrency(StrToCurr(Value),GetScale));
434	>	if TryStrToInt64(Value,Int64Value) then
435	>	SetAsInt64(Int64Value)
436	>	else
437	>	SetAsCurrency(StrToCurr(Value));
438
439		SQL_D_FLOAT,
440		SQL_DOUBLE,
#	Line 484 | Line 510 | begin
510		end
511		end;
512
513	+	procedure TFBArrayElement.SetAsBcd(aValue: tBCD);
514	+	var C: Currency;
515	+	begin
516	+	CheckActive;
517	+	with FirebirdClientAPI do
518	+	case SQLType of
519	+	SQL_DEC_FIXED,
520	+	SQL_DEC16,
521	+	SQL_DEC34:
522	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
523	+
524	+	SQL_INT128:
525	+	StrToInt128(Scale,BcdToStr(aValue),SQLData);
526	+
527	+	else
528	+	begin
529	+	BCDToCurr(aValue,C);
530	+	SetAsCurrency(C);
531	+	end;
532	+	end;
533	+	Changed;
534	+	end;
535	+
536		procedure TFBArrayElement.SetSQLType(aValue: cardinal);
537		begin
538	<	if aValue = GetSQLType then
538	>	if aValue <> GetSQLType then
539		IBError(ibxeInvalidDataConversion, [nil]);
540		end;
541
#	Line 553 | Line 602 | begin
602		Result :=  SQL_TYPE_TIME;
603		blr_int64:
604		Result := SQL_INT64;
605	+	blr_sql_time_tz:
606	+	Result := SQL_TIME_TZ;
607	+	blr_timestamp_tz:
608	+	Result := SQL_TIMESTAMP_TZ;
609	+	blr_ex_time_tz:
610	+	Result := SQL_TIME_TZ_EX;
611	+	blr_ex_timestamp_tz:
612	+	Result := SQL_TIMESTAMP_TZ_EX;
613	+	blr_dec64:
614	+	Result := SQL_DEC16;
615	+	blr_dec128:
616	+	Result := SQL_DEC34;
617	+	blr_int128:
618	+	Result := SQL_INT128;
619		end;
620		end;
621
#	Line 563 | Line 626 | end;
626
627		function TFBArrayMetaData.GetScale: integer;
628		begin
629	<	Result := byte(FArrayDesc.array_desc_scale);
629	>	Result := FArrayDesc.array_desc_scale;
630		end;
631
632		function TFBArrayMetaData.GetSize: cardinal;
#	Line 626 | Line 689 | begin
689		Result :=  blr_sql_time;
690		SQL_INT64:
691		Result := blr_int64;
692	+	SQL_TIME_TZ:
693	+	Result := blr_sql_time_tz;
694	+	SQL_TIMESTAMP_TZ:
695	+	Result := blr_timestamp_tz;
696	+	SQL_TIME_TZ_EX:
697	+	Result := blr_ex_time_tz;
698	+	SQL_TIMESTAMP_TZ_EX:
699	+	Result := blr_ex_timestamp_tz;
700	+	SQL_DEC16:
701	+	Result := blr_dec64;
702	+	SQL_DEC34:
703	+	Result := blr_dec128;
704	+	SQL_INT128:
705	+	Result := blr_int128;
706		end;
707		end;
708
#	Line 835 | Line 912 | end;
912		procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean
913		);
914		begin
915	<	if (aTransaction = FTransactionIntf) and FModified and not FIsNew then
915	>	if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then
916		PutArraySlice(Force);
917		end;
918
#	Line 924 | Line 1001 | begin
1001		Result := FElement.GetAsDateTime;
1002		end;
1003
1004	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1005	+	var aDateTime: TDateTime; var dstOffset: smallint;
1006	+	var aTimezoneID: TFBTimeZoneID);
1007	+	begin
1008	+	GetArraySlice;
1009	+	FElement.FBufPtr := GetOffset(index);
1010	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID);
1011	+	end;
1012	+
1013	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1014	+	var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString);
1015	+	begin
1016	+	GetArraySlice;
1017	+	FElement.FBufPtr := GetOffset(index);
1018	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone);
1019	+	end;
1020	+
1021	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1022	+	var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1023	+	begin
1024	+	GetArraySlice;
1025	+	FElement.FBufPtr := GetOffset(index);
1026	+	FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate);
1027	+	end;
1028	+
1029	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1030	+	var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime);
1031	+	begin
1032	+	GetArraySlice;
1033	+	FElement.FBufPtr := GetOffset(index);
1034	+	FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate);
1035	+	end;
1036	+
1037	+	function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime;
1038	+	begin
1039	+	GetArraySlice;
1040	+	FElement.FBufPtr := GetOffset(index);
1041	+	Result := FElement.GetAsUTCDateTime;
1042	+	end;
1043	+
1044		function TFBArray.GetAsDouble(index: array of integer): Double;
1045		begin
1046		GetArraySlice;
#	Line 966 | Line 1083 | begin
1083		Result := FElement.GetAsVariant;
1084		end;
1085
1086	+	function TFBArray.GetAsBCD(index: array of integer): tBCD;
1087	+	begin
1088	+	GetArraySlice;
1089	+	FElement.FBufPtr := GetOffset(index);
1090	+	Result := FElement.GetAsBCD;
1091	+	end;
1092	+
1093		procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer);
1094		begin
1095		FElement.FBufPtr := GetOffset(index);
#	Line 1008 | Line 1132 | begin
1132		FElement.SetAsTime(Value);
1133		end;
1134
1135	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1136	+	aTimeZoneID: TFBTimeZoneID);
1137	+	begin
1138	+	FElement.FBufPtr := GetOffset(index);
1139	+	FElement.SetAsTime(aValue,OnDate,aTimeZoneID);
1140	+	end;
1141	+
1142	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1143	+	aTimeZone: AnsiString);
1144	+	begin
1145	+	FElement.FBufPtr := GetOffset(index);
1146	+	FElement.SetAsTime(aValue,OnDate, aTimeZone);
1147	+	end;
1148	+
1149		procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime);
1150		begin
1151		FElement.FBufPtr := GetOffset(index);
1152		FElement.SetAsDateTime(Value);
1153		end;
1154
1155	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1156	+	aTimeZoneID: TFBTimeZoneID);
1157	+	begin
1158	+	FElement.FBufPtr := GetOffset(index);
1159	+	FElement.SetAsDateTime(aValue,aTimeZoneID);
1160	+	end;
1161	+
1162	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1163	+	aTimeZone: AnsiString);
1164	+	begin
1165	+	FElement.FBufPtr := GetOffset(index);
1166	+	FElement.SetAsDateTime(aValue,aTimeZone);
1167	+	end;
1168	+
1169	+	procedure TFBArray.SetAsUTCDateTime(index: array of integer;
1170	+	aUTCTime: TDateTime);
1171	+	begin
1172	+	FElement.FBufPtr := GetOffset(index);
1173	+	FElement.SetAsUTCDateTime(aUTCTime);
1174	+	end;
1175	+
1176		procedure TFBArray.SetAsDouble(index: array of integer; Value: Double);
1177		begin
1178		FElement.FBufPtr := GetOffset(index);
#	Line 1044 | Line 1203 | begin
1203		FElement.SetAsVariant(Value);
1204		end;
1205
1206	+	procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD);
1207	+	begin
1208	+	FElement.FBufPtr := GetOffset(index);
1209	+	FElement.SetAsBcd(aValue);
1210	+	end;
1211	+
1212		procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer);
1213		begin
1214		with (FMetaData as TFBArrayMetaData) do

Diff Legend

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