ViewVC Help

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

root/public/ibx/trunk/fbintf/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 315 by tony, Thu Feb 25 11:56:36 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 484 | Line 506 | begin
506		end
507		end;
508
509	+	procedure TFBArrayElement.SetAsBcd(aValue: tBCD);
510	+	var C: Currency;
511	+	begin
512	+	CheckActive;
513	+	with FirebirdClientAPI do
514	+	case SQLType of
515	+	SQL_DEC_FIXED,
516	+	SQL_DEC16,
517	+	SQL_DEC34:
518	+	SQLDecFloatEncode(aValue,SQLType,SQLData);
519	+
520	+	SQL_INT128:
521	+	StrToInt128(Scale,BcdToStr(aValue),SQLData);
522	+
523	+	else
524	+	begin
525	+	BCDToCurr(aValue,C);
526	+	SetAsCurrency(C);
527	+	end;
528	+	end;
529	+	Changed;
530	+	end;
531	+
532		procedure TFBArrayElement.SetSQLType(aValue: cardinal);
533		begin
534	<	if aValue = GetSQLType then
534	>	if aValue <> GetSQLType then
535		IBError(ibxeInvalidDataConversion, [nil]);
536		end;
537
#	Line 553 | Line 598 | begin
598		Result :=  SQL_TYPE_TIME;
599		blr_int64:
600		Result := SQL_INT64;
601	+	blr_sql_time_tz:
602	+	Result := SQL_TIME_TZ;
603	+	blr_timestamp_tz:
604	+	Result := SQL_TIMESTAMP_TZ;
605	+	blr_ex_time_tz:
606	+	Result := SQL_TIME_TZ_EX;
607	+	blr_ex_timestamp_tz:
608	+	Result := SQL_TIMESTAMP_TZ_EX;
609	+	blr_dec64:
610	+	Result := SQL_DEC16;
611	+	blr_dec128:
612	+	Result := SQL_DEC34;
613	+	blr_int128:
614	+	Result := SQL_INT128;
615		end;
616		end;
617
#	Line 563 | Line 622 | end;
622
623		function TFBArrayMetaData.GetScale: integer;
624		begin
625	<	Result := byte(FArrayDesc.array_desc_scale);
625	>	Result := FArrayDesc.array_desc_scale;
626		end;
627
628		function TFBArrayMetaData.GetSize: cardinal;
#	Line 626 | Line 685 | begin
685		Result :=  blr_sql_time;
686		SQL_INT64:
687		Result := blr_int64;
688	+	SQL_TIME_TZ:
689	+	Result := blr_sql_time_tz;
690	+	SQL_TIMESTAMP_TZ:
691	+	Result := blr_timestamp_tz;
692	+	SQL_TIME_TZ_EX:
693	+	Result := blr_ex_time_tz;
694	+	SQL_TIMESTAMP_TZ_EX:
695	+	Result := blr_ex_timestamp_tz;
696	+	SQL_DEC16:
697	+	Result := blr_dec64;
698	+	SQL_DEC34:
699	+	Result := blr_dec128;
700	+	SQL_INT128:
701	+	Result := blr_int128;
702		end;
703		end;
704
#	Line 835 | Line 908 | end;
908		procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean
909		);
910		begin
911	<	if (aTransaction = FTransactionIntf) and FModified and not FIsNew then
911	>	if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then
912		PutArraySlice(Force);
913		end;
914
#	Line 924 | Line 997 | begin
997		Result := FElement.GetAsDateTime;
998		end;
999
1000	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1001	+	var aDateTime: TDateTime; var dstOffset: smallint;
1002	+	var aTimezoneID: TFBTimeZoneID);
1003	+	begin
1004	+	GetArraySlice;
1005	+	FElement.FBufPtr := GetOffset(index);
1006	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID);
1007	+	end;
1008	+
1009	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1010	+	var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString);
1011	+	begin
1012	+	GetArraySlice;
1013	+	FElement.FBufPtr := GetOffset(index);
1014	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone);
1015	+	end;
1016	+
1017	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1018	+	var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1019	+	begin
1020	+	GetArraySlice;
1021	+	FElement.FBufPtr := GetOffset(index);
1022	+	FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate);
1023	+	end;
1024	+
1025	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1026	+	var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime);
1027	+	begin
1028	+	GetArraySlice;
1029	+	FElement.FBufPtr := GetOffset(index);
1030	+	FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate);
1031	+	end;
1032	+
1033	+	function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime;
1034	+	begin
1035	+	GetArraySlice;
1036	+	FElement.FBufPtr := GetOffset(index);
1037	+	Result := FElement.GetAsUTCDateTime;
1038	+	end;
1039	+
1040		function TFBArray.GetAsDouble(index: array of integer): Double;
1041		begin
1042		GetArraySlice;
#	Line 966 | Line 1079 | begin
1079		Result := FElement.GetAsVariant;
1080		end;
1081
1082	+	function TFBArray.GetAsBCD(index: array of integer): tBCD;
1083	+	begin
1084	+	GetArraySlice;
1085	+	FElement.FBufPtr := GetOffset(index);
1086	+	Result := FElement.GetAsBCD;
1087	+	end;
1088	+
1089		procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer);
1090		begin
1091		FElement.FBufPtr := GetOffset(index);
#	Line 1008 | Line 1128 | begin
1128		FElement.SetAsTime(Value);
1129		end;
1130
1131	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1132	+	aTimeZoneID: TFBTimeZoneID);
1133	+	begin
1134	+	FElement.FBufPtr := GetOffset(index);
1135	+	FElement.SetAsTime(aValue,OnDate,aTimeZoneID);
1136	+	end;
1137	+
1138	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1139	+	aTimeZone: AnsiString);
1140	+	begin
1141	+	FElement.FBufPtr := GetOffset(index);
1142	+	FElement.SetAsTime(aValue,OnDate, aTimeZone);
1143	+	end;
1144	+
1145		procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime);
1146		begin
1147		FElement.FBufPtr := GetOffset(index);
1148		FElement.SetAsDateTime(Value);
1149		end;
1150
1151	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1152	+	aTimeZoneID: TFBTimeZoneID);
1153	+	begin
1154	+	FElement.FBufPtr := GetOffset(index);
1155	+	FElement.SetAsDateTime(aValue,aTimeZoneID);
1156	+	end;
1157	+
1158	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1159	+	aTimeZone: AnsiString);
1160	+	begin
1161	+	FElement.FBufPtr := GetOffset(index);
1162	+	FElement.SetAsDateTime(aValue,aTimeZone);
1163	+	end;
1164	+
1165	+	procedure TFBArray.SetAsUTCDateTime(index: array of integer;
1166	+	aUTCTime: TDateTime);
1167	+	begin
1168	+	FElement.FBufPtr := GetOffset(index);
1169	+	FElement.SetAsUTCDateTime(aUTCTime);
1170	+	end;
1171	+
1172		procedure TFBArray.SetAsDouble(index: array of integer; Value: Double);
1173		begin
1174		FElement.FBufPtr := GetOffset(index);
#	Line 1044 | Line 1199 | begin
1199		FElement.SetAsVariant(Value);
1200		end;
1201
1202	+	procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD);
1203	+	begin
1204	+	FElement.FBufPtr := GetOffset(index);
1205	+	FElement.SetAsBcd(aValue);
1206	+	end;
1207	+
1208		procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer);
1209		begin
1210		with (FMetaData as TFBArrayMetaData) do

Diff Legend

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