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 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 353 by tony, Sat Oct 23 14:11:37 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 90 | Line 91 | type
91		function GetName: AnsiString; override;
92		function GetScale: integer; override;
93		function GetSize: integer;
94	+	function GetCharSetWidth: integer; override;
95		function GetAsString: AnsiString; override;
96		procedure SetAsLong(Value: Long); override;
97		procedure SetAsShort(Value: Short); override;
#	Line 98 | 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: Int64; aScale: integer); override;
105		end;
106
107		{ TFBArrayMetaData }
#	Line 127 | Line 131 | type
131		function GetScale: integer;
132		function GetSize: cardinal;
133		function GetCharSetID: cardinal; virtual; abstract;
134	+	function GetCharSetWidth: integer; virtual; abstract;
135		function GetTableName: AnsiString;
136		function GetColumnName: AnsiString;
137		function GetDimensions: integer;
#	Line 136 | 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 161 | Line 166 | type
166		FBufSize: ISC_LONG;
167		FArrayID: TISC_QUAD;
168		procedure AllocateBuffer; virtual;
169	<	procedure Changing;
170	<	procedure Changed;
169	>	procedure Changing; virtual;
170	>	procedure Changed;  virtual;
171		function GetArrayDesc: PISC_ARRAY_DESC;
172		procedure InternalGetSlice; virtual; abstract;
173		procedure InternalPutSlice(Force: boolean); virtual; abstract;
#	Line 173 | 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 182 | Line 190 | type
190		function GetScale: integer;
191		function GetSize: cardinal;
192		function GetCharSetID: cardinal;
193	+	function GetCharSetWidth: integer;
194		function GetTableName: AnsiString;
195		function GetColumnName: AnsiString;
196		function GetDimensions: integer;
#	Line 197 | 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 226 | Line 247 | type
247
248		implementation
249
250	<	uses FBMessages;
250	>	uses FBMessages, IBUtils;
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 300 | Line 326 | begin
326		Result := GetDataLength;
327		end;
328
329	+	function TFBArrayElement.GetCharSetWidth: integer;
330	+	begin
331	+	Result := FArray.FMetaData.GetCharSetWidth;
332	+	end;
333	+
334		function TFBArrayElement.GetAsString: AnsiString;
335		var rs: RawByteString;
336		begin
#	Line 336 | Line 367 | begin
367		CheckActive;
368		case GetSQLType of
369		SQL_LONG:
370	<	PLong(SQLData)^ := Value;
370	>	PLong(SQLData)^ := AdjustScaleToInt64(Value,getScale);
371		SQL_SHORT:
372	<	PShort(SQLData)^ := Value;
372	>	PShort(SQLData)^ := AdjustScaleToInt64(Value,getScale);
373		SQL_INT64:
374	<	PInt64(SQLData)^ := Value;
374	>	PInt64(SQLData)^ := AdjustScaleToInt64(Value,getScale);
375		SQL_TEXT, SQL_VARYING:
376		SetAsString(IntToStr(Value));
377		SQL_D_FLOAT,
#	Line 357 | 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 397 | 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(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 476 | Line 515 | begin
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: Int64; aScale: integer);
542	+	begin
543	+	CheckActive;
544	+	case GetSQLType of
545	+	SQL_LONG:
546	+	PLong(SQLData)^ := AdjustScaleToInt64(Value,aScale - getScale);
547	+	SQL_SHORT:
548	+	PShort(SQLData)^ := AdjustScaleToInt64(Value,aScale - getScale);
549	+	SQL_INT64:
550	+	PInt64(SQLData)^ := AdjustScaleToInt64(Value,aScale - getScale);
551	+	SQL_TEXT, SQL_VARYING:
552	+	SetAsString(AdjustScaleToStr(Value,aScale));
553	+	SQL_D_FLOAT,
554	+	SQL_DOUBLE:
555	+	PDouble(SQLData)^ := AdjustScale(Value,aScale);
556	+	SQL_FLOAT:
557	+	PSingle(SQLData)^ := AdjustScale(Value,aScale);
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 545 | 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 555 | 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 618 | 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 765 | Line 878 | begin
878		FMetaData := aField;
879		FArrayID := ArrayID;
880		FAttachment := aAttachment;
881	+	FFirebirdClientAPI := aTransaction.FirebirdAPI;
882		FTransactionIntf :=  aTransaction;
883		FTransactionSeqNo := aTransaction.TransactionSeqNo;
884		FIsNew := false;
#	Line 826 | Line 940 | end;
940		procedure TFBArray.TransactionEnding(aTransaction: ITransaction; Force: boolean
941		);
942		begin
943	<	if (aTransaction = FTransactionIntf) and FModified and not FIsNew then
943	>	if ((aTransaction as TObject) = (FTransactionIntf as TObject)) and FModified and not FIsNew then
944		PutArraySlice(Force);
945		end;
946
#	Line 855 | Line 969 | begin
969		Result := FMetaData.GetCharSetID;
970		end;
971
972	+	function TFBArray.GetCharSetWidth: integer;
973	+	begin
974	+	Result := FMetaData.GetCharSetWidth;
975	+	end;
976	+
977		function TFBArray.GetTableName: AnsiString;
978		begin
979		Result := FMetaData.GetTableName;
#	Line 910 | Line 1029 | begin
1029		Result := FElement.GetAsDateTime;
1030		end;
1031
1032	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1033	+	var aDateTime: TDateTime; var dstOffset: smallint;
1034	+	var aTimezoneID: TFBTimeZoneID);
1035	+	begin
1036	+	GetArraySlice;
1037	+	FElement.FBufPtr := GetOffset(index);
1038	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezoneID);
1039	+	end;
1040	+
1041	+	procedure TFBArray.GetAsDateTime(index: array of integer;
1042	+	var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString);
1043	+	begin
1044	+	GetArraySlice;
1045	+	FElement.FBufPtr := GetOffset(index);
1046	+	FElement.GetAsDateTime(aDateTime,dstOffset,aTimezone);
1047	+	end;
1048	+
1049	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1050	+	var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime);
1051	+	begin
1052	+	GetArraySlice;
1053	+	FElement.FBufPtr := GetOffset(index);
1054	+	FElement.GetAsTime(aTime,dstOffset,aTimezoneID,OnDate);
1055	+	end;
1056	+
1057	+	procedure TFBArray.GetAsTime(index: array of integer; var aTime: TDateTime;
1058	+	var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime);
1059	+	begin
1060	+	GetArraySlice;
1061	+	FElement.FBufPtr := GetOffset(index);
1062	+	FElement.GetAsTime(aTime,dstOffset,aTimezone,OnDate);
1063	+	end;
1064	+
1065	+	function TFBArray.GetAsUTCDateTime(index: array of integer): TDateTime;
1066	+	begin
1067	+	GetArraySlice;
1068	+	FElement.FBufPtr := GetOffset(index);
1069	+	Result := FElement.GetAsUTCDateTime;
1070	+	end;
1071	+
1072		function TFBArray.GetAsDouble(index: array of integer): Double;
1073		begin
1074		GetArraySlice;
#	Line 952 | Line 1111 | begin
1111		Result := FElement.GetAsVariant;
1112		end;
1113
1114	+	function TFBArray.GetAsBCD(index: array of integer): tBCD;
1115	+	begin
1116	+	GetArraySlice;
1117	+	FElement.FBufPtr := GetOffset(index);
1118	+	Result := FElement.GetAsBCD;
1119	+	end;
1120	+
1121		procedure TFBArray.SetAsInteger(index: array of integer; AValue: integer);
1122		begin
1123		FElement.FBufPtr := GetOffset(index);
#	Line 994 | Line 1160 | begin
1160		FElement.SetAsTime(Value);
1161		end;
1162
1163	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1164	+	aTimeZoneID: TFBTimeZoneID);
1165	+	begin
1166	+	FElement.FBufPtr := GetOffset(index);
1167	+	FElement.SetAsTime(aValue,OnDate,aTimeZoneID);
1168	+	end;
1169	+
1170	+	procedure TFBArray.SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime;
1171	+	aTimeZone: AnsiString);
1172	+	begin
1173	+	FElement.FBufPtr := GetOffset(index);
1174	+	FElement.SetAsTime(aValue,OnDate, aTimeZone);
1175	+	end;
1176	+
1177		procedure TFBArray.SetAsDateTime(index: array of integer; Value: TDateTime);
1178		begin
1179		FElement.FBufPtr := GetOffset(index);
1180		FElement.SetAsDateTime(Value);
1181		end;
1182
1183	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1184	+	aTimeZoneID: TFBTimeZoneID);
1185	+	begin
1186	+	FElement.FBufPtr := GetOffset(index);
1187	+	FElement.SetAsDateTime(aValue,aTimeZoneID);
1188	+	end;
1189	+
1190	+	procedure TFBArray.SetAsDateTime(index: array of integer; aValue: TDateTime;
1191	+	aTimeZone: AnsiString);
1192	+	begin
1193	+	FElement.FBufPtr := GetOffset(index);
1194	+	FElement.SetAsDateTime(aValue,aTimeZone);
1195	+	end;
1196	+
1197	+	procedure TFBArray.SetAsUTCDateTime(index: array of integer;
1198	+	aUTCTime: TDateTime);
1199	+	begin
1200	+	FElement.FBufPtr := GetOffset(index);
1201	+	FElement.SetAsUTCDateTime(aUTCTime);
1202	+	end;
1203	+
1204		procedure TFBArray.SetAsDouble(index: array of integer; Value: Double);
1205		begin
1206		FElement.FBufPtr := GetOffset(index);
#	Line 1030 | Line 1231 | begin
1231		FElement.SetAsVariant(Value);
1232		end;
1233
1234	+	procedure TFBArray.SetAsBcd(index: array of integer; aValue: tBCD);
1235	+	begin
1236	+	FElement.FBufPtr := GetOffset(index);
1237	+	FElement.SetAsBcd(aValue);
1238	+	end;
1239	+
1240		procedure TFBArray.SetBounds(dim, UpperBound, LowerBound: integer);
1241		begin
1242		with (FMetaData as TFBArrayMetaData) do

Diff Legend

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