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 59 by tony, Mon Mar 13 09:51:56 2017 UTC vs.
Revision 287 by tony, Thu Apr 11 08:51:23 2019 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	–	{ $define ALLOWDIALECT3PARAMNAMES}
80	–
81	–	{$ifndef ALLOWDIALECT3PARAMNAMES}
82	–
83	–	{ Note on SQL Dialects and SQL Parameter Names
84	–	--------------------------------------------
85	–
86	–	Even when dialect 3 quoted format parameter names are not supported, IBX still processes
87	–	parameter names case insensitive. This does result in some additional overhead
88	–	due to a call to "AnsiUpperCase". This can be avoided by undefining
89	–	"UseCaseInSensitiveParamName" below.
90	–
91	–	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
92	–	is defined. This will not give a useful result.
93	–	}
94	–	{$define UseCaseInSensitiveParamName}
95	–	{$endif}
79
80		interface
81
82		uses
83	<	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
83	>	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
84
85		type
86
#	Line 105 | Line 88 | type
88
89		TSQLDataItem = class(TFBInterfacedObject)
90		private
91	+	FFirebirdClientAPI: TFBClientAPI;
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 128 | Line 115 | type
115		property DataLength: cardinal read GetDataLength write SetDataLength;
116
117		public
118	+	constructor Create(api: TFBClientAPI);
119		function GetSQLType: cardinal; virtual; abstract;
120		function GetSQLTypeName: AnsiString; overload;
121		class function GetSQLTypeName(SQLType: short): AnsiString; overload;
#	Line 145 | Line 133 | type
133		function GetAsShort: short;
134		function GetAsString: AnsiString; virtual;
135		function GetIsNull: Boolean; virtual;
136	<	function getIsNullable: boolean; virtual;
136	>	function GetIsNullable: boolean; virtual;
137		function GetAsVariant: Variant;
138		function GetModified: boolean; virtual;
139	+	function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
140		procedure SetAsBoolean(AValue: boolean); virtual;
141		procedure SetAsCurrency(Value: Currency); virtual;
142		procedure SetAsInt64(Value: Int64); virtual;
#	Line 196 | Line 185 | type
185
186		TSQLDataArea = class
187		private
188	+	FCaseSensitiveParams: boolean;
189		function GetColumn(index: integer): TSQLVarData;
190		function GetCount: integer;
191		protected
#	Line 218 | Line 208 | type
208		var data: PByte); virtual;
209		procedure RowChange;
210		function StateChanged(var ChangeSeqNo: integer): boolean; virtual; abstract;
211	+	property CaseSensitiveParams: boolean read FCaseSensitiveParams
212	+	write FCaseSensitiveParams; {Only used when IsInputDataArea true}
213		property Count: integer read GetCount;
214		property Column[index: integer]: TSQLVarData read GetColumn;
215		property UniqueRelationName: AnsiString read FUniqueRelationName;
#	Line 429 | Line 421 | type
421		function getSQLParam(index: integer): ISQLParam;
422		function ByName(Idx: AnsiString): ISQLParam ;
423		function GetModified: Boolean;
424	+	function GetHasCaseSensitiveParams: Boolean;
425		end;
426
427		{ TResults }
#	Line 456 | Line 449 | type
449
450		implementation
451
452	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
460	<
452	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
453
454		{ TSQLDataArea }
455
#	Line 510 | Line 502 | end;
502
503		procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
504		var sProcessedSQL: AnsiString);
513	–	var
514	–	cCurChar, cNextChar, cQuoteChar: AnsiChar;
515	–	sParamName: AnsiString;
516	–	j, i, iLenSQL, iSQLPos: Integer;
517	–	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
518	–	iParamSuffix: Integer;
519	–	slNames: TStrings;
520	–	StrBuffer: PByte;
521	–	found: boolean;
522	–
523	–	const
524	–	DefaultState = 0;
525	–	CommentState = 1;
526	–	QuoteState = 2;
527	–	ParamState = 3;
528	–	ArrayDimState = 4;
529	–	{$ifdef ALLOWDIALECT3PARAMNAMES}
530	–	ParamDefaultState = 0;
531	–	ParamQuoteState = 1;
532	–	{$endif}
505
506	<	procedure AddToProcessedSQL(cChar: AnsiChar);
535	<	begin
536	<	StrBuffer[iSQLPos] := byte(cChar);
537	<	Inc(iSQLPos);
538	<	end;
539	<
540	<	begin
541	<	if not IsInputDataArea then
542	<	IBError(ibxeNotPermitted,[nil]);
543	<
544	<	sParamName := '';
545	<	iLenSQL := Length(sSQL);
546	<	GetMem(StrBuffer,iLenSQL + 1);
547	<	slNames := TStringList.Create;
548	<	try
549	<	{ Do some initializations of variables }
550	<	iParamSuffix := 0;
551	<	cQuoteChar := '''';
552	<	i := 1;
553	<	iSQLPos := 0;
554	<	iCurState := DefaultState;
555	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
556	<	iCurParamState := ParamDefaultState;
557	<	{$endif}
558	<	{ Now, traverse through the SQL string, character by character,
559	<	picking out the parameters and formatting correctly for InterBase }
560	<	while (i <= iLenSQL) do begin
561	<	{ Get the current token and a look-ahead }
562	<	cCurChar := sSQL[i];
563	<	if i = iLenSQL then
564	<	cNextChar := #0
565	<	else
566	<	cNextChar := sSQL[i + 1];
567	<	{ Now act based on the current state }
568	<	case iCurState of
569	<	DefaultState:
570	<	begin
571	<	case cCurChar of
572	<	'''', '"':
573	<	begin
574	<	cQuoteChar := cCurChar;
575	<	iCurState := QuoteState;
576	<	end;
577	<	'?', ':':
578	<	begin
579	<	iCurState := ParamState;
580	<	AddToProcessedSQL('?');
581	<	end;
582	<	'/': if (cNextChar = '*') then
583	<	begin
584	<	AddToProcessedSQL(cCurChar);
585	<	Inc(i);
586	<	iCurState := CommentState;
587	<	end;
588	<	'[':
589	<	begin
590	<	AddToProcessedSQL(cCurChar);
591	<	Inc(i);
592	<	iCurState := ArrayDimState;
593	<	end;
594	<	end;
595	<	end;
596	<
597	<	ArrayDimState:
598	<	begin
599	<	case cCurChar of
600	<	':',',','0'..'9',' ',#9,#10,#13:
601	<	begin
602	<	AddToProcessedSQL(cCurChar);
603	<	Inc(i);
604	<	end;
605	<	else
606	<	begin
607	<	AddToProcessedSQL(cCurChar);
608	<	Inc(i);
609	<	iCurState := DefaultState;
610	<	end;
611	<	end;
612	<	end;
506	>	var slNames: TStrings;
507
508	<	CommentState:
509	<	begin
510	<	if (cNextChar = #0) then
511	<	IBError(ibxeSQLParseError, [SEOFInComment])
512	<	else if (cCurChar = '*') then begin
619	<	if (cNextChar = '/') then
620	<	iCurState := DefaultState;
621	<	end;
622	<	end;
623	<	QuoteState: begin
624	<	if cNextChar = #0 then
625	<	IBError(ibxeSQLParseError, [SEOFInString])
626	<	else if (cCurChar = cQuoteChar) then begin
627	<	if (cNextChar = cQuoteChar) then begin
628	<	AddToProcessedSQL(cCurChar);
629	<	Inc(i);
630	<	end else
631	<	iCurState := DefaultState;
632	<	end;
633	<	end;
634	<	ParamState:
635	<	begin
636	<	{ collect the name of the parameter }
637	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
638	<	if iCurParamState = ParamDefaultState then
639	<	begin
640	<	if cCurChar = '"' then
641	<	iCurParamState := ParamQuoteState
642	<	else
643	<	{$endif}
644	<	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
645	<	sParamName := sParamName + cCurChar
646	<	else if GenerateParamNames then
647	<	begin
648	<	sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
649	<	Inc(iParamSuffix);
650	<	iCurState := DefaultState;
651	<	slNames.AddObject(sParamName,self); //Note local convention
652	<	//add pointer to self to mark entry
653	<	sParamName := '';
654	<	end
655	<	else
656	<	IBError(ibxeSQLParseError, [SParamNameExpected]);
657	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
658	<	end
659	<	else begin
660	<	{ determine if Quoted parameter name is finished }
661	<	if cCurChar = '"' then
662	<	begin
663	<	Inc(i);
664	<	slNames.Add(sParamName);
665	<	SParamName := '';
666	<	iCurParamState := ParamDefaultState;
667	<	iCurState := DefaultState;
668	<	end
669	<	else
670	<	sParamName := sParamName + cCurChar
671	<	end;
672	<	{$endif}
673	<	{ determine if the unquoted parameter name is finished }
674	<	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
675	<	(iCurState <> DefaultState) then
676	<	begin
677	<	if not (cNextChar in ['A'..'Z', 'a'..'z',
678	<	'0'..'9', '_', '$']) then begin
679	<	Inc(i);
680	<	iCurState := DefaultState;
681	<	slNames.Add(sParamName);
682	<	sParamName := '';
683	<	end;
684	<	end;
685	<	end;
686	<	end;
687	<	if (iCurState <> ParamState) and (i <= iLenSQL) then
688	<	AddToProcessedSQL(sSQL[i]);
689	<	Inc(i);
690	<	end;
691	<	AddToProcessedSQL(#0);
692	<	sProcessedSQL := strpas(PAnsiChar(StrBuffer));
508	>	procedure SetColumnNames(slNames: TStrings);
509	>	var i, j: integer;
510	>	found: boolean;
511	>	begin
512	>	found := false;
513		SetCount(slNames.Count);
514		for i := 0 to slNames.Count - 1 do
515		begin
#	Line 710 | Line 530 | begin
530		Column[i].UniqueName := not found;
531		end;
532		end;
533	+	end;
534	+
535	+	begin
536	+	if not IsInputDataArea then
537	+	IBError(ibxeNotPermitted,[nil]);
538	+
539	+	slNames := TStringList.Create;
540	+	try
541	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
542	+	SetColumnNames(slNames);
543		finally
544		slNames.Free;
715	–	FreeMem(StrBuffer);
545		end;
546		end;
547
#	Line 726 | Line 555 | var
555		s: AnsiString;
556		i: Integer;
557		begin
558	<	{$ifdef UseCaseInSensitiveParamName}
559	<	s := AnsiUpperCase(Idx);
560	<	{$else}
558	>	if not IsInputDataArea or not CaseSensitiveParams then
559	>	s := AnsiUpperCase(Idx)
560	>	else
561		s := Idx;
562	<	{$endif}
562	>
563		for i := 0 to Count - 1 do
564		if Column[i].Name = s then
565		begin
#	Line 762 | Line 591 | end;
591
592		procedure TSQLVarData.SetName(AValue: AnsiString);
593		begin
594	<	if FName = AValue then Exit;
766	<	{$ifdef UseCaseInSensitiveParamName}
767	<	if Parent.IsInputDataArea then
594	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
595		FName := AnsiUpperCase(AValue)
596		else
770	–	{$endif}
597		FName := AValue;
598		end;
599
#	Line 788 | Line 614 | begin
614
615		FVarString := aValue;
616		SQLType := SQL_TEXT;
617	+	Scale := 0;
618		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
619		end;
620
#	Line 948 | Line 775 | begin
775		result := Value;
776		end;
777
778	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
779	+	begin
780	+	{$IF declared(DefaultFormatSettings)}
781	+	with DefaultFormatSettings do
782	+	{$ELSE}
783	+	{$IF declared(FormatSettings)}
784	+	with FormatSettings do
785	+	{$IFEND}
786	+	{$IFEND}
787	+	case GetSQLDialect of
788	+	1:
789	+	if IncludeTime then
790	+	result := ShortDateFormat + ' ' + LongTimeFormat
791	+	else
792	+	result := ShortDateFormat;
793	+	3:
794	+	result := ShortDateFormat;
795	+	end;
796	+	end;
797	+
798	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
799	+	begin
800	+	{$IF declared(DefaultFormatSettings)}
801	+	with DefaultFormatSettings do
802	+	{$ELSE}
803	+	{$IF declared(FormatSettings)}
804	+	with FormatSettings do
805	+	{$IFEND}
806	+	{$IFEND}
807	+	Result := LongTimeFormat;
808	+	end;
809	+
810	+	function TSQLDataItem.GetTimestampFormatStr: AnsiString;
811	+	begin
812	+	{$IF declared(DefaultFormatSettings)}
813	+	with DefaultFormatSettings do
814	+	{$ELSE}
815	+	{$IF declared(FormatSettings)}
816	+	with FormatSettings do
817	+	{$IFEND}
818	+	{$IFEND}
819	+	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
820	+	end;
821	+
822		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
823		begin
824		SetAsLong(aValue);
#	Line 1046 | Line 917 | begin
917		//Do nothing by default
918		end;
919
920	+	constructor TSQLDataItem.Create(api: TFBClientAPI);
921	+	begin
922	+	inherited Create;
923	+	FFirebirdClientAPI := api;
924	+	end;
925	+
926		function TSQLDataItem.GetSQLTypeName: AnsiString;
927		begin
928		Result := GetSQLTypeName(GetSQLType);
#	Line 1152 | Line 1029 | begin
1029		CheckActive;
1030		result := 0;
1031		if not IsNull then
1032	<	with FirebirdClientAPI do
1032	>	with FFirebirdClientAPI do
1033		case SQLType of
1034		SQL_TEXT, SQL_VARYING: begin
1035		try
#	Line 1292 | Line 1169 | begin
1169		result := '';
1170		{ Check null, if so return a default string }
1171		if not IsNull then
1172	<	with FirebirdClientAPI do
1172	>	with FFirebirdClientAPI do
1173		case SQLType of
1174		SQL_BOOLEAN:
1175		if AsBoolean then
#	Line 1317 | Line 1194 | begin
1194		Result := rs
1195		end;
1196		SQL_TYPE_DATE:
1197	<	case GetSQLDialect of
1321	<	1 : result := DateTimeToStr(AsDateTime);
1322	<	3 : result := DateToStr(AsDateTime);
1323	<	end;
1197	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1198		SQL_TYPE_TIME :
1199	<	result := TimeToStr(AsDateTime);
1199	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1200		SQL_TIMESTAMP:
1201	<	{$IF declared(DefaultFormatSettings)}
1328	<	with DefaultFormatSettings do
1329	<	{$ELSE}
1330	<	{$IF declared(FormatSettings)}
1331	<	with FormatSettings do
1332	<	{$IFEND}
1333	<	{$IFEND}
1334	<	result := FormatDateTime(ShortDateFormat + ' ' +
1335	<	LongTimeFormat+'.zzz',AsDateTime);
1201	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1202		SQL_SHORT, SQL_LONG:
1203		if Scale = 0 then
1204		result := IntToStr(AsLong)
#	Line 1360 | Line 1226 | begin
1226		Result := false;
1227		end;
1228
1229	<	function TSQLDataItem.getIsNullable: boolean;
1229	>	function TSQLDataItem.GetIsNullable: boolean;
1230		begin
1231		CheckActive;
1232		Result := false;
#	Line 1408 | Line 1274 | begin
1274		Result := false;
1275		end;
1276
1277	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1278	+	): integer;
1279	+	begin
1280	+	case DateTimeFormat of
1281	+	dfTimestamp:
1282	+	Result := Length(GetTimestampFormatStr);
1283	+	dfDateTime:
1284	+	Result := Length(GetDateFormatStr(true));
1285	+	dfTime:
1286	+	Result := Length(GetTimeFormatStr);
1287	+	else
1288	+	Result := 0;
1289	+	end;
1290	+	end;
1291	+
1292
1293		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1294		begin
#	Line 1471 | Line 1352 | begin
1352
1353		SQLType := SQL_TYPE_DATE;
1354		DataLength := SizeOf(ISC_DATE);
1355	<	with FirebirdClientAPI do
1355	>	with FFirebirdClientAPI do
1356		SQLEncodeDate(Value,SQLData);
1357		Changed;
1358		end;
#	Line 1491 | Line 1372 | begin
1372
1373		SQLType := SQL_TYPE_TIME;
1374		DataLength := SizeOf(ISC_TIME);
1375	<	with FirebirdClientAPI do
1375	>	with FFirebirdClientAPI do
1376		SQLEncodeTime(Value,SQLData);
1377		Changed;
1378		end;
#	Line 1505 | Line 1386 | begin
1386		Changing;
1387		SQLType := SQL_TIMESTAMP;
1388		DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1389	<	with FirebirdClientAPI do
1389	>	with FFirebirdClientAPI do
1390		SQLEncodeDateTime(Value,SQLData);
1391		Changed;
1392		end;
#	Line 1691 | Line 1572 | end;
1572
1573		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1574		begin
1575	<	inherited Create;
1575	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1576		FIBXSQLVAR := aIBXSQLVAR;
1577		FOwner := aOwner;
1578		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1855 | Line 1736 | end;
1736		{ TSQLParam }
1737
1738		procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1739	+
1740	+	procedure DoSetString;
1741	+	begin
1742	+	Changing;
1743	+	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1744	+	Changed;
1745	+	end;
1746	+
1747		var b: IBlob;
1748		dt: TDateTime;
1749	+	CurrValue: Currency;
1750	+	FloatValue: single;
1751		begin
1752		CheckActive;
1753		if IsNullable then
#	Line 1882 | Line 1773 | begin
1773
1774		SQL_VARYING,
1775		SQL_TEXT:
1776	<	begin
1886	<	Changing;
1887	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1888	<	Changed;
1889	<	end;
1776	>	DoSetString;
1777
1778		SQL_SHORT,
1779		SQL_LONG,
1780		SQL_INT64:
1781	<	SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1781	>	if TryStrToCurr(Value,CurrValue) then
1782	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1783	>	else
1784	>	DoSetString;
1785
1786		SQL_D_FLOAT,
1787		SQL_DOUBLE,
1788		SQL_FLOAT:
1789	<	SetAsDouble(StrToFloat(Value));
1789	>	if TryStrToFloat(Value,FloatValue) then
1790	>	SetAsDouble(FloatValue)
1791	>	else
1792	>	DoSetString;
1793
1794		SQL_TIMESTAMP:
1795		if TryStrToDateTime(Value,dt) then
1796		SetAsDateTime(dt)
1797		else
1798	<	FIBXSQLVar.SetString(Value);
1798	>	DoSetString;
1799
1800		SQL_TYPE_DATE:
1801		if TryStrToDateTime(Value,dt) then
1802		SetAsDate(dt)
1803		else
1804	<	FIBXSQLVar.SetString(Value);
1804	>	DoSetString;
1805
1806		SQL_TYPE_TIME:
1807		if TryStrToDateTime(Value,dt) then
1808		SetAsTime(dt)
1809		else
1810	<	FIBXSQLVar.SetString(Value);
1810	>	DoSetString;
1811
1812		else
1813		IBError(ibxeInvalidDataConversion,[nil]);
#	Line 2500 | Line 2393 | begin
2393		end;
2394		end;
2395
2396	+	function TSQLParams.GetHasCaseSensitiveParams: Boolean;
2397	+	begin
2398	+	Result := FSQLParams.CaseSensitiveParams;
2399	+	end;
2400	+
2401		{ TResults }
2402
2403		procedure TResults.CheckActive;

Diff Legend

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