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 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

#	Line 76 | Line 76 | unit FBSQLData;
76		methods are needed for SQL parameters only. The string getters and setters
77		are virtual as SQLVar and Array encodings of string data is different.}
78
79	–	{ Note on SQL Parameter Names
80	–	--------------------------------------------
81	–
82	–	IBX processes parameter names case insensitive. This does result in some additional
83	–	overhead due to a call to "AnsiUpperCase". This can be avoided by undefining
84	–	"UseCaseInSensitiveParamName" below.
85	–
86	–	}
87	–	{$define UseCaseInSensitiveParamName}
79
80		interface
81
#	Line 101 | Line 92 | type
92		function AdjustScale(Value: Int64; aScale: Integer): Double;
93		function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
94		function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
95	+	function GetTimestampFormatStr: AnsiString;
96	+	function GetDateFormatStr(IncludeTime: boolean): AnsiString;
97	+	function GetTimeFormatStr: AnsiString;
98		procedure SetAsInteger(AValue: Integer);
99		protected
100		function AdjustScaleFromCurrency(Value: Currency; aScale: Integer): Int64;
#	Line 125 | Line 119 | type
119		function GetSQLType: cardinal; virtual; abstract;
120		function GetSQLTypeName: AnsiString; overload;
121		class function GetSQLTypeName(SQLType: short): AnsiString; overload;
122	+	function GetStrDataLength: short;
123		function GetName: AnsiString; virtual; abstract;
124		function GetScale: integer; virtual; abstract;
125		function GetAsBoolean: boolean;
#	Line 142 | Line 137 | type
137		function GetIsNullable: boolean; virtual;
138		function GetAsVariant: Variant;
139		function GetModified: boolean; virtual;
140	+	function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
141		procedure SetAsBoolean(AValue: boolean); virtual;
142		procedure SetAsCurrency(Value: Currency); virtual;
143		procedure SetAsInt64(Value: Int64); virtual;
#	Line 190 | Line 186 | type
186
187		TSQLDataArea = class
188		private
189	+	FCaseSensitiveParams: boolean;
190		function GetColumn(index: integer): TSQLVarData;
191		function GetCount: integer;
192		protected
#	Line 212 | Line 209 | type
209		var data: PByte); virtual;
210		procedure RowChange;
211		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
212	+	property CaseSensitiveParams: boolean read FCaseSensitiveParams
213	+	write FCaseSensitiveParams; {Only used when IsInputDataArea true}
214		property Count: integer read GetCount;
215		property Column[index: integer]: TSQLVarData read GetColumn;
216		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 294 | Line 293 | type
293		FIBXSQLVAR: TSQLVarData;
294		FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
295		FPrepareSeqNo: integer;
297	–	FStatement: IStatement;
296		FChangeSeqNo: integer;
297		protected
298		procedure CheckActive; override;
#	Line 306 | Line 304 | type
304		constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
305		destructor Destroy; override;
306		function GetSQLDialect: integer; override;
309	–	property Statement: IStatement read FStatement;
307
308		public
309		{IColumnMetaData}
#	Line 324 | Line 321 | type
321		function GetSize: cardinal;
322		function GetArrayMetaData: IArrayMetaData;
323		function GetBlobMetaData: IBlobMetaData;
324	+	function GetStatement: IStatement;
325	+	function GetTransaction: ITransaction; virtual;
326		property Name: AnsiString read GetName;
327		property Size: cardinal read GetSize;
328		property CharSetID: cardinal read getCharSetID;
329		property SQLSubtype: integer read getSubtype;
330		property IsNullable: Boolean read GetIsNullable;
331	+	public
332	+	property Statement: IStatement read GetStatement;
333		end;
334
335		{ TIBSQLData }
336
337		TIBSQLData = class(TColumnMetaData,ISQLData)
338	+	private
339	+	FTransaction: ITransaction;
340		protected
341		procedure CheckActive; override;
342		public
343	+	function GetTransaction: ITransaction; override;
344		function GetIsNull: Boolean; override;
345		function GetAsArray: IArray;
346		function GetAsBlob: IBlob; overload;
#	Line 423 | Line 427 | type
427		function getSQLParam(index: integer): ISQLParam;
428		function ByName(Idx: AnsiString): ISQLParam ;
429		function GetModified: Boolean;
430	+	function GetHasCaseSensitiveParams: Boolean;
431		end;
432
433		{ TResults }
#	Line 444 | Line 449 | type
449		function ByName(Idx: AnsiString): ISQLData;
450		function getSQLData(index: integer): ISQLData;
451		procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
452	+	function GetStatement: IStatement;
453		function GetTransaction: ITransaction; virtual;
454		procedure SetRetainInterfaces(aValue: boolean);
455		end;
456
457		implementation
458
459	<	uses FBMessages, variants, IBUtils, FBTransaction;
454	<
455	<	type
456	<
457	<	{ TSQLParamProcessor }
458	<
459	<	TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
460	<	private
461	<	const
462	<	sIBXParam = 'IBXParam';  {do not localize}
463	<	private
464	<	FInString: AnsiString;
465	<	FIndex: integer;
466	<	function DoExecute(GenerateParamNames: boolean;
467	<	var slNames: TStrings): AnsiString;
468	<	protected
469	<	function GetChar: AnsiChar; override;
470	<	public
471	<	class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
472	<	var slNames: TStrings): AnsiString;
473	<	end;
474	<
475	<	{ TSQLParamProcessor }
476	<
477	<	function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
478	<	var slNames: TStrings): AnsiString;
479	<	var token: TSQLTokens;
480	<	iParamSuffix: Integer;
481	<	begin
482	<	Result := '';
483	<	iParamSuffix := 0;
484	<
485	<	while not EOF do
486	<	begin
487	<	token := GetNextToken;
488	<	case token of
489	<	sqltParam,
490	<	sqltQuotedParam:
491	<	begin
492	<	Result := Result + '?';
493	<	slNames.Add(TokenText);
494	<	end;
495	<
496	<	sqltPlaceHolder:
497	<	if GenerateParamNames then
498	<	begin
499	<	Inc(iParamSuffix);
500	<	slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
501	<	//add pointer to self to mark entry
502	<	Result := Result + '?';
503	<	end
504	<	else
505	<	IBError(ibxeSQLParseError, [SParamNameExpected]);
506	<
507	<	sqltQuotedString:
508	<	Result := Result + '''' + SQLSafeString(TokenText) + '''';
509	<
510	<	sqltIdentifierInDoubleQuotes:
511	<	Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
512	<
513	<	sqltComment:
514	<	Result := Result + '/*' + TokenText + '*/';
515	<
516	<	sqltCommentLine:
517	<	Result := Result + '//' + TokenText + LineEnding;
518	<
519	<	sqltEOL:
520	<	Result := Result + LineEnding;
521	<
522	<	else
523	<	Result := Result + TokenText;
524	<	end;
525	<	end;
526	<	end;
527	<
528	<	function TSQLParamProcessor.GetChar: AnsiChar;
529	<	begin
530	<	if FIndex <= Length(FInString) then
531	<	begin
532	<	Result := FInString[FIndex];
533	<	Inc(FIndex);
534	<	end
535	<	else
536	<	Result := #0;
537	<	end;
538	<
539	<	class function TSQLParamProcessor.Execute(sSQL: AnsiString;
540	<	GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
541	<	begin
542	<	with self.Create do
543	<	try
544	<	FInString := sSQL;
545	<	FIndex := 1;
546	<	Result := DoExecute(GenerateParamNames,slNames);
547	<	finally
548	<	Free;
549	<	end;
550	<	end;
551	<
459	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
460
461		{ TSQLDataArea }
462
#	Line 654 | Line 562 | var
562		s: AnsiString;
563		i: Integer;
564		begin
565	<	{$ifdef UseCaseInSensitiveParamName}
566	<	s := AnsiUpperCase(Idx);
567	<	{$else}
565	>	if not IsInputDataArea or not CaseSensitiveParams then
566	>	s := AnsiUpperCase(Idx)
567	>	else
568		s := Idx;
569	<	{$endif}
569	>
570		for i := 0 to Count - 1 do
571		if Column[i].Name = s then
572		begin
#	Line 690 | Line 598 | end;
598
599		procedure TSQLVarData.SetName(AValue: AnsiString);
600		begin
601	<	if FName = AValue then Exit;
694	<	{$ifdef UseCaseInSensitiveParamName}
695	<	if Parent.IsInputDataArea then
601	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
602		FName := AnsiUpperCase(AValue)
603		else
698	–	{$endif}
604		FName := AValue;
605		end;
606
#	Line 716 | Line 621 | begin
621
622		FVarString := aValue;
623		SQLType := SQL_TEXT;
624	+	Scale := 0;
625		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
626		end;
627
#	Line 876 | Line 782 | begin
782		result := Value;
783		end;
784
785	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
786	+	begin
787	+	{$IF declared(DefaultFormatSettings)}
788	+	with DefaultFormatSettings do
789	+	{$ELSE}
790	+	{$IF declared(FormatSettings)}
791	+	with FormatSettings do
792	+	{$IFEND}
793	+	{$IFEND}
794	+	case GetSQLDialect of
795	+	1:
796	+	if IncludeTime then
797	+	result := ShortDateFormat + ' ' + LongTimeFormat
798	+	else
799	+	result := ShortDateFormat;
800	+	3:
801	+	result := ShortDateFormat;
802	+	end;
803	+	end;
804	+
805	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
806	+	begin
807	+	{$IF declared(DefaultFormatSettings)}
808	+	with DefaultFormatSettings do
809	+	{$ELSE}
810	+	{$IF declared(FormatSettings)}
811	+	with FormatSettings do
812	+	{$IFEND}
813	+	{$IFEND}
814	+	Result := LongTimeFormat;
815	+	end;
816	+
817	+	function TSQLDataItem.GetTimestampFormatStr: AnsiString;
818	+	begin
819	+	{$IF declared(DefaultFormatSettings)}
820	+	with DefaultFormatSettings do
821	+	{$ELSE}
822	+	{$IF declared(FormatSettings)}
823	+	with FormatSettings do
824	+	{$IFEND}
825	+	{$IFEND}
826	+	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
827	+	end;
828	+
829		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
830		begin
831		SetAsLong(aValue);
#	Line 1006 | Line 956 | begin
956		end;
957		end;
958
959	+	function TSQLDataItem.GetStrDataLength: short;
960	+	begin
961	+	with FFirebirdClientAPI do
962	+	if SQLType = SQL_VARYING then
963	+	Result := DecodeInteger(SQLData, 2)
964	+	else
965	+	Result := DataLength;
966	+	end;
967	+
968		function TSQLDataItem.GetAsBoolean: boolean;
969		begin
970		CheckActive;
#	Line 1251 | Line 1210 | begin
1210		Result := rs
1211		end;
1212		SQL_TYPE_DATE:
1213	<	case GetSQLDialect of
1255	<	1 : result := DateTimeToStr(AsDateTime);
1256	<	3 : result := DateToStr(AsDateTime);
1257	<	end;
1213	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1214		SQL_TYPE_TIME :
1215	<	result := TimeToStr(AsDateTime);
1215	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1216		SQL_TIMESTAMP:
1217	<	{$IF declared(DefaultFormatSettings)}
1262	<	with DefaultFormatSettings do
1263	<	{$ELSE}
1264	<	{$IF declared(FormatSettings)}
1265	<	with FormatSettings do
1266	<	{$IFEND}
1267	<	{$IFEND}
1268	<	result := FormatDateTime(ShortDateFormat + ' ' +
1269	<	LongTimeFormat+'.zzz',AsDateTime);
1217	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1218		SQL_SHORT, SQL_LONG:
1219		if Scale = 0 then
1220		result := IntToStr(AsLong)
#	Line 1294 | Line 1242 | begin
1242		Result := false;
1243		end;
1244
1245	<	function TSQLDataItem.getIsNullable: boolean;
1245	>	function TSQLDataItem.GetIsNullable: boolean;
1246		begin
1247		CheckActive;
1248		Result := false;
#	Line 1342 | Line 1290 | begin
1290		Result := false;
1291		end;
1292
1293	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1294	+	): integer;
1295	+	begin
1296	+	case DateTimeFormat of
1297	+	dfTimestamp:
1298	+	Result := Length(GetTimestampFormatStr);
1299	+	dfDateTime:
1300	+	Result := Length(GetDateFormatStr(true));
1301	+	dfTime:
1302	+	Result := Length(GetTimeFormatStr);
1303	+	else
1304	+	Result := 0;
1305	+	end;
1306	+	end;
1307	+
1308
1309		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1310		begin
#	Line 1727 | Line 1690 | begin
1690		result := FIBXSQLVAR.GetBlobMetaData;
1691		end;
1692
1693	+	function TColumnMetaData.GetStatement: IStatement;
1694	+	begin
1695	+	Result := FIBXSQLVAR.GetStatement;
1696	+	end;
1697	+
1698	+	function TColumnMetaData.GetTransaction: ITransaction;
1699	+	begin
1700	+	Result := GetStatement.GetTransaction;
1701	+	end;
1702	+
1703		{ TIBSQLData }
1704
1705		procedure TIBSQLData.CheckActive;
#	Line 1746 | Line 1719 | begin
1719		IBError(ibxeBOF,[nil]);
1720		end;
1721
1722	+	function TIBSQLData.GetTransaction: ITransaction;
1723	+	begin
1724	+	if FTransaction = nil then
1725	+	Result := inherited GetTransaction
1726	+	else
1727	+	Result := FTransaction;
1728	+	end;
1729	+
1730		function TIBSQLData.GetIsNull: Boolean;
1731		begin
1732		CheckActive;
#	Line 1789 | Line 1770 | end;
1770		{ TSQLParam }
1771
1772		procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1773	+
1774	+	procedure DoSetString;
1775	+	begin
1776	+	Changing;
1777	+	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1778	+	Changed;
1779	+	end;
1780	+
1781		var b: IBlob;
1782		dt: TDateTime;
1783	+	CurrValue: Currency;
1784	+	FloatValue: single;
1785		begin
1786		CheckActive;
1787		if IsNullable then
#	Line 1816 | Line 1807 | begin
1807
1808		SQL_VARYING,
1809		SQL_TEXT:
1810	<	begin
1820	<	Changing;
1821	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1822	<	Changed;
1823	<	end;
1810	>	DoSetString;
1811
1812		SQL_SHORT,
1813		SQL_LONG,
1814		SQL_INT64:
1815	<	SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1815	>	if TryStrToCurr(Value,CurrValue) then
1816	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1817	>	else
1818	>	DoSetString;
1819
1820		SQL_D_FLOAT,
1821		SQL_DOUBLE,
1822		SQL_FLOAT:
1823	<	SetAsDouble(StrToFloat(Value));
1823	>	if TryStrToFloat(Value,FloatValue) then
1824	>	SetAsDouble(FloatValue)
1825	>	else
1826	>	DoSetString;
1827
1828		SQL_TIMESTAMP:
1829		if TryStrToDateTime(Value,dt) then
1830		SetAsDateTime(dt)
1831		else
1832	<	FIBXSQLVar.SetString(Value);
1832	>	DoSetString;
1833
1834		SQL_TYPE_DATE:
1835		if TryStrToDateTime(Value,dt) then
1836		SetAsDate(dt)
1837		else
1838	<	FIBXSQLVar.SetString(Value);
1838	>	DoSetString;
1839
1840		SQL_TYPE_TIME:
1841		if TryStrToDateTime(Value,dt) then
1842		SetAsTime(dt)
1843		else
1844	<	FIBXSQLVar.SetString(Value);
1844	>	DoSetString;
1845
1846		else
1847		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 2434 | Line 2427 | begin
2427		end;
2428		end;
2429
2430	+	function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2431	+	begin
2432	+	Result := FSQLParams.CaseSensitiveParams;
2433	+	end;
2434	+
2435		{ TResults }
2436
2437		procedure TResults.CheckActive;
#	Line 2452 | Line 2450 | begin
2450		end;
2451
2452		function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2453	+	var col: TIBSQLData;
2454		begin
2455		if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2456		IBError(ibxeInvalidColumnIndex,[nil]);
2457
2458		if not HasInterface(aIBXSQLVAR.Index) then
2459		AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2460	<	Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2460	>	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2461	>	col.FTransaction := GetTransaction;
2462	>	Result := col;
2463		end;
2464
2465		constructor TResults.Create(aResults: TSQLDataArea);
#	Line 2515 | Line 2516 | begin
2516		FResults.GetData(index,IsNull, len,data);
2517		end;
2518
2519	+	function TResults.GetStatement: IStatement;
2520	+	begin
2521	+	Result := FStatement;
2522	+	end;
2523	+
2524		function TResults.GetTransaction: ITransaction;
2525		begin
2526		Result := FStatement.GetTransaction;

Diff Legend

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