ViewVC Help

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

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

Comparing:
ibx/trunk/fbintf/client/FBSQLData.pas (file contents), Revision 350 by tony, Wed Oct 20 14:58:56 2021 UTC vs.
ibx/branches/udr/client/FBSQLData.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

#	Line 122 | Line 122 | type
122		private
123		FFirebirdClientAPI: TFBClientAPI;
124		FTimeZoneServices: IExTimeZoneServices;
125	–	function AdjustScale(Value: Int64; aScale: Integer): Double;
126	–	function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
127	–	function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
125		function GetDateFormatStr(IncludeTime: boolean): AnsiString;
126		function GetTimeFormatStr: AnsiString;
127		function GetTimestampFormatStr: AnsiString;
#	Line 132 | Line 129 | type
129		procedure InternalGetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint;
130		var aTimezone: AnsiString; var aTimeZoneID: TFBTimeZoneID);
131		protected
132	+	function AdjustScale(Value: Int64; aScale: Integer): Double;
133	+	function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
134	+	function AdjustScaleToStr(Value: Int64; aScale: Integer): AnsiString;
135	+	function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
136		function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
137		function AdjustScaleFromDouble(Value: Double; aScale: Integer): Int64;
138		procedure CheckActive; virtual;
#	Line 205 | Line 206 | type
206		procedure SetAsShort(Value: short); virtual;
207		procedure SetAsString(Value: AnsiString); virtual;
208		procedure SetAsVariant(Value: Variant);
209	<	procedure SetAsNumeric(Value: Int64; aScale: integer);
209	>	procedure SetAsNumeric(Value: Int64; aScale: integer); virtual;
210		procedure SetAsBcd(aValue: tBCD); virtual;
211		procedure SetIsNull(Value: Boolean); virtual;
212		procedure SetIsNullable(Value: Boolean); virtual;
#	Line 288 | Line 289 | type
289		function GetStatement: IStatement;
290		procedure SetName(AValue: AnsiString);
291		protected
292	+	FArrayIntf: IArray;
293		function GetAttachment: IAttachment; virtual; abstract;
294		function GetSQLType: cardinal; virtual; abstract;
295		function GetSubtype: integer; virtual; abstract;
#	Line 318 | Line 320 | type
320		procedure SetString(aValue: AnsiString);
321		procedure Changed; virtual;
322		procedure RowChange; virtual;
323	<	function GetAsArray(Array_ID: TISC_QUAD): IArray; virtual; abstract;
323	>	function GetAsArray: IArray; virtual; abstract;
324		function GetAsBlob(Blob_ID: TISC_QUAD; BPB: IBPB): IBlob; virtual; abstract;
325		function CreateBlob: IBlob; virtual; abstract;
326		function GetArrayMetaData: IArrayMetaData; virtual; abstract;
#	Line 326 | Line 328 | type
328		function getColMetadata: IParamMetaData;
329		procedure Initialize; virtual;
330		procedure SaveMetaData;
331	+	procedure SetArray(AValue: IArray);
332
333		public
334		property AliasName: AnsiString read GetAliasName;
#	Line 767 | Line 770 | begin
770		FColMetaData := TSQLParamMetaData.Create(self);
771		end;
772
773	+	procedure TSQLVarData.SetArray(AValue: IArray);
774	+	begin
775	+	FArrayIntf := AValue;
776	+	end;
777	+
778		constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
779		begin
780		inherited Create;
#	Line 797 | Line 805 | end;
805
806		procedure TSQLVarData.RowChange;
807		begin
808	+	FArrayIntf := nil;
809		FModified := false;
810		FVarString := '';
811		end;
#	Line 906 | Line 915 | begin
915		result := Val;
916		end;
917
918	+	function TSQLDataItem.AdjustScaleToStr(Value: Int64; aScale: Integer
919	+	): AnsiString;
920	+	var Scaling : AnsiString;
921	+	i: Integer;
922	+	begin
923	+	Result := IntToStr(Value);
924	+	Scaling := '';
925	+	if aScale > 0 then
926	+	begin
927	+	for i := 1 to aScale do
928	+	Result := Result + '0';
929	+	end
930	+	else
931	+	if aScale < 0 then
932	+	{$IF declared(DefaultFormatSettings)}
933	+	with DefaultFormatSettings do
934	+	{$ELSE}
935	+	{$IF declared(FormatSettings)}
936	+	with FormatSettings do
937	+	{$IFEND}
938	+	{$IFEND}
939	+	begin
940	+	if Length(Result) > -aScale then
941	+	system.Insert(DecimalSeparator,Result,Length(Result) + aScale)
942	+	else
943	+	begin
944	+	Scaling := '0' + DecimalSeparator;
945	+	for i := -1 downto aScale + Length(Result) do
946	+	Scaling := Scaling + '0';
947	+	Result := Scaling + Result;
948	+	end;
949	+	end;
950	+	end;
951	+
952		function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
953		): Currency;
954		var
#	Line 1570 | Line 1613 | end;
1613		function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1614		var i: integer;
1615		cplen: integer;
1573	–	s: AnsiString;
1616		begin
1617		Result := 0;
1576	–	s := strpas(p);
1618		for i := 1 to FieldWidth do
1619		begin
1620		cplen := UTF8CodepointSizeFull(p);
#	Line 2130 | Line 2171 | begin
2171		end;
2172
2173		procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2133	–	var C: Currency;
2174		begin
2175		CheckActive;
2176		Changing;
#	Line 2380 | Line 2420 | end;
2420		function TIBSQLData.GetAsArray: IArray;
2421		begin
2422		CheckActive;
2423	<	result := FIBXSQLVAR.GetAsArray(AsQuad);
2423	>	result := FIBXSQLVAR.GetAsArray;
2424		end;
2425
2426		function TIBSQLData.GetAsBlob: IBlob;
#	Line 2422 | Line 2462 | begin
2462		Changed;
2463		end;
2464
2425	–	function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
2426	–	var i: integer;
2427	–	ds: integer;
2428	–	begin
2429	–	Result := false;
2430	–	ds := 0;
2431	–	S := Trim(S);
2432	–	{$IF declared(DefaultFormatSettings)}
2433	–	with DefaultFormatSettings do
2434	–	{$ELSE}
2435	–	{$IF declared(FormatSettings)}
2436	–	with FormatSettings do
2437	–	{$IFEND}
2438	–	{$IFEND}
2439	–	begin
2440	–	{ThousandSeparator not allowed as by Delphi specs}
2441	–	if (ThousandSeparator <> DecimalSeparator) and
2442	–	(Pos(ThousandSeparator, S) <> 0) then
2443	–	Exit;
2444	–
2445	–	for i := length(S) downto 1 do
2446	–	begin
2447	–	if S[i] = AnsiChar(DecimalSeparator) then
2448	–	begin
2449	–	if ds <> 0 then Exit; {only one allowed}
2450	–	ds := i-1;
2451	–	system.Delete(S,i,1);
2452	–	end
2453	–	else
2454	–	if (i > 1) and (S[i] in ['+','-']) then
2455	–	Exit
2456	–	else
2457	–	if not (S[i] in ['0'..'9']) then
2458	–	Exit; {bad character}
2459	–
2460	–	end;
2461	–	if ds = 0 then
2462	–	scale := 0
2463	–	else
2464	–	scale := ds - Length(S);
2465	–	Result := TryStrToInt64(S,Value);
2466	–	end;
2467	–	end;
2468	–
2465		var b: IBlob;
2466		dt: TDateTime;
2467		timezone: AnsiString;
2472	–	{$ifdef FPC_HAS_TYPE_EXTENDED}
2473	–	FloatValue: Extended;
2474	–	{$else}
2475	–	FloatValue: Double;
2476	–	{$endif}
2468		Int64Value: Int64;
2469		BCDValue: TBCD;
2470		aScale: integer;
#	Line 2512 | Line 2503 | begin
2503		SQL_LONG,
2504		SQL_INT64:
2505		if TryStrToNumeric(Value,Int64Value,aScale) then
2506	<	begin
2516	<	if aScale = 0 then
2517	<	SetAsInt64(Int64Value)
2518	<	else
2519	<	SetAsNumeric(Int64Value,aScale);
2520	<	end
2521	<	else
2522	<	if TryStrToFloat(Value,FloatValue) then
2523	<	SetAsDouble(FloatValue)
2506	>	SetAsNumeric(Int64Value,aScale)
2507		else
2508		DoSetString;
2509
#	Line 2536 | Line 2519 | begin
2519		SQL_D_FLOAT,
2520		SQL_DOUBLE,
2521		SQL_FLOAT:
2522	<	if TryStrToFloat(Value,FloatValue) then
2523	<	SetAsDouble(FloatValue)
2522	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2523	>	SetAsDouble(NumericToDouble(Int64Value,aScale))
2524		else
2525		DoSetString;
2526
#	Line 2691 | Line 2674 | begin
2674		if not FIBXSQLVAR.UniqueName then
2675		IBError(ibxeDuplicateParamName,[FIBXSQLVAR.Name]);
2676
2677	+	FIBXSQLVAR.SetArray(anArray); {save array interface}
2678		SetAsQuad(AnArray.GetArrayID);
2679		end;
2680

Diff Legend

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