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.
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 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	+	function GetAttachment: IAttachment; virtual; abstract;
293		function GetSQLType: cardinal; virtual; abstract;
294		function GetSubtype: integer; virtual; abstract;
295		function GetAliasName: AnsiString;  virtual; abstract;
#	Line 301 | Line 305 | type
305		function GetSQLData: PByte;  virtual; abstract;
306		function GetDataLength: cardinal; virtual; abstract; {current field length}
307		function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
308	+	function GetDefaultTextSQLType: cardinal; virtual; abstract;
309		procedure SetIsNull(Value: Boolean); virtual; abstract;
310		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
311		procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
#	Line 308 | Line 313 | type
313		procedure SetDataLength(len: cardinal); virtual; abstract;
314		procedure SetSQLType(aValue: cardinal); virtual; abstract;
315		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
316	+	procedure SetMetaSize(aValue: cardinal); virtual;
317		public
318		constructor Create(aParent: TSQLDataArea; aIndex: integer);
319		procedure SetString(aValue: AnsiString);
#	Line 318 | 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 407 | 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 419 | 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;
459		procedure SetName(Value: AnsiString); override;
460		procedure SetIsNull(Value: Boolean);  override;
461		procedure SetIsNullable(Value: Boolean); override;
#	Line 523 | 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 669 | Line 758 | begin
758		FName := AValue;
759		end;
760
761	+	procedure TSQLVarData.SetMetaSize(aValue: cardinal);
762	+	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 685 | Line 784 | begin
784		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
785
786		FVarString := aValue;
787	<	SQLType := SQL_TEXT;
787	>	if SQLType = SQL_BLOB then
788	>	SetMetaSize(GetAttachment.GetInlineBlobLimit);
789	>	SQLType := GetDefaultTextSQLType;
790		Scale := 0;
791		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
792		end;
#	Line 701 | 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 801 | 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 992 | 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 1065 | 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 1144 | Line 1285 | begin
1285		result := AdjustScaleToCurrency(PInt64(SQLData)^,
1286		Scale);
1287		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1288	<	result := Trunc(AsDouble);
1288	>	result := Round(AsDouble);
1289
1290		SQL_DEC_FIXED,
1291		SQL_DEC16,
#	Line 1182 | Line 1323 | begin
1323		result := AdjustScaleToInt64(PInt64(SQLData)^,
1324		Scale);
1325		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1326	<	result := Trunc(AsDouble);
1326	>	result := Round(AsDouble);
1327		else
1328		IBError(ibxeInvalidDataConversion, [nil]);
1329		end;
#	Line 1361 | Line 1502 | begin
1502		end;
1503		end;
1504		SQL_SHORT:
1505	<	result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1505	>	result := Round(AdjustScale(Int64(PShort(SQLData)^),
1506		Scale));
1507		SQL_LONG:
1508	<	result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1508	>	result := Round(AdjustScale(Int64(PLong(SQLData)^),
1509		Scale));
1510		SQL_INT64:
1511	<	result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1511	>	result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1512		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1513	<	result := Trunc(AsDouble);
1513	>	result := Round(AsDouble);
1514		SQL_DEC_FIXED,
1515		SQL_DEC16,
1516		SQL_DEC34,
#	Line 2318 | Line 2459 | end;
2459
2460		var b: IBlob;
2461		dt: TDateTime;
2321	–	CurrValue: Currency;
2322	–	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 2337 | Line 2479 | begin
2479		IBError(ibxeInvalidDataConversion,[nil]);
2480
2481		SQL_BLOB:
2482	+	if Length(Value) < GetAttachment.GetInlineBlobLimit then
2483	+	DoSetString
2484	+	else
2485		begin
2486		Changing;
2487		b := FIBXSQLVAR.CreateBlob;
#	Line 2349 | 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_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:
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,
2400	<	SQL_DEC34,
2401	<	SQL_INT128:
2402	<	SetAsBCD(StrToBCD(Value));
2403	<
2404	<	else
2405	<	IBError(ibxeInvalidDataConversion,[nil]);
2554	>	else
2555	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2556		end;
2557		end;
2558
#	Line 2440 | 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;
#	Line 2453 | Line 2608 | begin
2608		Result := inherited GetAsPointer;
2609		end;
2610
2611	+	function TSQLParam.GetAsString: AnsiString;
2612	+	var rs: RawByteString;
2613	+	begin
2614	+	Result := '';
2615	+	if (SQLType = SQL_VARYING) and not IsNull then
2616	+	{SQLData points to start of string - default is to length word}
2617	+	begin
2618	+	CheckActive;
2619	+	SetString(rs,PAnsiChar(SQLData),DataLength);
2620	+	SetCodePage(rs,GetCodePage,false);
2621	+	Result := rs;
2622	+	end
2623	+	else
2624	+	Result := inherited GetAsString;
2625	+	end;
2626	+
2627		procedure TSQLParam.SetName(Value: AnsiString);
2628		begin
2629		CheckActive;

Diff Legend

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