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 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 308 by tony, Sat Jul 18 10:26:30 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
82		uses
83	<	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
83	>	Classes, SysUtils, IBExternals, IBHeader, {$IFDEF WINDOWS} Windows, {$ENDIF} IB,  FBActivityMonitor, FBClientAPI;
84
85		type
86
#	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	+	function GetSize: cardinal; virtual; abstract;
142		procedure SetAsBoolean(AValue: boolean); virtual;
143		procedure SetAsCurrency(Value: Currency); virtual;
144		procedure SetAsInt64(Value: Int64); virtual;
#	Line 190 | Line 187 | type
187
188		TSQLDataArea = class
189		private
190	+	FCaseSensitiveParams: boolean;
191		function GetColumn(index: integer): TSQLVarData;
192		function GetCount: integer;
193		protected
#	Line 212 | Line 210 | type
210		var data: PByte); virtual;
211		procedure RowChange;
212		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
213	+	property CaseSensitiveParams: boolean read FCaseSensitiveParams
214	+	write FCaseSensitiveParams; {Only used when IsInputDataArea true}
215		property Count: integer read GetCount;
216		property Column[index: integer]: TSQLVarData read GetColumn;
217		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 294 | Line 294 | type
294		FIBXSQLVAR: TSQLVarData;
295		FOwner: IUnknown;         {Keep reference to ensure Metadata/statement not discarded}
296		FPrepareSeqNo: integer;
297	–	FStatement: IStatement;
297		FChangeSeqNo: integer;
298		protected
299		procedure CheckActive; override;
#	Line 306 | Line 305 | type
305		constructor Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
306		destructor Destroy; override;
307		function GetSQLDialect: integer; override;
309	–	property Statement: IStatement read FStatement;
308
309		public
310		{IColumnMetaData}
#	Line 321 | Line 319 | type
319		function GetScale: integer; override;
320		function getCharSetID: cardinal; override;
321		function GetIsNullable: boolean; override;
322	<	function GetSize: cardinal;
322	>	function GetSize: cardinal; override;
323		function GetArrayMetaData: IArrayMetaData;
324		function GetBlobMetaData: IBlobMetaData;
325	+	function GetStatement: IStatement;
326	+	function GetTransaction: ITransaction; virtual;
327		property Name: AnsiString read GetName;
328		property Size: cardinal read GetSize;
329		property CharSetID: cardinal read getCharSetID;
330		property SQLSubtype: integer read getSubtype;
331		property IsNullable: Boolean read GetIsNullable;
332	+	public
333	+	property Statement: IStatement read GetStatement;
334		end;
335
336		{ TIBSQLData }
337
338		TIBSQLData = class(TColumnMetaData,ISQLData)
339	+	private
340	+	FTransaction: ITransaction;
341		protected
342		procedure CheckActive; override;
343		public
344	+	function GetTransaction: ITransaction; override;
345		function GetIsNull: Boolean; override;
346		function GetAsArray: IArray;
347		function GetAsBlob: IBlob; overload;
#	Line 423 | Line 428 | type
428		function getSQLParam(index: integer): ISQLParam;
429		function ByName(Idx: AnsiString): ISQLParam ;
430		function GetModified: Boolean;
431	+	function GetHasCaseSensitiveParams: Boolean;
432		end;
433
434		{ TResults }
#	Line 444 | Line 450 | type
450		function ByName(Idx: AnsiString): ISQLData;
451		function getSQLData(index: integer): ISQLData;
452		procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
453	+	function GetStatement: IStatement;
454		function GetTransaction: ITransaction; virtual;
455		procedure SetRetainInterfaces(aValue: boolean);
456		end;
457
458		implementation
459
460	<	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	<
460	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
461
462		{ TSQLDataArea }
463
#	Line 654 | Line 563 | var
563		s: AnsiString;
564		i: Integer;
565		begin
566	<	{$ifdef UseCaseInSensitiveParamName}
567	<	s := AnsiUpperCase(Idx);
568	<	{$else}
566	>	if not IsInputDataArea or not CaseSensitiveParams then
567	>	s := AnsiUpperCase(Idx)
568	>	else
569		s := Idx;
570	<	{$endif}
570	>
571		for i := 0 to Count - 1 do
572		if Column[i].Name = s then
573		begin
#	Line 690 | Line 599 | end;
599
600		procedure TSQLVarData.SetName(AValue: AnsiString);
601		begin
602	<	if FName = AValue then Exit;
694	<	{$ifdef UseCaseInSensitiveParamName}
695	<	if Parent.IsInputDataArea then
602	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
603		FName := AnsiUpperCase(AValue)
604		else
698	–	{$endif}
605		FName := AValue;
606		end;
607
#	Line 716 | Line 622 | begin
622
623		FVarString := aValue;
624		SQLType := SQL_TEXT;
625	+	Scale := 0;
626		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
627		end;
628
#	Line 876 | Line 783 | begin
783		result := Value;
784		end;
785
786	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
787	+	begin
788	+	{$IF declared(DefaultFormatSettings)}
789	+	with DefaultFormatSettings do
790	+	{$ELSE}
791	+	{$IF declared(FormatSettings)}
792	+	with FormatSettings do
793	+	{$IFEND}
794	+	{$IFEND}
795	+	case GetSQLDialect of
796	+	1:
797	+	if IncludeTime then
798	+	result := ShortDateFormat + ' ' + LongTimeFormat
799	+	else
800	+	result := ShortDateFormat;
801	+	3:
802	+	result := ShortDateFormat;
803	+	end;
804	+	end;
805	+
806	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
807	+	begin
808	+	{$IF declared(DefaultFormatSettings)}
809	+	with DefaultFormatSettings do
810	+	{$ELSE}
811	+	{$IF declared(FormatSettings)}
812	+	with FormatSettings do
813	+	{$IFEND}
814	+	{$IFEND}
815	+	Result := LongTimeFormat;
816	+	end;
817	+
818	+	function TSQLDataItem.GetTimestampFormatStr: AnsiString;
819	+	begin
820	+	{$IF declared(DefaultFormatSettings)}
821	+	with DefaultFormatSettings do
822	+	{$ELSE}
823	+	{$IF declared(FormatSettings)}
824	+	with FormatSettings do
825	+	{$IFEND}
826	+	{$IFEND}
827	+	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
828	+	end;
829	+
830		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
831		begin
832		SetAsLong(aValue);
#	Line 1006 | Line 957 | begin
957		end;
958		end;
959
960	+	function TSQLDataItem.GetStrDataLength: short;
961	+	begin
962	+	with FFirebirdClientAPI do
963	+	if SQLType = SQL_VARYING then
964	+	Result := DecodeInteger(SQLData, 2)
965	+	else
966	+	Result := DataLength;
967	+	end;
968	+
969		function TSQLDataItem.GetAsBoolean: boolean;
970		begin
971		CheckActive;
#	Line 1215 | Line 1175 | begin
1175		end;
1176		end;
1177
1178	+	{Copied from LazUTF8}
1179	+
1180	+	function UTF8CodepointSizeFull(p: PAnsiChar): integer;
1181	+	const TopBitSetMask   = $8000; {%10000000}
1182	+	Top2BitsSetMask = $C000; {%11000000}
1183	+	Top3BitsSetMask = $E000; {%11100000}
1184	+	Top4BitsSetMask = $F000; {%11110000}
1185	+	Top5BitsSetMask = $F800; {%11111000}
1186	+	begin
1187	+	case p^ of
1188	+	#0..#191: // %11000000
1189	+	// regular single byte character (#0 is a character, this is Pascal ;)
1190	+	Result:=1;
1191	+	#192..#223: // p^ and %11100000 = %11000000
1192	+	begin
1193	+	// could be 2 byte character
1194	+	if (ord(p[1]) and Top2BitsSetMask) = TopBitSetMask then
1195	+	Result:=2
1196	+	else
1197	+	Result:=1;
1198	+	end;
1199	+	#224..#239: // p^ and %11110000 = %11100000
1200	+	begin
1201	+	// could be 3 byte character
1202	+	if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1203	+	and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask) then
1204	+	Result:=3
1205	+	else
1206	+	Result:=1;
1207	+	end;
1208	+	#240..#247: // p^ and %11111000 = %11110000
1209	+	begin
1210	+	// could be 4 byte character
1211	+	if ((ord(p[1]) and Top2BitsSetMask) = TopBitSetMask)
1212	+	and ((ord(p[2]) and Top2BitsSetMask) = TopBitSetMask)
1213	+	and ((ord(p[3]) and Top2BitsSetMask) = TopBitSetMask) then
1214	+	Result:=4
1215	+	else
1216	+	Result:=1;
1217	+	end;
1218	+	else
1219	+	Result:=1;
1220	+	end;
1221	+	end;
1222	+
1223	+	{Returns the byte length of a UTF8 string with a fixed charwidth}
1224	+
1225	+	function GetStrLen(p: PAnsiChar; CharWidth, MaxDataLength: cardinal): integer;
1226	+	var i: integer;
1227	+	cplen: integer;
1228	+	begin
1229	+	Result := 0;
1230	+	for i := 1 to CharWidth do
1231	+	begin
1232	+	cplen := UTF8CodepointSizeFull(p);
1233	+	Inc(p,cplen);
1234	+	Inc(Result,cplen);
1235	+	if Result >= MaxDataLength then
1236	+	begin
1237	+	Result := MaxDataLength;
1238	+	Exit;
1239	+	end;
1240	+	end;
1241	+	end;
1242
1243		function TSQLDataItem.GetAsString: AnsiString;
1244		var
#	Line 1238 | Line 1262 | begin
1262		begin
1263		sz := SQLData;
1264		if (SQLType = SQL_TEXT) then
1265	<	str_len := DataLength
1265	>	begin
1266	>	if GetCodePage = cp_utf8 then
1267	>	str_len := GetStrLen(PAnsiChar(sz),GetSize,DataLength)
1268	>	else
1269	>	str_len := DataLength
1270	>	end
1271		else begin
1272	<	str_len := DecodeInteger(SQLData, 2);
1272	>	str_len := DecodeInteger(sz, 2);
1273		Inc(sz, 2);
1274		end;
1275		SetString(rs, PAnsiChar(sz), str_len);
1276		SetCodePage(rs,GetCodePage,false);
1277	<	if (SQLType = SQL_TEXT) and (GetCharSetID <> 1) then
1249	<	Result := TrimRight(rs)
1250	<	else
1251	<	Result := rs
1277	>	Result := rs;
1278		end;
1279		SQL_TYPE_DATE:
1280	<	case GetSQLDialect of
1255	<	1 : result := DateTimeToStr(AsDateTime);
1256	<	3 : result := DateToStr(AsDateTime);
1257	<	end;
1280	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1281		SQL_TYPE_TIME :
1282	<	result := TimeToStr(AsDateTime);
1282	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1283		SQL_TIMESTAMP:
1284	<	{$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);
1284	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1285		SQL_SHORT, SQL_LONG:
1286		if Scale = 0 then
1287		result := IntToStr(AsLong)
#	Line 1294 | Line 1309 | begin
1309		Result := false;
1310		end;
1311
1312	<	function TSQLDataItem.getIsNullable: boolean;
1312	>	function TSQLDataItem.GetIsNullable: boolean;
1313		begin
1314		CheckActive;
1315		Result := false;
#	Line 1342 | Line 1357 | begin
1357		Result := false;
1358		end;
1359
1360	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1361	+	): integer;
1362	+	begin
1363	+	case DateTimeFormat of
1364	+	dfTimestamp:
1365	+	Result := Length(GetTimestampFormatStr);
1366	+	dfDateTime:
1367	+	Result := Length(GetDateFormatStr(true));
1368	+	dfTime:
1369	+	Result := Length(GetTimeFormatStr);
1370	+	else
1371	+	Result := 0;
1372	+	end;
1373	+	end;
1374	+
1375
1376		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1377		begin
#	Line 1727 | Line 1757 | begin
1757		result := FIBXSQLVAR.GetBlobMetaData;
1758		end;
1759
1760	+	function TColumnMetaData.GetStatement: IStatement;
1761	+	begin
1762	+	Result := FIBXSQLVAR.GetStatement;
1763	+	end;
1764	+
1765	+	function TColumnMetaData.GetTransaction: ITransaction;
1766	+	begin
1767	+	Result := GetStatement.GetTransaction;
1768	+	end;
1769	+
1770		{ TIBSQLData }
1771
1772		procedure TIBSQLData.CheckActive;
#	Line 1746 | Line 1786 | begin
1786		IBError(ibxeBOF,[nil]);
1787		end;
1788
1789	+	function TIBSQLData.GetTransaction: ITransaction;
1790	+	begin
1791	+	if FTransaction = nil then
1792	+	Result := inherited GetTransaction
1793	+	else
1794	+	Result := FTransaction;
1795	+	end;
1796	+
1797		function TIBSQLData.GetIsNull: Boolean;
1798		begin
1799		CheckActive;
#	Line 1789 | Line 1837 | end;
1837		{ TSQLParam }
1838
1839		procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1840	+
1841	+	procedure DoSetString;
1842	+	begin
1843	+	Changing;
1844	+	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1845	+	Changed;
1846	+	end;
1847	+
1848		var b: IBlob;
1849		dt: TDateTime;
1850	+	CurrValue: Currency;
1851	+	FloatValue: single;
1852		begin
1853		CheckActive;
1854		if IsNullable then
#	Line 1816 | Line 1874 | begin
1874
1875		SQL_VARYING,
1876		SQL_TEXT:
1877	<	begin
1820	<	Changing;
1821	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1822	<	Changed;
1823	<	end;
1877	>	DoSetString;
1878
1879		SQL_SHORT,
1880		SQL_LONG,
1881		SQL_INT64:
1882	<	SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1882	>	if TryStrToCurr(Value,CurrValue) then
1883	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1884	>	else
1885	>	DoSetString;
1886
1887		SQL_D_FLOAT,
1888		SQL_DOUBLE,
1889		SQL_FLOAT:
1890	<	SetAsDouble(StrToFloat(Value));
1890	>	if TryStrToFloat(Value,FloatValue) then
1891	>	SetAsDouble(FloatValue)
1892	>	else
1893	>	DoSetString;
1894
1895		SQL_TIMESTAMP:
1896		if TryStrToDateTime(Value,dt) then
1897		SetAsDateTime(dt)
1898		else
1899	<	FIBXSQLVar.SetString(Value);
1899	>	DoSetString;
1900
1901		SQL_TYPE_DATE:
1902		if TryStrToDateTime(Value,dt) then
1903		SetAsDate(dt)
1904		else
1905	<	FIBXSQLVar.SetString(Value);
1905	>	DoSetString;
1906
1907		SQL_TYPE_TIME:
1908		if TryStrToDateTime(Value,dt) then
1909		SetAsTime(dt)
1910		else
1911	<	FIBXSQLVar.SetString(Value);
1911	>	DoSetString;
1912
1913		else
1914		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 2434 | Line 2494 | begin
2494		end;
2495		end;
2496
2497	+	function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2498	+	begin
2499	+	Result := FSQLParams.CaseSensitiveParams;
2500	+	end;
2501	+
2502		{ TResults }
2503
2504		procedure TResults.CheckActive;
#	Line 2452 | Line 2517 | begin
2517		end;
2518
2519		function TResults.GetISQLData(aIBXSQLVAR: TSQLVarData): ISQLData;
2520	+	var col: TIBSQLData;
2521		begin
2522		if (aIBXSQLVAR.Index < 0) or (aIBXSQLVAR.Index >= getCount) then
2523		IBError(ibxeInvalidColumnIndex,[nil]);
2524
2525		if not HasInterface(aIBXSQLVAR.Index) then
2526		AddInterface(aIBXSQLVAR.Index, TIBSQLData.Create(self,aIBXSQLVAR));
2527	<	Result := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2527	>	col := TIBSQLData(GetInterface(aIBXSQLVAR.Index));
2528	>	col.FTransaction := GetTransaction;
2529	>	Result := col;
2530		end;
2531
2532		constructor TResults.Create(aResults: TSQLDataArea);
#	Line 2515 | Line 2583 | begin
2583		FResults.GetData(index,IsNull, len,data);
2584		end;
2585
2586	+	function TResults.GetStatement: IStatement;
2587	+	begin
2588	+	Result := FStatement;
2589	+	end;
2590	+
2591		function TResults.GetTransaction: ITransaction;
2592		begin
2593		Result := FStatement.GetTransaction;

Diff Legend

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