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 262 by tony, Mon Mar 13 09:51:56 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 456 | 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 510 | Line 601 | end;
601
602		procedure TSQLDataArea.PreprocessSQL(sSQL: AnsiString; GenerateParamNames: boolean;
603		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}
533	–
534	–	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;
604
605	<	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;
605	>	var slNames: TStrings;
606
607	<	CommentState:
608	<	begin
609	<	if (cNextChar = #0) then
610	<	IBError(ibxeSQLParseError, [SEOFInComment])
611	<	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));
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 710 | 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;
715	–	FreeMem(StrBuffer);
644		end;
645		end;
646
#	Line 1046 | 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 1152 | 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 1292 | 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 1471 | 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 1491 | 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 1505 | 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 1691 | 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;

Diff Legend

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