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 263 by tony, Thu Dec 6 15:55:01 2018 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
79	>	{ Note on SQL Parameter Names
80		--------------------------------------------
81
82	<	Even when dialect 3 quoted format parameter names are not supported, IBX still processes
83	<	parameter names case insensitive. This does result in some additional overhead
88	<	due to a call to "AnsiUpperCase". This can be avoided by undefining
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
91	–	Note: do not define "UseCaseSensitiveParamName" when "ALLOWDIALECT3PARAMNAMES"
92	–	is defined. This will not give a useful result.
86		}
87		{$define UseCaseInSensitiveParamName}
95	–	{$endif}
88
89		interface
90
91		uses
92	<	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor;
92	>	Classes, SysUtils, IBExternals, IBHeader, IB,  FBActivityMonitor, FBClientAPI;
93
94		type
95
#	Line 105 | Line 97 | type
97
98		TSQLDataItem = class(TFBInterfacedObject)
99		private
100	+	FFirebirdClientAPI: TFBClientAPI;
101		function AdjustScale(Value: Int64; aScale: Integer): Double;
102		function AdjustScaleToInt64(Value: Int64; aScale: Integer): Int64;
103		function AdjustScaleToCurrency(Value: Int64; aScale: Integer): Currency;
#	Line 128 | Line 121 | type
121		property DataLength: cardinal read GetDataLength write SetDataLength;
122
123		public
124	+	constructor Create(api: TFBClientAPI);
125		function GetSQLType: cardinal; virtual; abstract;
126		function GetSQLTypeName: AnsiString; overload;
127		class function GetSQLTypeName(SQLType: short): AnsiString; overload;
#	Line 145 | Line 139 | type
139		function GetAsShort: short;
140		function GetAsString: AnsiString; virtual;
141		function GetIsNull: Boolean; virtual;
142	<	function getIsNullable: boolean; virtual;
142	>	function GetIsNullable: boolean; virtual;
143		function GetAsVariant: Variant;
144		function GetModified: boolean; virtual;
145		procedure SetAsBoolean(AValue: boolean); virtual;
#	Line 162 | Line 156 | type
156		procedure SetAsShort(Value: short); virtual;
157		procedure SetAsString(Value: AnsiString); virtual;
158		procedure SetAsVariant(Value: Variant);
159	+	procedure SetAsNumeric(Value: Int64; aScale: integer);
160		procedure SetIsNull(Value: Boolean); virtual;
161		procedure SetIsNullable(Value: Boolean); virtual;
162		procedure SetName(aValue: AnsiString); virtual;
#	Line 455 | Line 450 | type
450
451		implementation
452
453	<	uses FBMessages, FBClientAPI, variants, IBUtils, FBTransaction;
453	>	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
552
553		{ TSQLDataArea }
#	Line 509 | Line 601 | end;
601
602		procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
603		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]);
604
605	<	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;
605	>	var slNames: TStrings;
606
607	<	ArrayDimState:
608	<	begin
609	<	case cCurChar of
610	<	':',',','0'..'9',' ',#9,#10,#13:
611	<	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;
612	<
613	<	CommentState:
614	<	begin
615	<	if (cNextChar = #0) then
616	<	IBError(ibxeSQLParseError, [SEOFInComment])
617	<	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));
607	>	procedure SetColumnNames(slNames: TStrings);
608	>	var i, j: integer;
609	>	found: boolean;
610	>	begin
611	>	found := false;
612		SetCount(slNames.Count);
613		for i := 0 to slNames.Count - 1 do
614		begin
#	Line 709 | Line 629 | begin
629		Column[i].UniqueName := not found;
630		end;
631		end;
632	+	end;
633	+
634	+	begin
635	+	if not IsInputDataArea then
636	+	IBError(ibxeNotPermitted,[nil]);
637	+
638	+	slNames := TStringList.Create;
639	+	try
640	+	sProcessedSQL := TSQLParamProcessor.Execute(sSQL,GenerateParamNames,slNames);
641	+	SetColumnNames(slNames);
642		finally
643		slNames.Free;
714	–	FreeMem(StrBuffer);
644		end;
645		end;
646
#	Line 1045 | Line 974 | begin
974		//Do nothing by default
975		end;
976
977	+	constructor TSQLDataItem.Create(api: TFBClientAPI);
978	+	begin
979	+	inherited Create;
980	+	FFirebirdClientAPI := api;
981	+	end;
982	+
983		function TSQLDataItem.GetSQLTypeName: AnsiString;
984		begin
985		Result := GetSQLTypeName(GetSQLType);
#	Line 1151 | Line 1086 | begin
1086		CheckActive;
1087		result := 0;
1088		if not IsNull then
1089	<	with FirebirdClientAPI do
1089	>	with FFirebirdClientAPI do
1090		case SQLType of
1091		SQL_TEXT, SQL_VARYING: begin
1092		try
#	Line 1291 | Line 1226 | begin
1226		result := '';
1227		{ Check null, if so return a default string }
1228		if not IsNull then
1229	<	with FirebirdClientAPI do
1229	>	with FFirebirdClientAPI do
1230		case SQLType of
1231		SQL_BOOLEAN:
1232		if AsBoolean then
#	Line 1470 | Line 1405 | begin
1405
1406		SQLType := SQL_TYPE_DATE;
1407		DataLength := SizeOf(ISC_DATE);
1408	<	with FirebirdClientAPI do
1408	>	with FFirebirdClientAPI do
1409		SQLEncodeDate(Value,SQLData);
1410		Changed;
1411		end;
#	Line 1490 | Line 1425 | begin
1425
1426		SQLType := SQL_TYPE_TIME;
1427		DataLength := SizeOf(ISC_TIME);
1428	<	with FirebirdClientAPI do
1428	>	with FFirebirdClientAPI do
1429		SQLEncodeTime(Value,SQLData);
1430		Changed;
1431		end;
#	Line 1504 | Line 1439 | begin
1439		Changing;
1440		SQLType := SQL_TIMESTAMP;
1441		DataLength := SizeOf(ISC_TIME) + sizeof(ISC_DATE);
1442	<	with FirebirdClientAPI do
1442	>	with FFirebirdClientAPI do
1443		SQLEncodeDateTime(Value,SQLData);
1444		Changed;
1445		end;
#	Line 1629 | Line 1564 | begin
1564		end;
1565		end;
1566
1567	+	procedure TSQLDataItem.SetAsNumeric(Value: Int64; aScale: integer);
1568	+	begin
1569	+	CheckActive;
1570	+	Changing;
1571	+	if IsNullable then
1572	+	IsNull := False;
1573	+
1574	+	SQLType := SQL_INT64;
1575	+	Scale := aScale;
1576	+	DataLength := SizeOf(Int64);
1577	+	PInt64(SQLData)^ := Value;
1578	+	Changed;
1579	+	end;
1580	+
1581		procedure TSQLDataItem.SetAsBoolean(AValue: boolean);
1582		begin
1583		CheckActive;
#	Line 1676 | Line 1625 | end;
1625
1626		constructor TColumnMetaData.Create(aOwner: IUnknown; aIBXSQLVAR: TSQLVarData);
1627		begin
1628	<	inherited Create;
1628	>	inherited Create(aIBXSQLVAR.GetStatement.GetAttachment.getFirebirdAPI as TFBClientAPI);
1629		FIBXSQLVAR := aIBXSQLVAR;
1630		FOwner := aOwner;
1631		FPrepareSeqNo := FIBXSQLVAR.Parent.PrepareSeqNo;
#	Line 1841 | Line 1790 | end;
1790
1791		procedure TSQLParam.InternalSetAsString(Value: AnsiString);
1792		var b: IBlob;
1793	+	dt: TDateTime;
1794		begin
1795		CheckActive;
1796		if IsNullable then
#	Line 1875 | Line 1825 | begin
1825		SQL_SHORT,
1826		SQL_LONG,
1827		SQL_INT64:
1828	<	SetAsInt64(StrToInt(Value));
1828	>	SetAsNumeric(AdjustScaleFromCurrency(StrToCurr(Value),GetScale),GetScale);
1829
1830		SQL_D_FLOAT,
1831		SQL_DOUBLE,
#	Line 1883 | Line 1833 | begin
1833		SetAsDouble(StrToFloat(Value));
1834
1835		SQL_TIMESTAMP:
1836	<	SetAsDateTime(StrToDateTime(Value));
1836	>	if TryStrToDateTime(Value,dt) then
1837	>	SetAsDateTime(dt)
1838	>	else
1839	>	FIBXSQLVar.SetString(Value);
1840
1841		SQL_TYPE_DATE:
1842	<	SetAsDate(StrToDateTime(Value));
1842	>	if TryStrToDateTime(Value,dt) then
1843	>	SetAsDate(dt)
1844	>	else
1845	>	FIBXSQLVar.SetString(Value);
1846
1847		SQL_TYPE_TIME:
1848	<	SetAsTime(StrToDateTime(Value));
1848	>	if TryStrToDateTime(Value,dt) then
1849	>	SetAsTime(dt)
1850	>	else
1851	>	FIBXSQLVar.SetString(Value);
1852
1853		else
1854		IBError(ibxeInvalidDataConversion,[nil]);

Diff Legend

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