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 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 270 by tony, Fri Jan 18 11:10:37 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 162 | Line 151 | type
151		procedure SetAsShort(Value: short); virtual;
152		procedure SetAsString(Value: AnsiString); virtual;
153		procedure SetAsVariant(Value: Variant);
154	+	procedure SetAsNumeric(Value: Int64; aScale: integer);
155		procedure SetIsNull(Value: Boolean); virtual;
156		procedure SetIsNullable(Value: Boolean); virtual;
157		procedure SetName(aValue: AnsiString); virtual;
#	Line 195 | 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 217 | 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 455 | Line 448 | type
448
449		implementation
450
451	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
459	<
451	>	uses FBMessages, variants, IBUtils, FBTransaction, DateUtils;
452
453		{ TSQLDataArea }
454
#	Line 509 | Line 501 | end;
501
502		procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
503		var sProcessedSQL: AnsiString);
512	–	var
513	–	cCurChar, cNextChar, cQuoteChar: AnsiChar;
514	–	sParamName: AnsiString;
515	–	j, i, iLenSQL, iSQLPos: Integer;
516	–	iCurState {$ifdef ALLOWDIALECT3PARAMNAMES}, iCurParamState {$endif}: Integer;
517	–	iParamSuffix: Integer;
518	–	slNames: TStrings;
519	–	StrBuffer: PByte;
520	–	found: boolean;
521	–
522	–	const
523	–	DefaultState = 0;
524	–	CommentState = 1;
525	–	QuoteState = 2;
526	–	ParamState = 3;
527	–	ArrayDimState = 4;
528	–	{$ifdef ALLOWDIALECT3PARAMNAMES}
529	–	ParamDefaultState = 0;
530	–	ParamQuoteState = 1;
531	–	{$endif}
532	–
533	–	procedure AddToProcessedSQL(cChar: AnsiChar);
534	–	begin
535	–	StrBuffer[iSQLPos] := byte(cChar);
536	–	Inc(iSQLPos);
537	–	end;
538	–
539	–	begin
540	–	if not IsInputDataArea then
541	–	IBError(ibxeNotPermitted,[nil]);
504
505	<	sParamName := '';
544	<	iLenSQL := Length(sSQL);
545	<	GetMem(StrBuffer,iLenSQL + 1);
546	<	slNames := TStringList.Create;
547	<	try
548	<	{ Do some initializations of variables }
549	<	iParamSuffix := 0;
550	<	cQuoteChar := '''';
551	<	i := 1;
552	<	iSQLPos := 0;
553	<	iCurState := DefaultState;
554	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
555	<	iCurParamState := ParamDefaultState;
556	<	{$endif}
557	<	{ Now, traverse through the SQL string, character by character,
558	<	picking out the parameters and formatting correctly for InterBase }
559	<	while (i <= iLenSQL) do begin
560	<	{ Get the current token and a look-ahead }
561	<	cCurChar := sSQL[i];
562	<	if i = iLenSQL then
563	<	cNextChar := #0
564	<	else
565	<	cNextChar := sSQL[i + 1];
566	<	{ Now act based on the current state }
567	<	case iCurState of
568	<	DefaultState:
569	<	begin
570	<	case cCurChar of
571	<	'''', '"':
572	<	begin
573	<	cQuoteChar := cCurChar;
574	<	iCurState := QuoteState;
575	<	end;
576	<	'?', ':':
577	<	begin
578	<	iCurState := ParamState;
579	<	AddToProcessedSQL('?');
580	<	end;
581	<	'/': if (cNextChar = '*') then
582	<	begin
583	<	AddToProcessedSQL(cCurChar);
584	<	Inc(i);
585	<	iCurState := CommentState;
586	<	end;
587	<	'[':
588	<	begin
589	<	AddToProcessedSQL(cCurChar);
590	<	Inc(i);
591	<	iCurState := ArrayDimState;
592	<	end;
593	<	end;
594	<	end;
595	<
596	<	ArrayDimState:
597	<	begin
598	<	case cCurChar of
599	<	':',',','0'..'9',' ',#9,#10,#13:
600	<	begin
601	<	AddToProcessedSQL(cCurChar);
602	<	Inc(i);
603	<	end;
604	<	else
605	<	begin
606	<	AddToProcessedSQL(cCurChar);
607	<	Inc(i);
608	<	iCurState := DefaultState;
609	<	end;
610	<	end;
611	<	end;
505	>	var slNames: TStrings;
506
507	<	CommentState:
508	<	begin
509	<	if (cNextChar = #0) then
510	<	IBError(ibxeSQLParseError, [SEOFInComment])
511	<	else if (cCurChar = '*') then begin
618	<	if (cNextChar = '/') then
619	<	iCurState := DefaultState;
620	<	end;
621	<	end;
622	<	QuoteState: begin
623	<	if cNextChar = #0 then
624	<	IBError(ibxeSQLParseError, [SEOFInString])
625	<	else if (cCurChar = cQuoteChar) then begin
626	<	if (cNextChar = cQuoteChar) then begin
627	<	AddToProcessedSQL(cCurChar);
628	<	Inc(i);
629	<	end else
630	<	iCurState := DefaultState;
631	<	end;
632	<	end;
633	<	ParamState:
634	<	begin
635	<	{ collect the name of the parameter }
636	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
637	<	if iCurParamState = ParamDefaultState then
638	<	begin
639	<	if cCurChar = '"' then
640	<	iCurParamState := ParamQuoteState
641	<	else
642	<	{$endif}
643	<	if (cCurChar in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$']) then
644	<	sParamName := sParamName + cCurChar
645	<	else if GenerateParamNames then
646	<	begin
647	<	sParamName := 'IBXParam' + IntToStr(iParamSuffix); {do not localize}
648	<	Inc(iParamSuffix);
649	<	iCurState := DefaultState;
650	<	slNames.AddObject(sParamName,self); //Note local convention
651	<	//add pointer to self to mark entry
652	<	sParamName := '';
653	<	end
654	<	else
655	<	IBError(ibxeSQLParseError, [SParamNameExpected]);
656	<	{$ifdef ALLOWDIALECT3PARAMNAMES}
657	<	end
658	<	else begin
659	<	{ determine if Quoted parameter name is finished }
660	<	if cCurChar = '"' then
661	<	begin
662	<	Inc(i);
663	<	slNames.Add(sParamName);
664	<	SParamName := '';
665	<	iCurParamState := ParamDefaultState;
666	<	iCurState := DefaultState;
667	<	end
668	<	else
669	<	sParamName := sParamName + cCurChar
670	<	end;
671	<	{$endif}
672	<	{ determine if the unquoted parameter name is finished }
673	<	if {$ifdef ALLOWDIALECT3PARAMNAMES}(iCurParamState <> ParamQuoteState) and {$endif}
674	<	(iCurState <> DefaultState) then
675	<	begin
676	<	if not (cNextChar in ['A'..'Z', 'a'..'z',
677	<	'0'..'9', '_', '$']) then begin
678	<	Inc(i);
679	<	iCurState := DefaultState;
680	<	slNames.Add(sParamName);
681	<	sParamName := '';
682	<	end;
683	<	end;
684	<	end;
685	<	end;
686	<	if (iCurState <> ParamState) and (i <= iLenSQL) then
687	<	AddToProcessedSQL(sSQL[i]);
688	<	Inc(i);
689	<	end;
690	<	AddToProcessedSQL(#0);
691	<	sProcessedSQL := strpas(PAnsiChar(StrBuffer));
507	>	procedure SetColumnNames(slNames: TStrings);
508	>	var i, j: integer;
509	>	found: boolean;
510	>	begin
511	>	found := false;
512		SetCount(slNames.Count);
513		for i := 0 to slNames.Count - 1 do
514		begin
#	Line 709 | Line 529 | begin
529		Column[i].UniqueName := not found;
530		end;
531		end;
532	+	end;
533	+
534	+	begin
535	+	if not IsInputDataArea then
536	+	IBError(ibxeNotPermitted,[nil]);
537	+
538	+	slNames := TStringList.Create;
539	+	try
540	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
541	+	SetColumnNames(slNames);
542		finally
543		slNames.Free;
714	–	FreeMem(StrBuffer);
544		end;
545		end;
546
#	Line 725 | Line 554 | var
554		s: AnsiString;
555		i: Integer;
556		begin
557	<	{$ifdef UseCaseInSensitiveParamName}
558	<	s := AnsiUpperCase(Idx);
559	<	{$else}
557	>	if not IsInputDataArea or not CaseSensitiveParams then
558	>	s := AnsiUpperCase(Idx)
559	>	else
560		s := Idx;
561	<	{$endif}
561	>
562		for i := 0 to Count - 1 do
563		if Column[i].Name = s then
564		begin
#	Line 761 | Line 590 | end;
590
591		procedure TSQLVarData.SetName(AValue: AnsiString);
592		begin
593	<	if FName = AValue then Exit;
765	<	{$ifdef UseCaseInSensitiveParamName}
766	<	if Parent.IsInputDataArea then
593	>	if not Parent.IsInputDataArea or not Parent.CaseSensitiveParams then
594		FName := AnsiUpperCase(AValue)
595		else
769	–	{$endif}
596		FName := AValue;
597		end;
598
#	Line 787 | Line 613 | begin
613
614		FVarString := aValue;
615		SQLType := SQL_TEXT;
616	+	Scale := 0;
617		SetSQLData(PByte(PAnsiChar(FVarString)),Length(aValue));
618		end;
619
#	Line 947 | Line 774 | begin
774		result := Value;
775		end;
776
777	+	function TSQLDataItem.GetDateFormatStr(IncludeTime: boolean): AnsiString;
778	+	begin
779	+	{$IF declared(DefaultFormatSettings)}
780	+	with DefaultFormatSettings do
781	+	{$ELSE}
782	+	{$IF declared(FormatSettings)}
783	+	with FormatSettings do
784	+	{$IFEND}
785	+	{$IFEND}
786	+	case GetSQLDialect of
787	+	1:
788	+	if IncludeTime then
789	+	result := ShortDateFormat + ' ' + LongTimeFormat
790	+	else
791	+	result := ShortDateFormat;
792	+	3:
793	+	result := ShortDateFormat;
794	+	end;
795	+	end;
796	+
797	+	function TSQLDataItem.GetTimeFormatStr: AnsiString;
798	+	begin
799	+	{$IF declared(DefaultFormatSettings)}
800	+	with DefaultFormatSettings do
801	+	{$ELSE}
802	+	{$IF declared(FormatSettings)}
803	+	with FormatSettings do
804	+	{$IFEND}
805	+	{$IFEND}
806	+	Result := LongTimeFormat;
807	+	end;
808	+
809	+	function TSQLDataItem.GetTimestampFormatStr: AnsiString;
810	+	begin
811	+	{$IF declared(DefaultFormatSettings)}
812	+	with DefaultFormatSettings do
813	+	{$ELSE}
814	+	{$IF declared(FormatSettings)}
815	+	with FormatSettings do
816	+	{$IFEND}
817	+	{$IFEND}
818	+	Result := ShortDateFormat + ' ' +  LongTimeFormat + '.zzz';
819	+	end;
820	+
821		procedure TSQLDataItem.SetAsInteger(AValue: Integer);
822		begin
823		SetAsLong(aValue);
#	Line 1045 | Line 916 | begin
916		//Do nothing by default
917		end;
918
919	+	constructor TSQLDataItem.Create(api: TFBClientAPI);
920	+	begin
921	+	inherited Create;
922	+	FFirebirdClientAPI := api;
923	+	end;
924	+
925		function TSQLDataItem.GetSQLTypeName: AnsiString;
926		begin
927		Result := GetSQLTypeName(GetSQLType);
#	Line 1151 | Line 1028 | begin
1028		CheckActive;
1029		result := 0;
1030		if not IsNull then
1031	<	with FirebirdClientAPI do
1031	>	with FFirebirdClientAPI do
1032		case SQLType of
1033		SQL_TEXT, SQL_VARYING: begin
1034		try
#	Line 1291 | Line 1168 | begin
1168		result := '';
1169		{ Check null, if so return a default string }
1170		if not IsNull then
1171	<	with FirebirdClientAPI do
1171	>	with FFirebirdClientAPI do
1172		case SQLType of
1173		SQL_BOOLEAN:
1174		if AsBoolean then
#	Line 1316 | Line 1193 | begin
1193		Result := rs
1194		end;
1195		SQL_TYPE_DATE:
1196	<	case GetSQLDialect of
1320	<	1 : result := DateTimeToStr(AsDateTime);
1321	<	3 : result := DateToStr(AsDateTime);
1322	<	end;
1196	>	result := FormatDateTime(GetDateFormatStr(TimeOf(AsDateTime)<>0),AsDateTime);
1197		SQL_TYPE_TIME :
1198	<	result := TimeToStr(AsDateTime);
1198	>	result := FormatDateTime(GetTimeFormatStr,AsDateTime);
1199		SQL_TIMESTAMP:
1200	<	{$IF declared(DefaultFormatSettings)}
1327	<	with DefaultFormatSettings do
1328	<	{$ELSE}
1329	<	{$IF declared(FormatSettings)}
1330	<	with FormatSettings do
1331	<	{$IFEND}
1332	<	{$IFEND}
1333	<	result := FormatDateTime(ShortDateFormat + ' ' +
1334	<	LongTimeFormat+'.zzz',AsDateTime);
1200	>	result := FormatDateTime(GetTimestampFormatStr,AsDateTime);
1201		SQL_SHORT, SQL_LONG:
1202		if Scale = 0 then
1203		result := IntToStr(AsLong)
#	Line 1359 | Line 1225 | begin
1225		Result := false;
1226		end;
1227
1228	<	function TSQLDataItem.getIsNullable: boolean;
1228	>	function TSQLDataItem.GetIsNullable: boolean;
1229		begin
1230		CheckActive;
1231		Result := false;
#	Line 1407 | Line 1273 | begin
1273		Result := false;
1274		end;
1275
1276	+	function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
1277	+	): integer;
1278	+	begin
1279	+	case DateTimeFormat of
1280	+	dfTimestamp:
1281	+	Result := Length(GetTimestampFormatStr);
1282	+	dfDateTime:
1283	+	Result := Length(GetDateFormatStr(true));
1284	+	dfTime:
1285	+	Result := Length(GetTimeFormatStr);
1286	+	else
1287	+	Result := 0;
1288	+	end;
1289	+	end;
1290	+
1291
1292		procedure TSQLDataItem.SetIsNull(Value: Boolean);
1293		begin
#	Line 1470 | Line 1351 | begin
1351
1352		SQLType := SQL_TYPE_DATE;
1353		DataLength := SizeOf(ISC_DATE);
1354	<	with FirebirdClientAPI do
1354	>	with FFirebirdClientAPI do
1355		SQLEncodeDate(Value,SQLData);
1356		Changed;
1357		end;
#	Line 1490 | Line 1371 | begin
1371
1372		SQLType := SQL_TYPE_TIME;
1373		DataLength := SizeOf(ISC_TIME);
1374	<	with FirebirdClientAPI do
1374	>	with FFirebirdClientAPI do
1375		SQLEncodeTime(Value,SQLData);
1376		Changed;
1377		end;
#	Line 1504 | Line 1385 | begin
1385		Changing;
1386		SQLType := SQL_TIMESTAMP;
1387		DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1388	<	with FirebirdClientAPI do
1388	>	with FFirebirdClientAPI do
1389		SQLEncodeDateTime(Value,SQLData);
1390		Changed;
1391		end;
#	Line 1629 | Line 1510 | begin
1510		end;
1511		end;
1512
1513	+	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1514	+	begin
1515	+	CheckActive;
1516	+	Changing;
1517	+	if IsNullable then
1518	+	IsNull := False;
1519	+
1520	+	SQLType := SQL_INT64;
1521	+	Scale := aScale;
1522	+	DataLength := SizeOf(Int64);
1523	+	PInt64(SQLData)^ := Value;
1524	+	Changed;
1525	+	end;
1526	+
1527		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1528		begin
1529		CheckActive;
#	Line 1676 | Line 1571 | end;
1571
1572		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1573		begin
1574	<	inherited Create;
1574	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1575		FIBXSQLVAR := aIBXSQLVAR;
1576		FOwner := aOwner;
1577		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1840 | Line 1735 | end;
1735		{ TSQLParam }
1736
1737		procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1738	+
1739	+	procedure DoSetString;
1740	+	begin
1741	+	Changing;
1742	+	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1743	+	Changed;
1744	+	end;
1745	+
1746		var b: IBlob;
1747	+	dt: TDateTime;
1748	+	CurrValue: Currency;
1749	+	FloatValue: single;
1750		begin
1751		CheckActive;
1752		if IsNullable then
#	Line 1866 | Line 1772 | begin
1772
1773		SQL_VARYING,
1774		SQL_TEXT:
1775	<	begin
1870	<	Changing;
1871	<	FIBXSQLVar.SetString(Transliterate(Value,GetCodePage));
1872	<	Changed;
1873	<	end;
1775	>	DoSetString;
1776
1777		SQL_SHORT,
1778		SQL_LONG,
1779		SQL_INT64:
1780	<	SetAsInt64(StrToInt(Value));
1780	>	if TryStrToCurr(Value,CurrValue) then
1781	>	SetAsNumeric(AdjustScaleFromCurrency(CurrValue,GetScale),GetScale)
1782	>	else
1783	>	DoSetString;
1784
1785		SQL_D_FLOAT,
1786		SQL_DOUBLE,
1787		SQL_FLOAT:
1788	<	SetAsDouble(StrToFloat(Value));
1788	>	if TryStrToFloat(Value,FloatValue) then
1789	>	SetAsDouble(FloatValue)
1790	>	else
1791	>	DoSetString;
1792
1793		SQL_TIMESTAMP:
1794	<	SetAsDateTime(StrToDateTime(Value));
1794	>	if TryStrToDateTime(Value,dt) then
1795	>	SetAsDateTime(dt)
1796	>	else
1797	>	DoSetString;
1798
1799		SQL_TYPE_DATE:
1800	<	SetAsDate(StrToDateTime(Value));
1800	>	if TryStrToDateTime(Value,dt) then
1801	>	SetAsDate(dt)
1802	>	else
1803	>	DoSetString;
1804
1805		SQL_TYPE_TIME:
1806	<	SetAsTime(StrToDateTime(Value));
1806	>	if TryStrToDateTime(Value,dt) then
1807	>	SetAsTime(dt)
1808	>	else
1809	>	DoSetString;
1810
1811		else
1812		IBError(ibxeInvalidDataConversion,[nil]);

Diff Legend

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