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 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 284 | 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
#	Line 322 | 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 411 | 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 423 | 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;
#	Line 528 | 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 679 | Line 762 | 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 713 | 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 1004 | 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 1077 | 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 2328 | 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;
2333	–	CurrValue: Currency;
2334	–	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 2364 | 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_TIMESTAMP:
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:
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,
2415	<	SQL_DEC34,
2416	<	SQL_INT128:
2417	<	SetAsBCD(StrToBCD(Value));
2418	<
2419	<	else
2420	<	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(SQLType)]);
2576	>	else
2577	>	IBError(ibxeInvalidDataConversion,[GetSQLTypeName(getColMetaData.SQLTYPE)]);
2578		end;
2579		end;
2580
#	Line 2455 | 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;

Diff Legend

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