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 350 by tony, Wed Oct 20 14:58:56 2021 UTC

#	Line 154 | Line 154 | type
154		property FirebirdClientAPI: TFBClientAPI read FFirebirdClientAPI;
155		public
156		constructor Create(api: TFBClientAPI);
157	<	function GetSQLType: cardinal; virtual; abstract;
157	>	function GetSQLType: cardinal; virtual; abstract; {Current Field Data SQL Type}
158		function GetSQLTypeName: AnsiString; overload;
159	<	class function GetSQLTypeName(SQLType: short): AnsiString; overload;
159	>	class function GetSQLTypeName(SQLType: cardinal): AnsiString; overload;
160		function GetStrDataLength: short;
161		function GetName: AnsiString; virtual; abstract;
162	<	function GetScale: integer; virtual; abstract;
162	>	function GetScale: integer; virtual; abstract; {Current Field Data scale}
163		function GetAsBoolean: boolean;
164		function GetAsCurrency: Currency;
165		function GetAsInt64: Int64;
#	Line 265 | Line 265 | type
265		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
266		property CaseSensitiveParams: boolean read FCaseSensitiveParams
267		write FCaseSensitiveParams; {Only used when IsInputDataArea true}
268	+	function CanChangeMetaData: boolean; virtual; abstract;
269		property Count: integer read GetCount;
270		property Column[index: integer]: TSQLVarData read GetColumn;
271		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 283 | Line 284 | type
284		FModified: boolean;
285		FUniqueName: boolean;
286		FVarString: RawByteString;
287	+	FColMetaData: IParamMetaData;
288		function GetStatement: IStatement;
289		procedure SetName(AValue: AnsiString);
290		protected
291	+	function GetAttachment: IAttachment; virtual; abstract;
292		function GetSQLType: cardinal; virtual; abstract;
293		function GetSubtype: integer; virtual; abstract;
294		function GetAliasName: AnsiString;  virtual; abstract;
#	Line 301 | Line 304 | type
304		function GetSQLData: PByte;  virtual; abstract;
305		function GetDataLength: cardinal; virtual; abstract; {current field length}
306		function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
307	+	function GetDefaultTextSQLType: cardinal; virtual; abstract;
308		procedure SetIsNull(Value: Boolean); virtual; abstract;
309		procedure SetIsNullable(Value: Boolean);  virtual; abstract;
310		procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
#	Line 308 | Line 312 | type
312		procedure SetDataLength(len: cardinal); virtual; abstract;
313		procedure SetSQLType(aValue: cardinal); virtual; abstract;
314		procedure SetCharSetID(aValue: cardinal); virtual; abstract;
315	+	procedure SetMetaSize(aValue: cardinal); virtual;
316		public
317		constructor Create(aParent: TSQLDataArea; aIndex: integer);
318		procedure SetString(aValue: AnsiString);
#	Line 318 | Line 323 | type
323		function CreateBlob: IBlob; virtual; abstract;
324		function GetArrayMetaData: IArrayMetaData; virtual; abstract;
325		function GetBlobMetaData: IBlobMetaData; virtual; abstract;
326	+	function getColMetadata: IParamMetaData;
327		procedure Initialize; virtual;
328	+	procedure SaveMetaData;
329
330		public
331		property AliasName: AnsiString read GetAliasName;
#	Line 407 | Line 414 | type
414		property AsBlob: IBlob read GetAsBlob;
415		end;
416
417	+	{ TSQLParamMetaData }
418	+
419	+	TSQLParamMetaData = class(TFBInterfacedObject,IParamMetaData)
420	+	private
421	+	FSQLType: cardinal;
422	+	FSQLSubType: integer;
423	+	FScale: integer;
424	+	FCharSetID: cardinal;
425	+	FNullable: boolean;
426	+	FSize: cardinal;
427	+	FCodePage: TSystemCodePage;
428	+	public
429	+	constructor Create(src: TSQLVarData);
430	+	{IParamMetaData}
431	+	function GetSQLType: cardinal;
432	+	function GetSQLTypeName: AnsiString;
433	+	function getSubtype: integer;
434	+	function getScale: integer;
435	+	function getCharSetID: cardinal;
436	+	function getCodePage: TSystemCodePage;
437	+	function getIsNullable: boolean;
438	+	function GetSize: cardinal;
439	+	property SQLType: cardinal read GetSQLType;
440	+	end;
441	+
442		{ TSQLParam }
443
444		TSQLParam = class(TIBSQLData,ISQLParam,ISQLData)
#	Line 419 | Line 451 | type
451		procedure SetSQLType(aValue: cardinal); override;
452		public
453		procedure Clear;
454	+	function getColMetadata: IParamMetaData;
455		function GetModified: boolean; override;
456		function GetAsPointer: Pointer;
457	+	function GetAsString: AnsiString; override;
458		procedure SetName(Value: AnsiString); override;
459		procedure SetIsNull(Value: Boolean);  override;
460		procedure SetIsNullable(Value: Boolean); override;
#	Line 523 | Line 557 | implementation
557
558		uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
559
560	+	{ TSQLParamMetaData }
561	+
562	+	constructor TSQLParamMetaData.Create(src: TSQLVarData);
563	+	begin
564	+	inherited Create;
565	+	FSQLType := src.GetSQLType;
566	+	FSQLSubType := src.getSubtype;
567	+	FScale := src.GetScale;
568	+	FCharSetID := src.getCharSetID;
569	+	FNullable := src.GetIsNullable;
570	+	FSize := src.GetSize;
571	+	FCodePage := src.GetCodePage;
572	+	end;
573	+
574	+	function TSQLParamMetaData.GetSQLType: cardinal;
575	+	begin
576	+	Result := FSQLType;
577	+	end;
578	+
579	+	function TSQLParamMetaData.GetSQLTypeName: AnsiString;
580	+	begin
581	+	Result := TSQLDataItem.GetSQLTypeName(FSQLType);
582	+	end;
583	+
584	+	function TSQLParamMetaData.getSubtype: integer;
585	+	begin
586	+	Result := FSQLSubType;
587	+	end;
588	+
589	+	function TSQLParamMetaData.getScale: integer;
590	+	begin
591	+	Result := FScale;
592	+	end;
593	+
594	+	function TSQLParamMetaData.getCharSetID: cardinal;
595	+	begin
596	+	Result := FCharSetID;
597	+	end;
598	+
599	+	function TSQLParamMetaData.getCodePage: TSystemCodePage;
600	+	begin
601	+	Result :=  FCodePage;
602	+	end;
603	+
604	+	function TSQLParamMetaData.getIsNullable: boolean;
605	+	begin
606	+	Result :=  FNullable;
607	+	end;
608	+
609	+	function TSQLParamMetaData.GetSize: cardinal;
610	+	begin
611	+	Result := FSize;
612	+	end;
613	+
614		{ TSQLDataArea }
615
616		function TSQLDataArea.GetColumn(index: integer): TSQLVarData;
#	Line 669 | Line 757 | begin
757		FName := AValue;
758		end;
759
760	+	procedure TSQLVarData.SetMetaSize(aValue: cardinal);
761	+	begin
762	+	//Ignore
763	+	end;
764	+
765	+	procedure TSQLVarData.SaveMetaData;
766	+	begin
767	+	FColMetaData := TSQLParamMetaData.Create(self);
768	+	end;
769	+
770		constructor TSQLVarData.Create(aParent: TSQLDataArea; aIndex: integer);
771		begin
772		inherited Create;
#	Line 685 | Line 783 | begin
783		a zero byte when the string is empty, neatly avoiding a nil pointer error.}
784
785		FVarString := aValue;
786	<	SQLType := SQL_TEXT;
786	>	if SQLType = SQL_BLOB then
787	>	SetMetaSize(GetAttachment.GetInlineBlobLimit);
788	>	SQLType := GetDefaultTextSQLType;
789		Scale := 0;
790		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
791		end;
#	Line 701 | Line 801 | begin
801		FVarString := '';
802		end;
803
804	+	function TSQLVarData.getColMetadata: IParamMetaData;
805	+	begin
806	+	Result := FColMetaData;
807	+	end;
808	+
809		procedure TSQLVarData.Initialize;
810
811		function FindVarByName(idx: AnsiString; limit: integer): TSQLVarData;
#	Line 992 | Line 1097 | begin
1097		end
1098		else
1099		result := trunc(Value);
1100	+	//  writeln('Adjusted ',Value,' to ',Result);
1101		end;
1102
1103		procedure TSQLDataItem.CheckActive;
#	Line 1065 | Line 1171 | begin
1171		Result := GetSQLTypeName(GetSQLType);
1172		end;
1173
1174	<	class function TSQLDataItem.GetSQLTypeName(SQLType: short): AnsiString;
1174	>	class function TSQLDataItem.GetSQLTypeName(SQLType: cardinal): AnsiString;
1175		begin
1176		Result := 'Unknown';
1177		case SQLType of
#	Line 1144 | Line 1250 | begin
1250		result := AdjustScaleToCurrency(PInt64(SQLData)^,
1251		Scale);
1252		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1253	<	result := Trunc(AsDouble);
1253	>	result := Round(AsDouble);
1254
1255		SQL_DEC_FIXED,
1256		SQL_DEC16,
#	Line 1182 | Line 1288 | begin
1288		result := AdjustScaleToInt64(PInt64(SQLData)^,
1289		Scale);
1290		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1291	<	result := Trunc(AsDouble);
1291	>	result := Round(AsDouble);
1292		else
1293		IBError(ibxeInvalidDataConversion, [nil]);
1294		end;
#	Line 1361 | Line 1467 | begin
1467		end;
1468		end;
1469		SQL_SHORT:
1470	<	result := Trunc(AdjustScale(Int64(PShort(SQLData)^),
1470	>	result := Round(AdjustScale(Int64(PShort(SQLData)^),
1471		Scale));
1472		SQL_LONG:
1473	<	result := Trunc(AdjustScale(Int64(PLong(SQLData)^),
1473	>	result := Round(AdjustScale(Int64(PLong(SQLData)^),
1474		Scale));
1475		SQL_INT64:
1476	<	result := Trunc(AdjustScale(PInt64(SQLData)^, Scale));
1476	>	result := Round(AdjustScale(PInt64(SQLData)^, Scale));
1477		SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT:
1478	<	result := Trunc(AsDouble);
1478	>	result := Round(AsDouble);
1479		SQL_DEC_FIXED,
1480		SQL_DEC16,
1481		SQL_DEC34,
#	Line 2316 | Line 2422 | begin
2422		Changed;
2423		end;
2424
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	+
2469		var b: IBlob;
2470		dt: TDateTime;
2321	–	CurrValue: Currency;
2322	–	FloatValue: single;
2471		timezone: AnsiString;
2472	+	{$ifdef FPC_HAS_TYPE_EXTENDED}
2473	+	FloatValue: Extended;
2474	+	{$else}
2475	+	FloatValue: Double;
2476	+	{$endif}
2477	+	Int64Value: Int64;
2478	+	BCDValue: TBCD;
2479	+	aScale: integer;
2480		begin
2481		CheckActive;
2482		if IsNullable then
2483		IsNull := False;
2484		with FFirebirdClientAPI do
2485	<	case SQLTYPE of
2485	>	case getColMetaData.SQLTYPE of
2486		SQL_BOOLEAN:
2487		if AnsiCompareText(Value,STrue) = 0 then
2488		AsBoolean := true
#	Line 2337 | Line 2493 | begin
2493		IBError(ibxeInvalidDataConversion,[nil]);
2494
2495		SQL_BLOB:
2496	+	if Length(Value) < GetAttachment.GetInlineBlobLimit then
2497	+	DoSetString
2498	+	else
2499		begin
2500		Changing;
2501		b := FIBXSQLVAR.CreateBlob;
#	Line 2349 | Line 2508 | begin
2508		SQL_TEXT:
2509		DoSetString;
2510
2511	<	SQL_SHORT,
2512	<	SQL_LONG,
2513	<	SQL_INT64:
2514	<	if TryStrToCurr(Value,CurrValue) then
2515	<	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
2511	>	SQL_SHORT,
2512	>	SQL_LONG,
2513	>	SQL_INT64:
2514	>	if TryStrToNumeric(Value,Int64Value,aScale) then
2515	>	begin
2516	>	if aScale = 0 then
2517	>	SetAsInt64(Int64Value)
2518		else
2519	<	DoSetString;
2519	>	SetAsNumeric(Int64Value,aScale);
2520	>	end
2521	>	else
2522	>	if TryStrToFloat(Value,FloatValue) then
2523	>	SetAsDouble(FloatValue)
2524	>	else
2525	>	DoSetString;
2526
2527	<	SQL_D_FLOAT,
2528	<	SQL_DOUBLE,
2529	<	SQL_FLOAT:
2530	<	if TryStrToFloat(Value,FloatValue) then
2531	<	SetAsDouble(FloatValue)
2532	<	else
2533	<	DoSetString;
2527	>	SQL_DEC_FIXED,
2528	>	SQL_DEC16,
2529	>	SQL_DEC34,
2530	>	SQL_INT128:
2531	>	if TryStrToBCD(Value,BCDValue) then
2532	>	SetAsBCD(BCDValue)
2533	>	else
2534	>	DoSetString;
2535	>
2536	>	SQL_D_FLOAT,
2537	>	SQL_DOUBLE,
2538	>	SQL_FLOAT:
2539	>	if TryStrToFloat(Value,FloatValue) then
2540	>	SetAsDouble(FloatValue)
2541	>	else
2542	>	DoSetString;
2543
2544	<	SQL_TIMESTAMP:
2544	>	SQL_TIMESTAMP:
2545		if TryStrToDateTime(Value,dt) then
2546		SetAsDateTime(dt)
2547		else
2548		DoSetString;
2549
2550	<	SQL_TYPE_DATE:
2550	>	SQL_TYPE_DATE:
2551		if TryStrToDateTime(Value,dt) then
2552		SetAsDate(dt)
2553		else
2554		DoSetString;
2555
2556	<	SQL_TYPE_TIME:
2556	>	SQL_TYPE_TIME:
2557		if TryStrToDateTime(Value,dt) then
2558		SetAsTime(dt)
2559		else
2560		DoSetString;
2561
2562	<	SQL_TIMESTAMP_TZ:
2562	>	SQL_TIMESTAMP_TZ,
2563	>	SQL_TIMESTAMP_TZ_EX:
2564		if ParseDateTimeTZString(value,dt,timezone) then
2565		SetAsDateTime(dt,timezone)
2566		else
2567		DoSetString;
2568
2569	<	SQL_TIME_TZ:
2569	>	SQL_TIME_TZ,
2570	>	SQL_TIME_TZ_EX:
2571		if ParseDateTimeTZString(value,dt,timezone,true) then
2572		SetAsTime(dt,GetAttachment.GetTimeZoneServices.GetTimeTZDate,timezone)
2573		else
2574		DoSetString;
2575
2576	<	SQL_DEC_FIXED,
2577	<	SQL_DEC16,
2400	<	SQL_DEC34,
2401	<	SQL_INT128:
2402	<	SetAsBCD(StrToBCD(Value));
2403	<
2404	<	else
2405	<	IBError(ibxeInvalidDataConversion,[nil]);
2576	>	else
2577	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2578		end;
2579		end;
2580
#	Line 2440 | Line 2612 | begin
2612		IsNull := true;
2613		end;
2614
2615	+	function TSQLParam.getColMetadata: IParamMetaData;
2616	+	begin
2617	+	Result := FIBXSQLVAR.getColMetadata;
2618	+	end;
2619	+
2620		function TSQLParam.GetModified: boolean;
2621		begin
2622		CheckActive;
#	Line 2453 | Line 2630 | begin
2630		Result := inherited GetAsPointer;
2631		end;
2632
2633	+	function TSQLParam.GetAsString: AnsiString;
2634	+	var rs: RawByteString;
2635	+	begin
2636	+	Result := '';
2637	+	if (SQLType = SQL_VARYING) and not IsNull then
2638	+	{SQLData points to start of string - default is to length word}
2639	+	begin
2640	+	CheckActive;
2641	+	SetString(rs,PAnsiChar(SQLData),DataLength);
2642	+	SetCodePage(rs,GetCodePage,false);
2643	+	Result := rs;
2644	+	end
2645	+	else
2646	+	Result := inherited GetAsString;
2647	+	end;
2648	+
2649		procedure TSQLParam.SetName(Value: AnsiString);
2650		begin
2651		CheckActive;

Diff Legend

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