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 59 by tony, Mon Mar 13 09:51:56 2017 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 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		end;
105
106		{ TFBArrayMetaData }
#	Line 108 | Line 111 | type
111		protected
112		FArrayDesc: TISC_ARRAY_DESC;
113		FCharSetID: integer;
114	+	FAttachment: IAttachment;
115		procedure LoadMetaData(aAttachment: IAttachment; aTransaction: ITransaction;
116		relationName, columnName: AnsiString); virtual; abstract;
117		function NumOfElements: integer;
118		public
119		constructor Create(aAttachment: IAttachment; aTransaction: ITransaction;
120		relationName, columnName: AnsiString); overload;
121	<	constructor Create(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
121	>	constructor Create(aAttachment: IAttachment;SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
122		Scale: integer; size: cardinal; charSetID: cardinal;
123		dimensions: cardinal; bounds: TArrayBounds); overload;
124		function GetCodePage: TSystemCodePage; virtual; abstract;
#	Line 126 | Line 130 | type
130		function GetScale: integer;
131		function GetSize: cardinal;
132		function GetCharSetID: cardinal; virtual; abstract;
133	+	function GetCharSetWidth: integer; virtual; abstract;
134		function GetTableName: AnsiString;
135		function GetColumnName: AnsiString;
136		function GetDimensions: integer;
#	Line 135 | 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;
147		FIsNew: boolean;
148		FLoaded: boolean;
#	Line 159 | Line 165 | type
165		FBufSize: ISC_LONG;
166		FArrayID: TISC_QUAD;
167		procedure AllocateBuffer; virtual;
168	<	procedure Changing;
169	<	procedure Changed;
168	>	procedure Changing; virtual;
169	>	procedure Changed;  virtual;
170		function GetArrayDesc: PISC_ARRAY_DESC;
171		procedure InternalGetSlice; virtual; abstract;
172		procedure InternalPutSlice(Force: boolean); virtual; abstract;
#	Line 171 | 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 180 | Line 189 | type
189		function GetScale: integer;
190		function GetSize: cardinal;
191		function GetCharSetID: cardinal;
192	+	function GetCharSetWidth: integer;
193		function GetTableName: AnsiString;
194		function GetColumnName: AnsiString;
195		function GetDimensions: integer;
#	Line 195 | 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 228 | 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 273 | Line 300 | end;
300
301		constructor TFBArrayElement.Create(anArray: TFBArray; P: PByte);
302		begin
303	<	inherited Create;
303	>	inherited Create(anArray.FFirebirdClientAPI);
304		FArray := anArray;
305		FBufPtr := P;
306		end;
#	Line 298 | Line 325 | begin
325		Result := GetDataLength;
326		end;
327
328	+	function TFBArrayElement.GetCharSetWidth: integer;
329	+	begin
330	+	Result := FArray.FMetaData.GetCharSetWidth;
331	+	end;
332	+
333		function TFBArrayElement.GetAsString: AnsiString;
334		var rs: RawByteString;
335		begin
#	Line 355 | 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 398 | 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 474 | 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 486 | Line 545 | constructor TFBArrayMetaData.Create(aAtt
545		aTransaction: ITransaction; relationName, columnName: AnsiString);
546		begin
547		inherited Create;
548	+	FAttachment := aAttachment;
549		LoadMetaData(aAttachment,aTransaction,relationName, columnName);
550		end;
551
552	<	constructor TFBArrayMetaData.Create(SQLType: cardinal; tableName: AnsiString;
553	<	columnName: AnsiString; Scale: integer; size: cardinal; charSetID: cardinal;
554	<	dimensions: cardinal; bounds: TArrayBounds);
552	>	constructor TFBArrayMetaData.Create(aAttachment: IAttachment;
553	>	SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
554	>	Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
555	>	bounds: TArrayBounds);
556		var i: integer;
557		begin
558		inherited Create;
559	+	FAttachment := aAttachment;
560		with FArrayDesc do
561		begin
562		array_desc_dtype := GetDType(SQLType);
#	Line 540 | 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 550 | 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 613 | 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 652 | Line 742 | begin
742		end;
743		FBufSize := FElementSize * l;
744
745	<	with FirebirdClientAPI do
745	>	with FFirebirdClientAPI do
746		IBAlloc(FBuffer,0,FBufSize);
747
748		Dims := GetDimensions;
#	Line 741 | Line 831 | begin
831		inherited Create(aTransaction);
832		FMetaData := aField;
833		FAttachment := aAttachment;
834	+	FFirebirdClientAPI := aTransaction.FirebirdAPI;
835		FTransactionIntf :=  aTransaction;
836		FTransactionSeqNo := aTransaction.TransactionSeqNo;
837		FIsNew := true;
#	Line 759 | Line 850 | begin
850		FMetaData := aField;
851		FArrayID := ArrayID;
852		FAttachment := aAttachment;
853	+	FFirebirdClientAPI := aTransaction.FirebirdAPI;
854		FTransactionIntf :=  aTransaction;
855		FTransactionSeqNo := aTransaction.TransactionSeqNo;
856		FIsNew := false;
#	Line 820 | 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 849 | Line 941 | begin
941		Result := FMetaData.GetCharSetID;
942		end;
943
944	+	function TFBArray.GetCharSetWidth: integer;
945	+	begin
946	+	Result := FMetaData.GetCharSetWidth;
947	+	end;
948	+
949		function TFBArray.GetTableName: AnsiString;
950		begin
951		Result := FMetaData.GetTableName;
#	Line 904 | 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 946 | 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 988 | 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 1024 | 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