ViewVC Help

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

root/public/ibx/branches/journaling/fbintf/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.
ibx/branches/journaling/fbintf/client/FBSQLData.pas (file contents), Revision 363 by tony, Tue Dec 7 13:30:05 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
292	+	FArrayIntf: IArray;
293		function GetAttachment: IAttachment; virtual; abstract;
294		function GetSQLType: cardinal; virtual; abstract;
295		function GetSubtype: integer; virtual; abstract;
#	Line 317 | 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;
327		function GetBlobMetaData: IBlobMetaData; virtual; abstract;
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 411 | Line 417 | type
417		property AsBlob: IBlob read GetAsBlob;
418		end;
419
420	+	{ TSQLParamMetaData }
421	+
422	+	TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
423	+	private
424	+	FSQLType: cardinal;
425	+	FSQLSubType: integer;
426	+	FScale: integer;
427	+	FCharSetID: cardinal;
428	+	FNullable: boolean;
429	+	FSize: cardinal;
430	+	FCodePage: TSystemCodePage;
431	+	public
432	+	constructor Create(src: TSQLVarData);
433	+	{IParamMetaData}
434	+	function GetSQLType: cardinal;
435	+	function GetSQLTypeName: AnsiString;
436	+	function getSubtype: integer;
437	+	function getScale: integer;
438	+	function getCharSetID: cardinal;
439	+	function getCodePage: TSystemCodePage;
440	+	function getIsNullable: boolean;
441	+	function GetSize: cardinal;
442	+	property SQLType: cardinal read GetSQLType;
443	+	end;
444	+
445		{ TSQLParam }
446
447		TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
#	Line 423 | Line 454 | type
454		procedure SetSQLType(aValue: cardinal); override;
455		public
456		procedure Clear;
457	+	function getColMetadata: IParamMetaData;
458		function GetModified: boolean; override;
459		function GetAsPointer: Pointer;
460		function GetAsString: AnsiString; override;
#	Line 528 | Line 560 | implementation
560
561		uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
562
563	+	{ TSQLParamMetaData }
564	+
565	+	constructor TSQLParamMetaData.Create(src: TSQLVarData);
566	+	begin
567	+	inherited Create;
568	+	FSQLType := src.GetSQLType;
569	+	FSQLSubType := src.getSubtype;
570	+	FScale := src.GetScale;
571	+	FCharSetID := src.getCharSetID;
572	+	FNullable := src.GetIsNullable;
573	+	FSize := src.GetSize;
574	+	FCodePage := src.GetCodePage;
575	+	end;
576	+
577	+	function TSQLParamMetaData.GetSQLType: cardinal;
578	+	begin
579	+	Result := FSQLType;
580	+	end;
581	+
582	+	function TSQLParamMetaData.GetSQLTypeName: AnsiString;
583	+	begin
584	+	Result := TSQLDataItem.GetSQLTypeName(FSQLType);
585	+	end;
586	+
587	+	function TSQLParamMetaData.getSubtype: integer;
588	+	begin
589	+	Result := FSQLSubType;
590	+	end;
591	+
592	+	function TSQLParamMetaData.getScale: integer;
593	+	begin
594	+	Result := FScale;
595	+	end;
596	+
597	+	function TSQLParamMetaData.getCharSetID: cardinal;
598	+	begin
599	+	Result := FCharSetID;
600	+	end;
601	+
602	+	function TSQLParamMetaData.getCodePage: TSystemCodePage;
603	+	begin
604	+	Result :=  FCodePage;
605	+	end;
606	+
607	+	function TSQLParamMetaData.getIsNullable: boolean;
608	+	begin
609	+	Result :=  FNullable;
610	+	end;
611	+
612	+	function TSQLParamMetaData.GetSize: cardinal;
613	+	begin
614	+	Result := FSize;
615	+	end;
616	+
617		{ TSQLDataArea }
618
619		function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
#	Line 679 | Line 765 | begin
765		//Ignore
766		end;
767
768	+	procedure TSQLVarData.SaveMetaData;
769	+	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 709 | Line 805 | end;
805
806		procedure TSQLVarData.RowChange;
807		begin
808	+	FArrayIntf := nil;
809		FModified := false;
810		FVarString := '';
811		end;
812
813	+	function TSQLVarData.getColMetadata: IParamMetaData;
814	+	begin
815	+	Result := FColMetaData;
816	+	end;
817	+
818		procedure TSQLVarData.Initialize;
819
820		function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
#	Line 813 | 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 1004 | Line 1140 | begin
1140		end
1141		else
1142		result := trunc(Value);
1143	+	//  writeln('Adjusted ',Value,' to ',Result);
1144		end;
1145
1146		procedure TSQLDataItem.CheckActive;
#	Line 1077 | Line 1214 | begin
1214		Result := GetSQLTypeName(GetSQLType);
1215		end;
1216
1217	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1217	>	class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1218		begin
1219		Result := 'Unknown';
1220		case SQLType of
#	Line 1476 | Line 1613 | end;
1613		function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1614		var i: integer;
1615		cplen: integer;
1479	–	s: AnsiString;
1616		begin
1617		Result := 0;
1482	–	s := strpas(p);
1618		for i := 1 to FieldWidth do
1619		begin
1620		cplen := UTF8CodepointSizeFull(p);
#	Line 2036 | Line 2171 | begin
2171		end;
2172
2173		procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2039	–	var C: Currency;
2174		begin
2175		CheckActive;
2176		Changing;
#	Line 2286 | 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 2330 | Line 2464 | end;
2464
2465		var b: IBlob;
2466		dt: TDateTime;
2333	–	CurrValue: Currency;
2334	–	FloatValue: single;
2467		timezone: AnsiString;
2468	+	Int64Value: Int64;
2469	+	BCDValue: TBCD;
2470	+	aScale: integer;
2471		begin
2472		CheckActive;
2473		if IsNullable then
2474		IsNull := False;
2475		with FFirebirdClientAPI do
2476	<	case SQLTYPE of
2476	>	case getColMetaData.SQLTYPE of
2477		SQL_BOOLEAN:
2478		if AnsiCompareText(Value,STrue) = 0 then
2479		AsBoolean := true
#	Line 2364 | Line 2499 | begin
2499		SQL_TEXT:
2500		DoSetString;
2501
2502	<	SQL_SHORT,
2503	<	SQL_LONG,
2504	<	SQL_INT64:
2505	<	if TryStrToCurr(Value,CurrValue) then
2506	<	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2507	<	else
2508	<	DoSetString;
2502	>	SQL_SHORT,
2503	>	SQL_LONG,
2504	>	SQL_INT64:
2505	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2506	>	SetAsNumeric(Int64Value,aScale)
2507	>	else
2508	>	DoSetString;
2509
2510	<	SQL_D_FLOAT,
2511	<	SQL_DOUBLE,
2512	<	SQL_FLOAT:
2513	<	if TryStrToFloat(Value,FloatValue) then
2514	<	SetAsDouble(FloatValue)
2515	<	else
2516	<	DoSetString;
2510	>	SQL_DEC_FIXED,
2511	>	SQL_DEC16,
2512	>	SQL_DEC34,
2513	>	SQL_INT128:
2514	>	if TryStrToBCD(Value,BCDValue) then
2515	>	SetAsBCD(BCDValue)
2516	>	else
2517	>	DoSetString;
2518
2519	<	SQL_TIMESTAMP:
2519	>	SQL_D_FLOAT,
2520	>	SQL_DOUBLE,
2521	>	SQL_FLOAT:
2522	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2523	>	SetAsDouble(NumericToDouble(Int64Value,aScale))
2524	>	else
2525	>	DoSetString;
2526	>
2527	>	SQL_TIMESTAMP:
2528		if TryStrToDateTime(Value,dt) then
2529		SetAsDateTime(dt)
2530		else
2531		DoSetString;
2532
2533	<	SQL_TYPE_DATE:
2533	>	SQL_TYPE_DATE:
2534		if TryStrToDateTime(Value,dt) then
2535		SetAsDate(dt)
2536		else
2537		DoSetString;
2538
2539	<	SQL_TYPE_TIME:
2539	>	SQL_TYPE_TIME:
2540		if TryStrToDateTime(Value,dt) then
2541		SetAsTime(dt)
2542		else
2543		DoSetString;
2544
2545	<	SQL_TIMESTAMP_TZ:
2545	>	SQL_TIMESTAMP_TZ,
2546	>	SQL_TIMESTAMP_TZ_EX:
2547		if ParseDateTimeTZString(value,dt,timezone) then
2548		SetAsDateTime(dt,timezone)
2549		else
2550		DoSetString;
2551
2552	<	SQL_TIME_TZ:
2552	>	SQL_TIME_TZ,
2553	>	SQL_TIME_TZ_EX:
2554		if ParseDateTimeTZString(value,dt,timezone,true) then
2555		SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2556		else
2557		DoSetString;
2558
2559	<	SQL_DEC_FIXED,
2560	<	SQL_DEC16,
2415	<	SQL_DEC34,
2416	<	SQL_INT128:
2417	<	SetAsBCD(StrToBCD(Value));
2418	<
2419	<	else
2420	<	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(SQLType)]);
2559	>	else
2560	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2561		end;
2562		end;
2563
#	Line 2455 | Line 2595 | begin
2595		IsNull := true;
2596		end;
2597
2598	+	function TSQLParam.getColMetadata: IParamMetaData;
2599	+	begin
2600	+	Result := FIBXSQLVAR.getColMetadata;
2601	+	end;
2602	+
2603		function TSQLParam.GetModified: boolean;
2604		begin
2605		CheckActive;
#	Line 2529 | 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