ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/client/IBUtils.pas

Comparing ibx/trunk/fbintf/IBUtils.pas (file contents):
Revision 120 by tony, Mon Jan 22 13:58:20 2018 UTC vs.
Revision 287 by tony, Thu Apr 11 08:51:23 2019 UTC

#	Line 45 | Line 45 | unit IBUtils;
45
46		interface
47
48	<	uses Classes, SysUtils;
48	>	uses Classes, SysUtils, IB;
49	>
50	>	type
51	>	TSQLTokens = (
52	>
53	>	{Reserved Words}
54	>
55	>	sqltAdd,
56	>	sqltAdmin,
57	>	sqltAll,
58	>	sqltAlter,
59	>	sqltAnd,
60	>	sqltAny,
61	>	sqltAs,
62	>	sqltAt,
63	>	sqltAvg,
64	>	sqltBegin,
65	>	sqltBetween,
66	>	sqltBigint,
67	>	sqltBit_Length,
68	>	sqltBlob,
69	>	sqltBoolean,
70	>	sqltBoth,
71	>	sqltBy,
72	>	sqltCase,
73	>	sqltCast,
74	>	sqltChar,
75	>	sqltChar_Length,
76	>	sqltCharacter,
77	>	sqltCharacter_Length,
78	>	sqltCheck,
79	>	sqltClose,
80	>	sqltCollate,
81	>	sqltColumn,
82	>	sqltCommit,
83	>	sqltConnect,
84	>	sqltConstraint,
85	>	sqltCorr,
86	>	sqltCount,
87	>	sqltCovar_Pop,
88	>	sqltCovar_Samp,
89	>	sqltCreate,
90	>	sqltCross,
91	>	sqltCurrent,
92	>	sqltCurrent_Connection,
93	>	sqltCurrent_Date,
94	>	sqltCurrent_Role,
95	>	sqltCurrent_Time,
96	>	sqltCurrent_Timestamp,
97	>	sqltCurrent_Transaction,
98	>	sqltCurrent_User,
99	>	sqltCursor,
100	>	sqltDate,
101	>	sqltDay,
102	>	sqltDec,
103	>	sqltDecimal,
104	>	sqltDeclare,
105	>	sqltDefault,
106	>	sqltDelete,
107	>	sqltDeleting,
108	>	sqltDeterministic,
109	>	sqltDisconnect,
110	>	sqltDistinct,
111	>	sqltDouble,
112	>	sqltDrop,
113	>	sqltElse,
114	>	sqltEnd,
115	>	sqltEscape,
116	>	sqltExecute,
117	>	sqltExists,
118	>	sqltExternal,
119	>	sqltExtract,
120	>	sqltFalse,
121	>	sqltFetch,
122	>	sqltFilter,
123	>	sqltFloat,
124	>	sqltFor,
125	>	sqltForeign,
126	>	sqltFrom,
127	>	sqltFull,
128	>	sqltFunction,
129	>	sqltGdscode,
130	>	sqltGlobal,
131	>	sqltGrant,
132	>	sqltGroup,
133	>	sqltHaving,
134	>	sqltHour,
135	>	sqltIn,
136	>	sqltIndex,
137	>	sqltInner,
138	>	sqltInsensitive,
139	>	sqltInsert,
140	>	sqltInserting,
141	>	sqltInt,
142	>	sqltInteger,
143	>	sqltInto,
144	>	sqltIs,
145	>	sqltJoin,
146	>	sqltKey,
147	>	sqltLeading,
148	>	sqltLeft,
149	>	sqltLike,
150	>	sqltLong,
151	>	sqltLower,
152	>	sqltMax,
153	>	sqltMaximum_Segment,
154	>	sqltMerge,
155	>	sqltMin,
156	>	sqltMinute,
157	>	sqltMonth,
158	>	sqltNational,
159	>	sqltNatural,
160	>	sqltNchar,
161	>	sqltNo,
162	>	sqltNot,
163	>	sqltNull,
164	>	sqltNumeric,
165	>	sqltOctet_Length,
166	>	sqltOf,
167	>	sqltOffset,
168	>	sqltOn,
169	>	sqltOnly,
170	>	sqltOpen,
171	>	sqltOr,
172	>	sqltOrder,
173	>	sqltOuter,
174	>	sqltOver,
175	>	sqltParameter,
176	>	sqltPlan,
177	>	sqltPosition,
178	>	sqltPost_Event,
179	>	sqltPrecision,
180	>	sqltPrimary,
181	>	sqltProcedure,
182	>	sqltRdbDb_Key,
183	>	sqltRdbRecord_Version,
184	>	sqltReal,
185	>	sqltRecord_Version,
186	>	sqltRecreate,
187	>	sqltRecursive,
188	>	sqltReferences,
189	>	sqltRegr_Avgx,
190	>	sqltRegr_Avgy,
191	>	sqltRegr_Count,
192	>	sqltRegr_Intercept,
193	>	sqltRegr_R2,
194	>	sqltRegr_Slope,
195	>	sqltRegr_Sxx,
196	>	sqltRegr_Sxy,
197	>	sqltRegr_Syy,
198	>	sqltRelease,
199	>	sqltReturn,
200	>	sqltReturning_Values,
201	>	sqltReturns,
202	>	sqltRevoke,
203	>	sqltRight,
204	>	sqltRollback,
205	>	sqltRow,
206	>	sqltRows,
207	>	sqltRow_Count,
208	>	sqltSavepoint,
209	>	sqltScroll,
210	>	sqltSecond,
211	>	sqltSelect,
212	>	sqltSensitive,
213	>	sqltSet,
214	>	sqltSimilar,
215	>	sqltSmallint,
216	>	sqltSome,
217	>	sqltSqlcode,
218	>	sqltSqlstate,
219	>	sqltStart,
220	>	sqltStddev_Pop,
221	>	sqltStddev_Samp,
222	>	sqltSum,
223	>	sqltTable,
224	>	sqltThen,
225	>	sqltTime,
226	>	sqltTimestamp,
227	>	sqltTo,
228	>	sqltTrailing,
229	>	sqltTrigger,
230	>	sqltTrim,
231	>	sqltTrue,
232	>	sqltUnion,
233	>	sqltUnique,
234	>	sqltUnknown,
235	>	sqltUpdate,
236	>	sqltUpdating,
237	>	sqltUpper,
238	>	sqltUser,
239	>	sqltUsing,
240	>	sqltValue,
241	>	sqltValues,
242	>	sqltVar_Pop,
243	>	sqltVar_Samp,
244	>	sqltVarchar,
245	>	sqltVariable,
246	>	sqltVarying,
247	>	sqltView,
248	>	sqltWhen,
249	>	sqltWhere,
250	>	sqltWhile,
251	>	sqltWith,
252	>	sqltYear,
253	>
254	>	{symbols}
255	>
256	>	sqltSpace,
257	>	sqltSemiColon,
258	>	sqltPlaceholder,
259	>	sqltSingleQuotes,
260	>	sqltDoubleQuotes,
261	>	sqltBackslash,
262	>	sqltComma,
263	>	sqltPeriod,
264	>	sqltEquals,
265	>	sqltOtherCharacter,
266	>	sqltIdentifier,
267	>	sqltIdentifierInDoubleQuotes,
268	>	sqltNumberString,
269	>	sqltString,
270	>	sqltParam,
271	>	sqltQuotedParam,
272	>	sqltColon,
273	>	sqltComment,
274	>	sqltCommentLine,
275	>	sqltQuotedString,
276	>	sqltAsterisk,
277	>	sqltForwardSlash,
278	>	sqltOpenSquareBracket,
279	>	sqltCloseSquareBracket,
280	>	sqltOpenBracket,
281	>	sqltCloseBracket,
282	>	sqltPipe,
283	>	sqltMinus,
284	>	sqltConcatSymbol,
285	>	sqltLT,
286	>	sqltGT,
287	>	sqltCR,
288	>	sqltEOL,
289	>	sqltEOF,
290	>	sqltInit
291	>	);
292	>
293	>	TSQLReservedWords = sqltAdd..sqltYear;
294
295		const
296		CRLF = #13 + #10;
#	Line 54 | Line 299 | const
299		TAB  = #9;
300		NULL_TERMINATOR = #0;
301
302	<	sqlReservedWords: array [0..197] of string = (
302	>	{$IFNDEF FPC}
303	>	LineEnding = CRLF;
304	>	{$ENDIF}
305	>
306	>	{SQL Reserved words in alphabetical order}
307	>
308	>	sqlReservedWords: array [TSQLReservedWords] of string = (
309		'ADD',
310		'ADMIN',
311		'ALL',
#	Line 146 | Line 397 | const
397		'INTO',
398		'IS',
399		'JOIN',
400	+	'KEY',
401		'LEADING',
402		'LEFT',
403		'LIKE',
#	Line 205 | Line 457 | const
457		'RIGHT',
458		'ROLLBACK',
459		'ROW',
208	–	'ROW_COUNT',
460		'ROWS',
461	+	'ROW_COUNT',
462		'SAVEPOINT',
463		'SCROLL',
464		'SECOND',
#	Line 218 | Line 470 | const
470		'SOME',
471		'SQLCODE',
472		'SQLSTATE',
221	–	'SQLSTATE',
473		'START',
474		'STDDEV_POP',
475		'STDDEV_SAMP',
#	Line 255 | Line 506 | const
506		'YEAR'
507		);
508
509	+	type
510	+	{The TSQLTokeniser class provides a common means to parse an SQL statement, or
511	+	even a stream of SQL Statements. The TSQLStringTokeniser class is instantiated
512	+	with a single SQL statement or a set of concatenated statements. The TSQLStreamTokeniser
513	+	is instantiated with a stream from which the SQL statements are read.
514	+
515	+	Successive calls to GetNextToken then return each SQL token. The TokenText contains
516	+	either the single character, the identifier or reserved word, the string or comment.}
517	+
518	+	{ TSQLTokeniser }
519	+
520	+	TSQLTokeniser = class
521	+	private
522	+	const
523	+	TokenQueueMaxSize = 64;
524	+	type
525	+	TLexState = (stDefault, stInCommentLine, stInComment, stSingleQuoted, stDoubleQuoted,
526	+	stInIdentifier, stInNumeric);
527	+
528	+	TTokenQueueItem = record
529	+	token: TSQLTokens;
530	+	text: AnsiString;
531	+	end;
532	+	TTokenQueueState = (tsHold, tsRelease);
533	+
534	+	private
535	+	FLastChar: AnsiChar;
536	+	FState: TLexState;
537	+	FSkipNext: boolean;
538	+	function GetNext: TSQLTokens;
539	+
540	+	{The token Queue is available for use by descendents so that they can
541	+	hold back tokens in order to lookahead by token rather than just a single
542	+	character}
543	+
544	+	private
545	+	FTokenQueue: array[0..TokenQueueMaxSize] of TTokenQueueItem;
546	+	FQueueState: TTokenQueueState;
547	+	FQFirst: integer;  {first and last pointers first=last => queue empty}
548	+	FQLast: integer;
549	+	FEOF: boolean;
550	+	procedure PopQueue(var token: TSQLTokens);
551	+	protected
552	+	FString: AnsiString;
553	+	FNextToken: TSQLTokens;
554	+	procedure Assign(source: TSQLTokeniser); virtual;
555	+	function GetChar: AnsiChar; virtual; abstract;
556	+	function TokenFound(var token: TSQLTokens): boolean; virtual;
557	+	function InternalGetNextToken: TSQLTokens; virtual;
558	+	procedure Reset; virtual;
559	+
560	+	{Token stack}
561	+	procedure QueueToken(token: TSQLTokens; text:AnsiString); overload;
562	+	procedure QueueToken(token: TSQLTokens); overload;
563	+	procedure ResetQueue; overload;
564	+	procedure ResetQueue(token: TSQLTokens; text:AnsiString); overload;
565	+	procedure ResetQueue(token: TSQLTokens); overload;
566	+	procedure ReleaseQueue(var token: TSQLTokens); overload;
567	+	procedure ReleaseQueue; overload;
568	+	function GetQueuedText: AnsiString;
569	+	procedure SetTokenText(text: AnsiString);
570	+
571	+	public
572	+	const
573	+	DefaultTerminator = ';';
574	+	public
575	+	constructor Create;
576	+	destructor Destroy; override;
577	+	function GetNextToken: TSQLTokens;
578	+	property EOF: boolean read FEOF;
579	+	property TokenText: AnsiString read FString;
580	+	end;
581	+
582	+	{ TSQLwithNamedParamsTokeniser }
583	+
584	+	TSQLwithNamedParamsTokeniser = class(TSQLTokeniser)
585	+	private
586	+	type
587	+	TSQLState = (stInit,stInParam,stInBlock, stInArrayDim);
588	+	private
589	+	FState: TSQLState;
590	+	FNested: integer;
591	+	protected
592	+	procedure Assign(source: TSQLTokeniser); override;
593	+	procedure Reset; override;
594	+	function TokenFound(var token: TSQLTokens): boolean; override;
595	+	end;
596	+
597	+	{ TSQLParamProcessor }
598	+
599	+	TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
600	+	private
601	+	const
602	+	sIBXParam = 'IBXParam';  {do not localize}
603	+	private
604	+	FInString: AnsiString;
605	+	FIndex: integer;
606	+	function DoExecute(GenerateParamNames: boolean;
607	+	var slNames: TStrings): AnsiString;
608	+	protected
609	+	function GetChar: AnsiChar; override;
610	+	public
611	+	class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
612	+	var slNames: TStrings): AnsiString;
613	+	end;
614	+
615	+
616		function Max(n1, n2: Integer): Integer;
617		function Min(n1, n2: Integer): Integer;
618		function RandomString(iLength: Integer): AnsiString;
619		function RandomInteger(iLow, iHigh: Integer): Integer;
620		function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
621		function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
622	+	function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
623	+	function IsReservedWord(w: AnsiString): boolean;
624		function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
625		function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
626		function Space2Underscore(s: AnsiString): AnsiString;
627		function SQLSafeString(const s: AnsiString): AnsiString;
628		function IsSQLIdentifier(Value: AnsiString): boolean;
629		function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
630	+	function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
631	+	PortNo: AnsiString = ''): AnsiString;
632	+	function ParseConnectString(ConnectString: AnsiString;
633	+	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
634	+	var PortNo: AnsiString): boolean;
635	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
636
637		implementation
638
639	+	uses FBMessages
640	+
641		{$IFDEF HASREQEX}
642	<	uses RegExpr;
643	<	{$ENDIF}
642	>	,RegExpr
643	>	{$ENDIF};
644
645		function Max(n1, n2: Integer): Integer;
646		begin
#	Line 336 | Line 704 | begin
704		Result := Value;
705		end;
706
707	+	{Returns true if "w" is a Firebird SQL reserved word, and the
708	+	corresponding TSQLTokens value.}
709	+
710	+	function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
711	+	var i: TSQLTokens;
712	+	begin
713	+	Result := true;
714	+	w := AnsiUpperCase(Trim(w));
715	+	for i := Low(TSQLReservedWords) to High(TSQLReservedWords) do
716	+	begin
717	+	if w = sqlReservedWords[i] then
718	+	begin
719	+	token := i;
720	+	Exit;
721	+	end;
722	+	if w <  sqlReservedWords[i] then
723	+	break;
724	+	end;
725	+	Result := false;
726	+	end;
727	+
728		{Returns true if "w" is a Firebird SQL reserved word}
729
730		function IsReservedWord(w: AnsiString): boolean;
731	<	var i: integer;
731	>	var token: TSQLTokens;
732		begin
733	<	Result := true;
345	<	for i := 0 to Length(sqlReservedWords) - 1 do
346	<	if w = sqlReservedWords[i] then
347	<	Exit;
348	<	Result := false;
733	>	Result := FindReservedWord(w,token);
734		end;
735
736		{Format an SQL Identifier according to SQL Dialect}
#	Line 388 | Line 773 | begin
773		RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
774		Result := RegexObj.Exec(CreateSQL);
775		if Result then
776	<	ConnectString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
776	>	ConnectString := RegexObj.Match[2];
777		finally
778		RegexObj.Free;
779		end;
780		end;
781	+
782	+	function ParseConnectString(ConnectString: AnsiString; var ServerName,
783	+	DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
784	+	): boolean;
785	+
786	+	function GetProtocol(scheme: AnsiString): TProtocolAll;
787	+	begin
788	+	scheme := AnsiUpperCase(scheme);
789	+	if scheme = 'INET' then
790	+	Result := inet
791	+	else
792	+	if scheme = 'INET4' then
793	+	Result := inet4
794	+	else
795	+	if scheme = 'INET6' then
796	+	Result := inet6
797	+	else
798	+	if scheme = 'XNET' then
799	+	Result := xnet
800	+	else
801	+	if scheme = 'WNET' then
802	+	Result := wnet
803	+	end;
804	+
805	+	var RegexObj: TRegExpr;
806	+	begin
807	+	ServerName := '';
808	+	DatabaseName := ConnectString;
809	+	PortNo := '';
810	+	Protocol := unknownProtocol;
811	+	RegexObj := TRegExpr.Create;
812	+	try
813	+	{extact database file spec}
814	+	RegexObj.ModifierG := false; {turn off greedy matches}
815	+	RegexObj.Expression := '^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$';
816	+	Result := RegexObj.Exec(ConnectString);
817	+	if Result then
818	+	begin
819	+	{URL type connect string}
820	+	Protocol := GetProtocol(RegexObj.Match[1]);
821	+	ServerName := RegexObj.Match[2];
822	+	if RegexObj.MatchLen[3] > 0 then
823	+	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
824	+	DatabaseName := RegexObj.Match[4];
825	+	if ServerName = '' then
826	+	DatabaseName := '/' + DatabaseName;
827	+	end
828	+	else
829	+	begin
830	+	{URL type connect string - local loop}
831	+	RegexObj.Expression := '^([a-zA-Z46]+)://(.*)$';
832	+	Result := RegexObj.Exec(ConnectString);
833	+	if Result then
834	+	begin
835	+	Protocol := GetProtocol(RegexObj.Match[1]);
836	+	DatabaseName := RegexObj.Match[2];
837	+	end
838	+	else
839	+	begin
840	+	RegexObj.Expression := '^([a-zA-Z]:\\.*)';
841	+	Result := RegexObj.Exec(ConnectString);
842	+	if Result then
843	+	Protocol := Local {Windows with leading drive ID}
844	+	else
845	+	begin
846	+	RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
847	+	Result := RegexObj.Exec(ConnectString);
848	+	if Result then
849	+	begin
850	+	{Legacy TCP Format}
851	+	ServerName := RegexObj.Match[1];
852	+	if RegexObj.MatchLen[2] > 0 then
853	+	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
854	+	DatabaseName := RegexObj.Match[3];
855	+	Protocol := TCP;
856	+	end
857	+	else
858	+	begin
859	+	RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
860	+	Result := RegexObj.Exec(ConnectString);
861	+	if Result then
862	+	begin
863	+	{Netbui}
864	+	ServerName := RegexObj.Match[1];
865	+	if RegexObj.MatchLen[2] > 0 then
866	+	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
867	+	DatabaseName := RegexObj.Match[3];
868	+	Protocol := NamedPipe
869	+	end
870	+	else
871	+	begin
872	+	Result := true;
873	+	Protocol := Local; {Assume local}
874	+	end;
875	+	end;
876	+	end;
877	+	end;
878	+	end;
879	+	finally
880	+	RegexObj.Free;
881	+	end;
882	+	end;
883	+
884	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
885	+	var ServerName,
886	+	DatabaseName: AnsiString;
887	+	PortNo: AnsiString;
888	+	begin
889	+	ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
890	+	end;
891	+
892		{$ELSE}
893	<	{cruder version of above for old versions of Delphi}
893	>	{cruder version of above for Delphi. Older versions lack regular expression
894	>	handling.}
895		function ExtractConnectString(const CreateSQL: AnsiString;
896		var ConnectString: AnsiString): boolean;
897		var i: integer;
#	Line 413 | Line 910 | begin
910		end;
911		end;
912		end;
913	+
914	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
915	+	begin
916	+	Result := unknownProtocol; {not implemented for Delphi}
917	+	end;
918	+
919	+	function ParseConnectString(ConnectString: AnsiString;
920	+	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
921	+	var PortNo: AnsiString): boolean;
922	+	begin
923	+	Result := false;
924	+	end;
925	+
926		{$ENDIF}
927
928	+	{Make a connect string in format appropriate protocol}
929	+
930	+	function MakeConnectString(ServerName, DatabaseName: AnsiString;
931	+	Protocol: TProtocol; PortNo: AnsiString): AnsiString;
932	+
933	+	function FormatURL: AnsiString;
934	+	begin
935	+	if (ServerName = '') and (Pos('/',DatabaseName) <= 1) then
936	+	Result := DatabaseName
937	+	else
938	+	Result := ServerName + '/' + DatabaseName;
939	+	end;
940	+
941	+	begin
942	+	if PortNo <> '' then
943	+	case Protocol of
944	+	NamedPipe:
945	+	ServerName := ServerName + '@' + PortNo;
946	+	Local,
947	+	SPX,
948	+	xnet: {do nothing};
949	+	TCP:
950	+	ServerName := ServerName + '/' + PortNo;
951	+	else
952	+	ServerName := ServerName + ':' + PortNo;
953	+	end;
954	+
955	+	case Protocol of
956	+	TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
957	+	SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
958	+	NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
959	+	Local:      Result := DatabaseName; {do not localize}
960	+	inet:       Result := 'inet://' + FormatURL; {do not localize}
961	+	inet4:       Result := 'inet4://' + FormatURL; {do not localize}
962	+	inet6:       Result := 'inet6://' + FormatURL; {do not localize}
963	+	wnet:       Result := 'wnet://' + FormatURL; {do not localize}
964	+	xnet:       Result := 'xnet://' + FormatURL;  {do not localize}
965	+	end;
966	+	end;
967	+
968		{Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
969
970		function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
#	Line 445 | Line 995 | begin
995		Result := StringReplace(s,'''','''''',[rfReplaceAll]);
996		end;
997
998	+	{ TSQLParamProcessor }
999	+
1000	+	function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
1001	+	var slNames: TStrings): AnsiString;
1002	+	var token: TSQLTokens;
1003	+	iParamSuffix: Integer;
1004	+	begin
1005	+	Result := '';
1006	+	iParamSuffix := 0;
1007	+
1008	+	while not EOF do
1009	+	begin
1010	+	token := GetNextToken;
1011	+	case token of
1012	+	sqltParam,
1013	+	sqltQuotedParam:
1014	+	begin
1015	+	Result := Result + '?';
1016	+	slNames.Add(TokenText);
1017	+	end;
1018	+
1019	+	sqltPlaceHolder:
1020	+	if GenerateParamNames then
1021	+	begin
1022	+	Inc(iParamSuffix);
1023	+	slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
1024	+	//add pointer to self to mark entry
1025	+	Result := Result + '?';
1026	+	end
1027	+	else
1028	+	IBError(ibxeSQLParseError, [SParamNameExpected]);
1029	+
1030	+	sqltQuotedString:
1031	+	Result := Result + '''' + SQLSafeString(TokenText) + '''';
1032	+
1033	+	sqltIdentifierInDoubleQuotes:
1034	+	Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
1035	+
1036	+	sqltComment:
1037	+	Result := Result + '/*' + TokenText + '*/';
1038	+
1039	+	sqltCommentLine:
1040	+	Result := Result + '--' + TokenText + LineEnding;
1041	+
1042	+	sqltEOL:
1043	+	Result := Result + LineEnding;
1044	+
1045	+	else
1046	+	Result := Result + TokenText;
1047	+	end;
1048	+	end;
1049	+	end;
1050	+
1051	+	function TSQLParamProcessor.GetChar: AnsiChar;
1052	+	begin
1053	+	if FIndex <= Length(FInString) then
1054	+	begin
1055	+	Result := FInString[FIndex];
1056	+	Inc(FIndex);
1057	+	end
1058	+	else
1059	+	Result := #0;
1060	+	end;
1061	+
1062	+	class function TSQLParamProcessor.Execute(sSQL: AnsiString;
1063	+	GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
1064	+	begin
1065	+	with self.Create do
1066	+	try
1067	+	FInString := sSQL;
1068	+	FIndex := 1;
1069	+	Result := DoExecute(GenerateParamNames,slNames);
1070	+	finally
1071	+	Free;
1072	+	end;
1073	+	end;
1074	+
1075	+	{ TSQLwithNamedParamsTokeniser }
1076	+
1077	+	procedure TSQLwithNamedParamsTokeniser.Assign(source: TSQLTokeniser);
1078	+	begin
1079	+	inherited Assign(source);
1080	+	if source is TSQLwithNamedParamsTokeniser then
1081	+	begin
1082	+	FState := TSQLwithNamedParamsTokeniser(source).FState;
1083	+	FNested := TSQLwithNamedParamsTokeniser(source).FNested;
1084	+	end;
1085	+	end;
1086	+
1087	+	procedure TSQLwithNamedParamsTokeniser.Reset;
1088	+	begin
1089	+	inherited Reset;
1090	+	FState := stInit;
1091	+	FNested := 0;
1092	+	end;
1093	+
1094	+	function TSQLwithNamedParamsTokeniser.TokenFound(var token: TSQLTokens
1095	+	): boolean;
1096	+	begin
1097	+	Result := inherited TokenFound(token);
1098	+	if not Result then Exit;
1099	+
1100	+	case FState of
1101	+	stInit:
1102	+	begin
1103	+	case token of
1104	+	sqltColon:
1105	+	begin
1106	+	FState := stInParam;
1107	+	ResetQueue(token);
1108	+	end;
1109	+
1110	+	sqltBegin:
1111	+	begin
1112	+	FState := stInBlock;
1113	+	FNested := 1;
1114	+	end;
1115	+
1116	+	sqltOpenSquareBracket:
1117	+	FState := stInArrayDim;
1118	+
1119	+	end;
1120	+	end;
1121	+
1122	+	stInParam:
1123	+	begin
1124	+	case token of
1125	+	sqltIdentifier:
1126	+	token := sqltParam;
1127	+
1128	+	sqltIdentifierInDoubleQuotes:
1129	+	token := sqltQuotedParam;
1130	+
1131	+	else
1132	+	begin
1133	+	QueueToken(token);
1134	+	ReleaseQueue(token);
1135	+	end;
1136	+	end;
1137	+	FState := stInit;
1138	+	end;
1139	+
1140	+	stInBlock:
1141	+	begin
1142	+	case token of
1143	+	sqltBegin:
1144	+	Inc(FNested);
1145	+
1146	+	sqltEnd:
1147	+	begin
1148	+	Dec(FNested);
1149	+	if FNested = 0 then
1150	+	FState := stInit;
1151	+	end;
1152	+	end;
1153	+	end;
1154	+
1155	+	stInArrayDim:
1156	+	begin
1157	+	if token = sqltCloseSquareBracket then
1158	+	FState := stInit;
1159	+	end;
1160	+	end;
1161	+
1162	+	Result := (FState <> stInParam);
1163	+	end;
1164	+
1165	+	{ TSQLTokeniser }
1166	+
1167	+	function TSQLTokeniser.GetNext: TSQLTokens;
1168	+	var C: AnsiChar;
1169	+	begin
1170	+	if EOF then
1171	+	Result := sqltEOF
1172	+	else
1173	+	begin
1174	+	C := GetChar;
1175	+	case C of
1176	+	#0:
1177	+	Result := sqltEOF;
1178	+	' ',TAB:
1179	+	Result := sqltSpace;
1180	+	'0'..'9':
1181	+	Result := sqltNumberString;
1182	+	';':
1183	+	Result := sqltSemiColon;
1184	+	'?':
1185	+	Result := sqltPlaceholder;
1186	+	'|':
1187	+	Result := sqltPipe;
1188	+	'"':
1189	+	Result := sqltDoubleQuotes;
1190	+	'''':
1191	+	Result := sqltSingleQuotes;
1192	+	'/':
1193	+	Result := sqltForwardSlash;
1194	+	'\':
1195	+	Result := sqltBackslash;
1196	+	'*':
1197	+	Result := sqltAsterisk;
1198	+	'(':
1199	+	Result := sqltOpenBracket;
1200	+	')':
1201	+	Result := sqltCloseBracket;
1202	+	':':
1203	+	Result := sqltColon;
1204	+	',':
1205	+	Result := sqltComma;
1206	+	'.':
1207	+	Result := sqltPeriod;
1208	+	'=':
1209	+	Result := sqltEquals;
1210	+	'[':
1211	+	Result := sqltOpenSquareBracket;
1212	+	']':
1213	+	Result := sqltCloseSquareBracket;
1214	+	'-':
1215	+	Result := sqltMinus;
1216	+	'<':
1217	+	Result := sqltLT;
1218	+	'>':
1219	+	Result := sqltGT;
1220	+	CR:
1221	+	Result := sqltCR;
1222	+	LF:
1223	+	Result := sqltEOL;
1224	+	else
1225	+	if C in ValidSQLIdentifierChars then
1226	+	Result := sqltIdentifier
1227	+	else
1228	+	Result := sqltOtherCharacter;
1229	+	end;
1230	+	FLastChar := C
1231	+	end;
1232	+	FNextToken := Result;
1233	+	end;
1234	+
1235	+	procedure TSQLTokeniser.PopQueue(var token: TSQLTokens);
1236	+	begin
1237	+	if FQFirst = FQLast then
1238	+	IBError(ibxeTokenQueueUnderflow,[]);
1239	+	token := FTokenQueue[FQFirst].token;
1240	+	FString := FTokenQueue[FQFirst].text;
1241	+	Inc(FQFirst);
1242	+	if FQFirst = FQLast then
1243	+	FQueueState := tsHold;
1244	+	end;
1245	+
1246	+	procedure TSQLTokeniser.Assign(source: TSQLTokeniser);
1247	+	begin
1248	+	FString := source.FString;
1249	+	FNextToken := source.FNextToken;
1250	+	FTokenQueue := source.FTokenQueue;
1251	+	FQueueState := source.FQueueState;
1252	+	FQFirst := source.FQFirst;
1253	+	FQLast := source.FQLast;
1254	+	end;
1255	+
1256	+	function TSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
1257	+	begin
1258	+	Result := (FState = stDefault);
1259	+	if Result and (token = sqltIdentifier)  then
1260	+	FindReservedWord(FString,token);
1261	+	end;
1262	+
1263	+	procedure TSQLTokeniser.QueueToken(token: TSQLTokens; text: AnsiString);
1264	+	begin
1265	+	if FQLast > TokenQueueMaxSize then
1266	+	IBError(ibxeTokenQueueOverflow,[]);
1267	+	FTokenQueue[FQLast].token := token;
1268	+	FTokenQueue[FQLast].text := text;
1269	+	Inc(FQLast);
1270	+	end;
1271	+
1272	+	procedure TSQLTokeniser.QueueToken(token: TSQLTokens);
1273	+	begin
1274	+	QueueToken(token,TokenText);
1275	+	end;
1276	+
1277	+	procedure TSQLTokeniser.ResetQueue;
1278	+	begin
1279	+	FQFirst := 0;
1280	+	FQLast := 0;
1281	+	FQueueState := tsHold;
1282	+	end;
1283	+
1284	+	procedure TSQLTokeniser.ResetQueue(token: TSQLTokens; text: AnsiString);
1285	+	begin
1286	+	ResetQueue;
1287	+	QueueToken(token,text);
1288	+	end;
1289	+
1290	+	procedure TSQLTokeniser.ResetQueue(token: TSQLTokens);
1291	+	begin
1292	+	ResetQueue;
1293	+	QueueToken(token);
1294	+	end;
1295	+
1296	+	procedure TSQLTokeniser.ReleaseQueue(var token: TSQLTokens);
1297	+	begin
1298	+	FQueueState := tsRelease;
1299	+	PopQueue(token);
1300	+	end;
1301	+
1302	+	procedure TSQLTokeniser.ReleaseQueue;
1303	+	begin
1304	+	FQueueState := tsRelease;
1305	+	end;
1306	+
1307	+	function TSQLTokeniser.GetQueuedText: AnsiString;
1308	+	var i: integer;
1309	+	begin
1310	+	Result := '';
1311	+	for i := FQFirst to FQLast do
1312	+	Result := Result + FTokenQueue[i].text;
1313	+	end;
1314	+
1315	+	procedure TSQLTokeniser.SetTokenText(text: AnsiString);
1316	+	begin
1317	+	FString := text;
1318	+	end;
1319	+
1320	+	constructor TSQLTokeniser.Create;
1321	+	begin
1322	+	inherited Create;
1323	+	Reset;
1324	+	end;
1325	+
1326	+	destructor TSQLTokeniser.Destroy;
1327	+	begin
1328	+	Reset;
1329	+	inherited Destroy;
1330	+	end;
1331	+
1332	+	procedure TSQLTokeniser.Reset;
1333	+	begin
1334	+	FNextToken := sqltInit;
1335	+	FState := stDefault;
1336	+	FString := '';
1337	+	FEOF := false;
1338	+	ResetQueue;
1339	+	end;
1340	+
1341	+	function TSQLTokeniser.GetNextToken: TSQLTokens;
1342	+	begin
1343	+	if FQueueState = tsRelease then
1344	+	repeat
1345	+	PopQueue(Result);
1346	+	FEOF := Result = sqltEOF;
1347	+	if TokenFound(Result) then
1348	+	Exit;
1349	+	until FQueueState <> tsRelease;
1350	+
1351	+	Result := InternalGetNextToken;
1352	+	end;
1353	+
1354	+	{a simple lookahead one algorithm to extra the next symbol}
1355	+
1356	+	function TSQLTokeniser.InternalGetNextToken: TSQLTokens;
1357	+	var C: AnsiChar;
1358	+	begin
1359	+	Result := sqltEOF;
1360	+
1361	+	if FNextToken = sqltInit then
1362	+	GetNext;
1363	+
1364	+	repeat
1365	+	Result := FNextToken;
1366	+	C := FLastChar;
1367	+	GetNext;
1368	+
1369	+	if FSkipNext then
1370	+	begin
1371	+	FSkipNext := false;
1372	+	continue;
1373	+	end;
1374	+
1375	+	case FState of
1376	+	stInComment:
1377	+	begin
1378	+	if (Result = sqltAsterisk) and (FNextToken = sqltForwardSlash) then
1379	+	begin
1380	+	FState := stDefault;
1381	+	Result := sqltComment;
1382	+	GetNext;
1383	+	end
1384	+	else
1385	+	FString := FString + C;
1386	+	end;
1387	+
1388	+	stInCommentLine:
1389	+	begin
1390	+	case Result of
1391	+	sqltEOL:
1392	+	begin
1393	+	FState := stDefault;
1394	+	Result := sqltCommentLine;
1395	+	end;
1396	+
1397	+	sqltCR: {ignore};
1398	+
1399	+	else
1400	+	FString := FString + C;
1401	+	end;
1402	+	end;
1403	+
1404	+	stSingleQuoted:
1405	+	begin
1406	+	if (Result = sqltSingleQuotes) then
1407	+	begin
1408	+	if (FNextToken = sqltSingleQuotes) then
1409	+	begin
1410	+	FSkipNext := true;
1411	+	FString := FString + C;
1412	+	end
1413	+	else
1414	+	begin
1415	+	Result := sqltQuotedString;
1416	+	FState := stDefault;
1417	+	end;
1418	+	end
1419	+	else
1420	+	FString := FString + C;
1421	+	end;
1422	+
1423	+	stDoubleQuoted:
1424	+	begin
1425	+	if (Result = sqltDoubleQuotes) then
1426	+	begin
1427	+	if (FNextToken = sqltDoubleQuotes) then
1428	+	begin
1429	+	FSkipNext := true;
1430	+	FString := FString + C;
1431	+	end
1432	+	else
1433	+	begin
1434	+	Result := sqltIdentifierInDoubleQuotes;
1435	+	FState := stDefault;
1436	+	end;
1437	+	end
1438	+	else
1439	+	FString := FString + C;
1440	+	end;
1441	+
1442	+	stInIdentifier:
1443	+	begin
1444	+	FString := FString + C;
1445	+	Result := sqltIdentifier;
1446	+	if not (FNextToken in [sqltIdentifier,sqltNumberString]) then
1447	+	FState := stDefault
1448	+	end;
1449	+
1450	+	stInNumeric:
1451	+	begin
1452	+	FString := FString + C;
1453	+	if (Result = sqltPeriod) and (FNextToken = sqltPeriod) then
1454	+	begin
1455	+	{malformed decimal}
1456	+	FState := stInIdentifier;
1457	+	Result := sqltIdentifier
1458	+	end
1459	+	else
1460	+	begin
1461	+	if not (FNextToken in [sqltNumberString,sqltPeriod]) then
1462	+	FState := stDefault;
1463	+	Result := sqltNumberString;
1464	+	end;
1465	+	end;
1466	+
1467	+	else {stDefault}
1468	+	begin
1469	+	FString := C;
1470	+	case Result of
1471	+
1472	+	sqltPipe:
1473	+	if FNextToken = sqltPipe then
1474	+	begin
1475	+	Result := sqltConcatSymbol;
1476	+	FString := C + FLastChar;
1477	+	GetNext;
1478	+	end;
1479	+
1480	+	sqltForwardSlash:
1481	+	begin
1482	+	if FNextToken = sqltAsterisk then
1483	+	begin
1484	+	FString := '';
1485	+	GetNext;
1486	+	FState := stInComment;
1487	+	end
1488	+	end;
1489	+
1490	+	sqltMinus:
1491	+	begin
1492	+	if FNextToken = sqltMinus then
1493	+	begin
1494	+	FString := '';
1495	+	GetNext;
1496	+	FState := stInCommentLine;
1497	+	end;
1498	+	end;
1499	+
1500	+	sqltSingleQuotes:
1501	+	begin
1502	+	FString := '';
1503	+	FState := stSingleQuoted;
1504	+	end;
1505	+
1506	+	sqltDoubleQuotes:
1507	+	begin
1508	+	FString := '';
1509	+	FState := stDoubleQuoted;
1510	+	end;
1511	+
1512	+	sqltIdentifier:
1513	+	if FNextToken in [sqltIdentifier,sqltNumberString] then
1514	+	FState := stInIdentifier;
1515	+
1516	+	sqltNumberString:
1517	+	if FNextToken in [sqltNumberString,sqltPeriod] then
1518	+	FState := stInNumeric;
1519	+	end;
1520	+	end;
1521	+	end;
1522	+
1523	+	//    writeln(FString);
1524	+	FEOF := Result = sqltEOF;
1525	+	until TokenFound(Result) or EOF;
1526	+	end;
1527	+
1528		end.

Diff Legend

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