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 315 by tony, Thu Feb 25 11:56:36 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 265 | Line 266 | type
266		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
267		property CaseSensitiveParams: boolean read FCaseSensitiveParams
268		write FCaseSensitiveParams; {Only used when IsInputDataArea true}
269	+	function CanChangeMetaData: boolean; virtual; abstract;
270		property Count: integer read GetCount;
271		property Column[index: integer]: TSQLVarData read GetColumn;
272		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 283 | 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;
296		function GetAliasName: AnsiString;  virtual; abstract;
#	Line 301 | Line 306 | type
306		function GetSQLData: PByte;  virtual; abstract;
307		function GetDataLength: cardinal; virtual; abstract; {current field length}
308		function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
309	+	function GetDefaultTextSQLType: cardinal; virtual; abstract;
310		procedure SetIsNull(Value: Boolean); virtual; abstract;
311		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
312		procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
#	Line 308 | Line 314 | type
314		procedure SetDataLength(len: cardinal); virtual; abstract;
315		procedure SetSQLType(aValue: cardinal); virtual; abstract;
316		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
317	+	procedure SetMetaSize(aValue: cardinal); virtual;
318		public
319		constructor Create(aParent: TSQLDataArea; aIndex: integer);
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 407 | 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 419 | 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;
461		procedure SetName(Value: AnsiString); override;
462		procedure SetIsNull(Value: Boolean);  override;
463		procedure SetIsNullable(Value: Boolean); override;
#	Line 523 | 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 669 | Line 760 | begin
760		FName := AValue;
761		end;
762
763	+	procedure TSQLVarData.SetMetaSize(aValue: cardinal);
764	+	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 685 | Line 791 | begin
791		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
792
793		FVarString := aValue;
794	<	SQLType := SQL_TEXT;
794	>	if SQLType = SQL_BLOB then
795	>	SetMetaSize(GetAttachment.GetInlineBlobLimit);
796	>	SQLType := GetDefaultTextSQLType;
797		Scale := 0;
798		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
799		end;
#	Line 697 | 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 801 | 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 992 | 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 1065 | 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 1144 | Line 1293 | begin
1293		result := AdjustScaleToCurrency(PInt64(SQLData)^,
1294		Scale);
1295		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1296	<	result := Trunc(AsDouble);
1296	>	result := Round(AsDouble);
1297
1298		SQL_DEC_FIXED,
1299		SQL_DEC16,
#	Line 1182 | Line 1331 | begin
1331		result := AdjustScaleToInt64(PInt64(SQLData)^,
1332		Scale);
1333		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1334	<	result := Trunc(AsDouble);
1334	>	result := Round(AsDouble);
1335		else
1336		IBError(ibxeInvalidDataConversion, [nil]);
1337		end;
#	Line 1361 | Line 1510 | begin
1510		end;
1511		end;
1512		SQL_SHORT:
1513	<	result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1513	>	result := Round(AdjustScale(Int64(PShort(SQLData)^),
1514		Scale));
1515		SQL_LONG:
1516	<	result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1516	>	result := Round(AdjustScale(Int64(PLong(SQLData)^),
1517		Scale));
1518		SQL_INT64:
1519	<	result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1519	>	result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1520		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1521	<	result := Trunc(AsDouble);
1521	>	result := Round(AsDouble);
1522		SQL_DEC_FIXED,
1523		SQL_DEC16,
1524		SQL_DEC34,
#	Line 1464 | Line 1613 | end;
1613		function GetStrLen(p: PAnsiChar; FieldWidth, MaxDataLength: cardinal): integer;
1614		var i: integer;
1615		cplen: integer;
1467	–	s: AnsiString;
1616		begin
1617		Result := 0;
1470	–	s := strpas(p);
1618		for i := 1 to FieldWidth do
1619		begin
1620		cplen := UTF8CodepointSizeFull(p);
#	Line 2024 | Line 2171 | begin
2171		end;
2172
2173		procedure TSQLDataItem.SetAsBcd(aValue: tBCD);
2027	–	var C: Currency;
2174		begin
2175		CheckActive;
2176		Changing;
#	Line 2274 | 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 2318 | Line 2464 | end;
2464
2465		var b: IBlob;
2466		dt: TDateTime;
2321	–	CurrValue: Currency;
2322	–	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 2337 | Line 2484 | begin
2484		IBError(ibxeInvalidDataConversion,[nil]);
2485
2486		SQL_BLOB:
2487	+	if Length(Value) < GetAttachment.GetInlineBlobLimit then
2488	+	DoSetString
2489	+	else
2490		begin
2491		Changing;
2492		b := FIBXSQLVAR.CreateBlob;
#	Line 2349 | 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_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:
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,
2400	<	SQL_DEC34,
2401	<	SQL_INT128:
2402	<	SetAsBCD(StrToBCD(Value));
2403	<
2404	<	else
2405	<	IBError(ibxeInvalidDataConversion,[nil]);
2559	>	else
2560	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2561		end;
2562		end;
2563
#	Line 2440 | 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 2453 | Line 2613 | begin
2613		Result := inherited GetAsPointer;
2614		end;
2615
2616	+	function TSQLParam.GetAsString: AnsiString;
2617	+	var rs: RawByteString;
2618	+	begin
2619	+	Result := '';
2620	+	if (SQLType = SQL_VARYING) and not IsNull then
2621	+	{SQLData points to start of string - default is to length word}
2622	+	begin
2623	+	CheckActive;
2624	+	SetString(rs,PAnsiChar(SQLData),DataLength);
2625	+	SetCodePage(rs,GetCodePage,false);
2626	+	Result := rs;
2627	+	end
2628	+	else
2629	+	Result := inherited GetAsString;
2630	+	end;
2631	+
2632		procedure TSQLParam.SetName(Value: AnsiString);
2633		begin
2634		CheckActive;
#	Line 2498 | 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