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 345 by tony, Mon Aug 23 14:22:29 2021 UTC vs.
Revision 353 by tony, Sat Oct 23 14:11:37 2021 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 154 | Line 155 | type
155		property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
156		public
157		constructor Create(api: TFBClientAPI);
158	<	function GetSQLType: cardinal; virtual; abstract;
158	>	function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
159		function GetSQLTypeName: AnsiString; overload;
160	<	class function GetSQLTypeName(SQLType: short): AnsiString; overload;
160	>	class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
161		function GetStrDataLength: short;
162		function GetName: AnsiString; virtual; abstract;
163	<	function GetScale: integer; virtual; abstract;
163	>	function GetScale: integer; virtual; abstract; {Current Field Data scale}
164		function GetAsBoolean: boolean;
165		function GetAsCurrency: Currency;
166		function GetAsInt64: Int64;
#	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 284 | Line 285 | type
285		FModified: boolean;
286		FUniqueName: boolean;
287		FVarString: RawByteString;
288	+	FColMetaData: IParamMetaData;
289		function GetStatement: IStatement;
290		procedure SetName(AValue: AnsiString);
291		protected
#	Line 322 | Line 324 | type
324		function CreateBlob: IBlob; virtual; abstract;
325		function GetArrayMetaData: IArrayMetaData; virtual; abstract;
326		function GetBlobMetaData: IBlobMetaData; virtual; abstract;
327	+	function getColMetadata: IParamMetaData;
328		procedure Initialize; virtual;
329	+	procedure SaveMetaData;
330
331		public
332		property AliasName: AnsiString read GetAliasName;
#	Line 411 | Line 415 | type
415		property AsBlob: IBlob read GetAsBlob;
416		end;
417
418	+	{ TSQLParamMetaData }
419	+
420	+	TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
421	+	private
422	+	FSQLType: cardinal;
423	+	FSQLSubType: integer;
424	+	FScale: integer;
425	+	FCharSetID: cardinal;
426	+	FNullable: boolean;
427	+	FSize: cardinal;
428	+	FCodePage: TSystemCodePage;
429	+	public
430	+	constructor Create(src: TSQLVarData);
431	+	{IParamMetaData}
432	+	function GetSQLType: cardinal;
433	+	function GetSQLTypeName: AnsiString;
434	+	function getSubtype: integer;
435	+	function getScale: integer;
436	+	function getCharSetID: cardinal;
437	+	function getCodePage: TSystemCodePage;
438	+	function getIsNullable: boolean;
439	+	function GetSize: cardinal;
440	+	property SQLType: cardinal read GetSQLType;
441	+	end;
442	+
443		{ TSQLParam }
444
445		TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
#	Line 423 | Line 452 | type
452		procedure SetSQLType(aValue: cardinal); override;
453		public
454		procedure Clear;
455	+	function getColMetadata: IParamMetaData;
456		function GetModified: boolean; override;
457		function GetAsPointer: Pointer;
458		function GetAsString: AnsiString; override;
#	Line 528 | Line 558 | implementation
558
559		uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
560
561	+	{ TSQLParamMetaData }
562	+
563	+	constructor TSQLParamMetaData.Create(src: TSQLVarData);
564	+	begin
565	+	inherited Create;
566	+	FSQLType := src.GetSQLType;
567	+	FSQLSubType := src.getSubtype;
568	+	FScale := src.GetScale;
569	+	FCharSetID := src.getCharSetID;
570	+	FNullable := src.GetIsNullable;
571	+	FSize := src.GetSize;
572	+	FCodePage := src.GetCodePage;
573	+	end;
574	+
575	+	function TSQLParamMetaData.GetSQLType: cardinal;
576	+	begin
577	+	Result := FSQLType;
578	+	end;
579	+
580	+	function TSQLParamMetaData.GetSQLTypeName: AnsiString;
581	+	begin
582	+	Result := TSQLDataItem.GetSQLTypeName(FSQLType);
583	+	end;
584	+
585	+	function TSQLParamMetaData.getSubtype: integer;
586	+	begin
587	+	Result := FSQLSubType;
588	+	end;
589	+
590	+	function TSQLParamMetaData.getScale: integer;
591	+	begin
592	+	Result := FScale;
593	+	end;
594	+
595	+	function TSQLParamMetaData.getCharSetID: cardinal;
596	+	begin
597	+	Result := FCharSetID;
598	+	end;
599	+
600	+	function TSQLParamMetaData.getCodePage: TSystemCodePage;
601	+	begin
602	+	Result :=  FCodePage;
603	+	end;
604	+
605	+	function TSQLParamMetaData.getIsNullable: boolean;
606	+	begin
607	+	Result :=  FNullable;
608	+	end;
609	+
610	+	function TSQLParamMetaData.GetSize: cardinal;
611	+	begin
612	+	Result := FSize;
613	+	end;
614	+
615		{ TSQLDataArea }
616
617		function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
#	Line 679 | Line 763 | begin
763		//Ignore
764		end;
765
766	+	procedure TSQLVarData.SaveMetaData;
767	+	begin
768	+	FColMetaData := TSQLParamMetaData.Create(self);
769	+	end;
770	+
771		constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
772		begin
773		inherited Create;
#	Line 713 | Line 802 | begin
802		FVarString := '';
803		end;
804
805	+	function TSQLVarData.getColMetadata: IParamMetaData;
806	+	begin
807	+	Result := FColMetaData;
808	+	end;
809	+
810		procedure TSQLVarData.Initialize;
811
812		function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
#	Line 813 | Line 907 | begin
907		result := Val;
908		end;
909
910	+	function TSQLDataItem.AdjustScaleToStr(Value: Int64; aScale: Integer
911	+	): AnsiString;
912	+	var Scaling : AnsiString;
913	+	i: Integer;
914	+	begin
915	+	Result := IntToStr(Value);
916	+	Scaling := '';
917	+	if aScale > 0 then
918	+	begin
919	+	for i := 1 to aScale do
920	+	Result := Result + '0';
921	+	end
922	+	else
923	+	if aScale < 0 then
924	+	{$IF declared(DefaultFormatSettings)}
925	+	with DefaultFormatSettings do
926	+	{$ELSE}
927	+	{$IF declared(FormatSettings)}
928	+	with FormatSettings do
929	+	{$IFEND}
930	+	{$IFEND}
931	+	begin
932	+	if Length(Result) > -aScale then
933	+	system.Insert(DecimalSeparator,Result,Length(Result) + aScale)
934	+	else
935	+	begin
936	+	Scaling := '0' + DecimalSeparator;
937	+	for i := -1 downto aScale + Length(Result) do
938	+	Scaling := Scaling + '0';
939	+	Result := Scaling + Result;
940	+	end;
941	+	end;
942	+	end;
943	+
944		function TSQLDataItem.AdjustScaleToCurrency(Value: Int64; aScale: Integer
945		): Currency;
946		var
#	Line 1004 | Line 1132 | begin
1132		end
1133		else
1134		result := trunc(Value);
1135	+	//  writeln('Adjusted ',Value,' to ',Result);
1136		end;
1137
1138		procedure TSQLDataItem.CheckActive;
#	Line 1077 | Line 1206 | begin
1206		Result := GetSQLTypeName(GetSQLType);
1207		end;
1208
1209	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1209	>	class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1210		begin
1211		Result := 'Unknown';
1212		case SQLType of
#	Line 2330 | Line 2459 | end;
2459
2460		var b: IBlob;
2461		dt: TDateTime;
2333	–	CurrValue: Currency;
2334	–	FloatValue: single;
2462		timezone: AnsiString;
2463	+	Int64Value: Int64;
2464	+	BCDValue: TBCD;
2465	+	aScale: integer;
2466		begin
2467		CheckActive;
2468		if IsNullable then
2469		IsNull := False;
2470		with FFirebirdClientAPI do
2471	<	case SQLTYPE of
2471	>	case getColMetaData.SQLTYPE of
2472		SQL_BOOLEAN:
2473		if AnsiCompareText(Value,STrue) = 0 then
2474		AsBoolean := true
#	Line 2364 | Line 2494 | begin
2494		SQL_TEXT:
2495		DoSetString;
2496
2497	<	SQL_SHORT,
2498	<	SQL_LONG,
2499	<	SQL_INT64:
2500	<	if TryStrToCurr(Value,CurrValue) then
2501	<	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2502	<	else
2503	<	DoSetString;
2497	>	SQL_SHORT,
2498	>	SQL_LONG,
2499	>	SQL_INT64:
2500	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2501	>	SetAsNumeric(Int64Value,aScale)
2502	>	else
2503	>	DoSetString;
2504
2505	<	SQL_D_FLOAT,
2506	<	SQL_DOUBLE,
2507	<	SQL_FLOAT:
2508	<	if TryStrToFloat(Value,FloatValue) then
2509	<	SetAsDouble(FloatValue)
2510	<	else
2511	<	DoSetString;
2505	>	SQL_DEC_FIXED,
2506	>	SQL_DEC16,
2507	>	SQL_DEC34,
2508	>	SQL_INT128:
2509	>	if TryStrToBCD(Value,BCDValue) then
2510	>	SetAsBCD(BCDValue)
2511	>	else
2512	>	DoSetString;
2513
2514	<	SQL_TIMESTAMP:
2514	>	SQL_D_FLOAT,
2515	>	SQL_DOUBLE,
2516	>	SQL_FLOAT:
2517	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2518	>	SetAsDouble(NumericToDouble(Int64Value,aScale))
2519	>	else
2520	>	DoSetString;
2521	>
2522	>	SQL_TIMESTAMP:
2523		if TryStrToDateTime(Value,dt) then
2524		SetAsDateTime(dt)
2525		else
2526		DoSetString;
2527
2528	<	SQL_TYPE_DATE:
2528	>	SQL_TYPE_DATE:
2529		if TryStrToDateTime(Value,dt) then
2530		SetAsDate(dt)
2531		else
2532		DoSetString;
2533
2534	<	SQL_TYPE_TIME:
2534	>	SQL_TYPE_TIME:
2535		if TryStrToDateTime(Value,dt) then
2536		SetAsTime(dt)
2537		else
2538		DoSetString;
2539
2540	<	SQL_TIMESTAMP_TZ:
2540	>	SQL_TIMESTAMP_TZ,
2541	>	SQL_TIMESTAMP_TZ_EX:
2542		if ParseDateTimeTZString(value,dt,timezone) then
2543		SetAsDateTime(dt,timezone)
2544		else
2545		DoSetString;
2546
2547	<	SQL_TIME_TZ:
2547	>	SQL_TIME_TZ,
2548	>	SQL_TIME_TZ_EX:
2549		if ParseDateTimeTZString(value,dt,timezone,true) then
2550		SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2551		else
2552		DoSetString;
2553
2554	<	SQL_DEC_FIXED,
2555	<	SQL_DEC16,
2415	<	SQL_DEC34,
2416	<	SQL_INT128:
2417	<	SetAsBCD(StrToBCD(Value));
2418	<
2419	<	else
2420	<	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(SQLType)]);
2554	>	else
2555	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2556		end;
2557		end;
2558
#	Line 2455 | Line 2590 | begin
2590		IsNull := true;
2591		end;
2592
2593	+	function TSQLParam.getColMetadata: IParamMetaData;
2594	+	begin
2595	+	Result := FIBXSQLVAR.getColMetadata;
2596	+	end;
2597	+
2598		function TSQLParam.GetModified: boolean;
2599		begin
2600		CheckActive;

Diff Legend

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