ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBSQLParser.pas
Revision: 291
Committed: Fri Apr 17 10:26:08 2020 UTC (3 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 23307 byte(s)
Log Message:
Changed for 2.3.4 merged into public release

File Contents

# Content
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2014 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ______________________________________.
24 *
25 *)
26 unit IBSQLParser;
27
28 {$Mode Delphi}
29
30 {$codepage UTF8}
31
32 interface
33
34 uses Classes, DB, IBUtils;
35
36 {
37 The SQL Parser is a partial SQL Parser intended to parser a Firebird DML (Select)
38 statement with the intention of being able to modify the "Where", Having" and
39 "Order By" clauses. It is not an SQL validator as while invalid SQL may be detected,
40 there are many cases of non-compliant SQL that will still be parsed successfully.
41
42 In use, when a TSelectSQLParser object is created, it is passed a Select SQL Statement
43 that is then parsed into its constituent clauses. CTEs are brought out separately, as is
44 each union. The main clauses are made visible as text properties. Some, such as the
45 order by clause can be replaced fully. The Where and Having Clauses are manipulated by
46 the Add2WhereClause and the Add2HavingClause.
47
48 Add2WhereClause allows an SQL Condition statement (e.g. A = 1) to be appended to the
49 current WhereClause, ANDing or ORing in the new condition. Normally, Add2WhereClause
50 only manipulates the first Select in a UNION, and conditions must be applied separately
51 to each member of the union. However, Add2WhereClause can also apply the same SQL
52 condition to each member of the UNION.
53
54 Add2HavingClause behaves identically, except that it applies to the Having Clause.
55
56 TSelectSQLParser.Reset will return the Where, Having and OrderBy Clauses of all members
57 of the Union to their initial state. ResetWhereClause, ResetHavingClause and
58 ResetOrderByClause allow each clause to be individually reset to their initial
59 state.
60
61 The property SQLText is used to access the current Select SQL statement including
62 CTEs and UNIONs and modified clauses.
63
64 }
65
66 type
67
68 { TSelectSQLTokeniser }
69
70 {The select SQL tokeniser returns each successive clause. The token returned
71 identifies the reserved word that starts the clause. e.g. sqltFrom and the tokentext
72 is the remainder of the clause.}
73
74 TSelectSQLTokeniser = class(TSQLwithNamedParamsTokeniser)
75 private
76 type
77 TSQLState = (stDefault, stWith, stInCTE, stInRecursiveCTE, stCTEAs, stInNextCTE,
78 stInSelect, stInFrom,stInWhere,stInGroupBy,
79 stInHaving,stInPlan, stInUnion, stInUnionAll, stUnionEnd,
80 stInOrderBy, stInRows, stNotASelectStmt);
81
82 TSQLStates = set of TSQLState;
83 private
84 FSQLState: TSQLState;
85 FNested: integer;
86 FNextToken: TSQLTokens;
87 FPrevCTEToken: TSQLTokens;
88 FClause: string;
89 FParamList: TStrings;
90 FHasText: boolean;
91 FUnionMember: boolean;
92 function GetNotaSelectStmt: boolean;
93 protected
94 FCTEName: string;
95 procedure Assign(source: TSQLTokeniser); override;
96 function TokenFound(var token: TSQLTokens): boolean; override;
97 procedure Reset; override;
98 public
99 constructor Create(UnionMember: boolean);
100 destructor Destroy; override;
101 procedure Clear; virtual;
102 property ParamList: TStrings read FParamList;
103 property NotaSelectStmt: boolean read GetNotaSelectStmt;
104 end;
105
106 { TSelectSQLParser }
107
108 TSelectSQLParser = class(TSelectSQLTokeniser)
109 public
110 type
111 PCTEDef = ^TCTEDef;
112 TCTEDef = record
113 Recursive: boolean;
114 Name: string;
115 Text: string;
116 end;
117
118 private
119 FDataSet: TDataSet;
120 FOwner: TSelectSQLParser;
121 FOnSQLChanging: TNotifyEvent;
122 FDestroying: boolean;
123
124 {Properties set after analysis}
125 FSelectClause: string;
126 FFromClause: string;
127 FWhereClause: string;
128 FGroupClause: string;
129 FHavingClause: string;
130 FPlanClause: string;
131 FUnionAll: boolean;
132 FOrderByClause: string;
133 FRowsClause: string;
134 FUnion: TSelectSQLParser;
135 FCTEs: array of PCTEDef;
136
137 {Saved values}
138 FOriginalWhereClause: string;
139 FOriginalOrderByClause: string;
140 FOriginalHavingClause: string;
141
142 {Input buffer}
143 FInString: string;
144 FIndex: integer;
145
146 procedure AnalyseSQL;
147 function GetCTE(Index: integer): PCTEDef;
148 function GetCTECount: integer;
149 function AddCTE(aName: string; Recursive: boolean; text: string): PCTEDef;
150 procedure FlushCTEs;
151 function GetSQLText: string;
152 procedure SetSelectClause(const Value: string);
153 procedure SetOrderByClause(const Value: string);
154 procedure SetGroupClause(const Value: string);
155 procedure SetFromClause(const Value: string);
156 protected
157 constructor Create(aOwner: TSelectSQLParser); overload;
158 procedure Assign(source: TSQLTokeniser); override;
159 procedure Changed;
160 function GetChar: char; override;
161 public
162 constructor Create(aDataSet: TDataSet; SQLText: TStrings); overload;
163 constructor Create(aDataSet: TDataSet; const SQLText: string); overload;
164 destructor Destroy; override;
165 procedure Add2WhereClause(const Condition: string; OrClause: boolean=false;
166 IncludeUnions: boolean = false);
167 procedure Add2HavingClause(const Condition: string; OrClause: boolean=false;
168 IncludeUnions: boolean = false);
169 procedure Clear; override;
170 procedure DropUnion;
171 function GetFieldPosition(AliasName: string): integer;
172 procedure ResetWhereClause;
173 procedure ResetHavingClause;
174 procedure ResetOrderByClause;
175 procedure RestoreClauseValues;
176 property CTEs[Index: integer]: PCTEDef read GetCTE;
177 property CTECount: integer read GetCTECount;
178 property DataSet: TDataSet read FDataSet;
179 property SelectClause: string read FSelectClause write SetSelectClause;
180 property FromClause: string read FFromClause write SetFromClause;
181 property GroupClause: string read FGroupClause write SetGroupClause;
182 property HavingClause: string read FHavingClause write FHavingClause;
183 property PlanClause: string read FPlanClause;
184 property WhereClause: string read FWhereClause write FWhereClause;
185 property OrderByClause: string read FOrderByClause write SetOrderByClause;
186 property RowsClause: string read FRowsClause;
187 property SQLText: string read GetSQLText;
188 property Union: TSelectSQLParser read FUnion;
189 property UnionAll: boolean read FUnionAll write FUnionAll;
190 {When true this is joined by "Union All" to the parent Select}
191 property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
192 end;
193
194 TFilterCallback = procedure(Parser: TSelectSQLParser; Key: integer) of object;
195
196 implementation
197
198 uses Sysutils, IBCustomDataSet, IB, IBMessages;
199
200 { TSelectSQLParser }
201
202 procedure TSelectSQLParser.AnalyseSQL;
203 var token: TSQLTokens;
204 begin
205 while not EOF do
206 begin
207 token := GetNextToken;
208 // writeln('HL: ',token,',',TokenText);
209 case token of
210 sqltSelect:
211 FSelectClause := Trim(TokenText);
212 sqltWith:
213 AddCTE(FCTEName,false,Trim(TokenText));
214 sqltRecursive:
215 AddCTE(FCTEName,true,Trim(TokenText));
216 sqltFrom:
217 FFromClause := Trim(TokenText);
218 sqltWhere:
219 FWhereClause := Trim(TokenText);
220 sqltGroup:
221 FGroupClause := Trim(TokenText);
222 sqltHaving:
223 FHavingClause := Trim(TokenText);
224 sqltPlan:
225 FPlanClause := Trim(TokenText);
226 sqltUnion:
227 begin
228 FUnion := TSelectSQLParser.Create(self);
229 Assign(FUnion); {copy back state}
230 FNextToken := sqltSpace;
231 end;
232 sqltOrder:
233 FOrderByClause := Trim(TokenText);
234 sqltRows:
235 FRowsClause := Trim(TokenText);
236 sqltAll:
237 begin
238 FUnion := TSelectSQLParser.Create(self);
239 FUnion.FUnionAll := true;
240 Assign(FUnion); {copy back state}
241 FNextToken := sqltSpace;
242 end;
243 end;
244 end;
245 FOriginalWhereClause := WhereClause;
246 FOriginalHavingClause := HavingClause;
247 FOriginalOrderByClause := OrderByClause
248 end;
249
250 function TSelectSQLParser.GetCTE(Index: integer): PCTEDef;
251 begin
252 if (Index < 0) or (index >= GetCTECount) then
253 raise Exception.Create('CTE Index out of bounds');
254
255 Result := FCTEs[Index]
256 end;
257
258 function TSelectSQLParser.GetCTECount: integer;
259 begin
260 Result := Length(FCTEs);
261 end;
262
263 function TSelectSQLParser.AddCTE(aName: string; Recursive: boolean; text: string
264 ): PCTEDef;
265 var index: integer;
266 begin
267 new(Result);
268 Result^.Name := aName;
269 Result^.Recursive := Recursive;
270 Result^.text := text;
271 index := Length(FCTEs);
272 SetLength(FCTEs,index+1);
273 FCTEs[index] := Result;
274 end;
275
276 procedure TSelectSQLParser.FlushCTEs;
277 var i: integer;
278 begin
279 for i := 0 to Length(FCTEs) - 1 do
280 dispose(FCTEs[i]);
281 SetLength(FCTEs,0);
282 end;
283
284 function TSelectSQLParser.GetSQLText: string;
285 var SQL: TStringList;
286 I: integer;
287 begin
288 SQL := TStringList.Create;
289 try
290 for I := 0 to CTECount - 1 do
291 begin
292 if I = 0 then
293 begin
294 if CTEs[I]^.Recursive then
295 SQL.Add('WITH RECURSIVE ' + CTEs[I]^.Name + ' AS ' + CTES[I]^.Text )
296 else
297 SQL.Add('WITH ' + CTEs[I]^.Name + ' AS ' + CTES[I]^.Text)
298 end
299 else
300 begin
301 SQL.Strings[SQL.Count-1] := SQL.Strings[SQL.Count-1] + ',';
302 SQL.Add(CTEs[I]^.Name + ' AS ' + CTES[I]^.Text)
303 end
304 end;
305 if CTECount > 0 then
306 SQL.Add('');
307 SQL.Add('SELECT ' + SelectClause);
308 SQL.Add('FROM ' + FromClause);
309 if WhereClause <> '' then
310 SQL.Add('WHERE ' + WhereClause);
311 if GroupClause <> '' then
312 SQL.Add('GROUP BY ' + GroupClause);
313 if HavingClause <> '' then
314 SQL.Add('HAVING ' + HavingClause);
315 if PlanClause <> '' then
316 SQL.Add('PLAN ' + PlanClause);
317 if Union <> nil then
318 begin
319 if Union.UnionAll then
320 SQL.Add('UNION ALL')
321 else
322 SQL.Add('UNION');
323 SQL.Add(Union.SQLText)
324 end;
325 if OrderByClause <> '' then
326 SQL.Add('ORDER BY ' + OrderByClause);
327 if RowsClause <> '' then
328 SQL.Add('ROWS ' + RowsClause);
329 Result := SQL.Text
330 finally
331 SQL.Free
332 end
333 end;
334
335 procedure TSelectSQLParser.SetSelectClause(const Value: string);
336 begin
337 if FSelectClause <> Value then
338 begin
339 FSelectClause := Value;
340 Changed
341 end;
342 end;
343
344 procedure TSelectSQLParser.SetOrderByClause(const Value: string);
345 begin
346 if Union <> nil then
347 Union.OrderByClause := Value
348 else
349 if FOrderByClause <> Value then
350 begin
351 FOrderByClause := Value;
352 Changed
353 end;
354 end;
355
356 procedure TSelectSQLParser.SetGroupClause(const Value: string);
357 begin
358 if FGroupClause <> Value then
359 begin
360 FGroupClause := Value;
361 Changed
362 end;
363 end;
364
365 procedure TSelectSQLParser.SetFromClause(const Value: string);
366 begin
367 if FFromClause <> Value then
368 begin
369 FFromClause := Value;
370 Changed
371 end;
372 end;
373
374 constructor TSelectSQLParser.Create(aOwner: TSelectSQLParser);
375 begin
376 inherited Create(aOwner <> nil);
377 FOwner := aOwner;
378 if assigned(FOwner) then
379 begin
380 FDataSet := FOwner.DataSet;
381 {copy state}
382 Assign(aOwner);
383 end;
384 AnalyseSQL;
385 end;
386
387 procedure TSelectSQLParser.Assign(source: TSQLTokeniser);
388 begin
389 inherited Assign(source);
390 if source is TSelectSQLParser then
391 begin
392 FInString := TSelectSQLParser(source).FInString;
393 FIndex := TSelectSQLParser(source).FIndex;
394 end;
395 end;
396
397 procedure TSelectSQLParser.Changed;
398 begin
399 if FOwner <> nil then
400 FOwner.Changed
401 else
402 if assigned(FOnSQLChanging) and not FDestroying then
403 OnSQLChanging(self)
404 end;
405
406 function TSelectSQLParser.GetChar: char;
407 begin
408 if FIndex <= Length(FInString) then
409 begin
410 Result := FInString[FIndex];
411 Inc(FIndex);
412 end
413 else
414 Result := #0;
415 end;
416
417 constructor TSelectSQLParser.Create(aDataSet: TDataSet; SQLText: TStrings);
418 begin
419 FDataSet := aDataSet;
420 FInString := SQLText.Text;
421 FIndex := 1;
422 Create(nil);
423 end;
424
425 constructor TSelectSQLParser.Create(aDataSet: TDataSet; const SQLText: string);
426 begin
427 FDataSet := aDataSet;
428 FInString := SQLText;
429 FIndex := 1;
430 Create(nil);
431 end;
432
433 destructor TSelectSQLParser.Destroy;
434 begin
435 FDestroying := true;
436 Clear;
437 inherited Destroy;
438 end;
439
440 procedure TSelectSQLParser.Add2WhereClause(const Condition: string;
441 OrClause: boolean; IncludeUnions: boolean);
442 begin
443 if WhereClause <> '' then
444 if OrClause then
445 FWhereClause := '(' + WhereClause + ') OR (' + Condition + ')'
446 else
447 FWhereClause := '(' + WhereClause + ') AND (' + Condition + ')'
448 else
449 FWhereClause := Condition;
450 if IncludeUnions and (Union <> nil) then
451 Union.Add2WhereClause(Condition,OrClause,IncludeUnions);
452 Changed;
453 end;
454
455 procedure TSelectSQLParser.Add2HavingClause(const Condition: string;
456 OrClause: boolean; IncludeUnions: boolean);
457 begin
458 if HavingClause <> '' then
459 if OrClause then
460 FHavingClause := '(' + HavingClause + ') OR (' + Condition + ')'
461 else
462 FHavingClause := '(' + HavingClause + ') AND (' + Condition + ')'
463 else
464 FHavingClause := Condition;
465 if IncludeUnions and (Union <> nil) then
466 Union.Add2HavingClause(Condition,OrClause,IncludeUnions);
467 Changed;
468 end;
469
470 procedure TSelectSQLParser.Clear;
471 begin
472 inherited Clear;
473 DropUnion;
474 FlushCTEs;
475 FInString := '';
476 FIndex := 1;
477 FSelectClause := '';
478 FFromClause := '';
479 FWhereClause := '';
480 FGroupClause := '';
481 FHavingClause := '';
482 FPlanClause := '';
483 FUnionAll := false;
484 FOrderByClause := '';
485 FOriginalWhereClause := '';
486 FOriginalOrderByClause := '';
487 FOriginalHavingClause := '';
488 end;
489
490 procedure TSelectSQLParser.DropUnion;
491 begin
492 if FUnion <> nil then
493 begin
494 FUnion.Free;
495 FUnion := nil;
496 Changed
497 end
498 end;
499
500 function TSelectSQLParser.GetFieldPosition(AliasName: string): integer;
501 begin
502 if assigned(FDataSet) and (FDataSet is TIBCustomDataset) then
503 Result := TIBCustomDataset(FDataSet).GetFieldPosition(AliasName)
504 else
505 Result := 0;
506 end;
507
508 procedure TSelectSQLParser.ResetWhereClause;
509 begin
510 FWhereClause := FOriginalWhereClause;
511 if Union <> nil then
512 Union.ResetWhereClause;
513 Changed
514 end;
515
516 procedure TSelectSQLParser.ResetHavingClause;
517 begin
518 FHavingClause := FOriginalHavingClause;
519 if Union <> nil then
520 Union.ResetHavingClause;
521 Changed
522 end;
523
524 procedure TSelectSQLParser.ResetOrderByClause;
525 begin
526 FOrderbyClause := FOriginalOrderByClause;
527 if Union <> nil then
528 Union.ResetOrderByClause;
529 Changed
530 end;
531
532 procedure TSelectSQLParser.RestoreClauseValues;
533 begin
534 ResetWhereClause;
535 ResetHavingClause;
536 ResetOrderByClause
537 end;
538
539 { TSelectSQLTokeniser }
540
541 function TSelectSQLTokeniser.GetNotaSelectStmt: boolean;
542 begin
543 Result := FSQLState = stNotASelectStmt;
544 end;
545
546 procedure TSelectSQLTokeniser.Assign(source: TSQLTokeniser);
547 begin
548 inherited Assign(source);
549 if source is TSelectSQLTokeniser then
550 begin
551 FSQLState := TSelectSQLTokeniser(source).FSQLState;
552 FNested := TSelectSQLTokeniser(source).FNested;
553 FNextToken := TSelectSQLTokeniser(source).FNextToken;
554 FPrevCTEToken := TSelectSQLTokeniser(source).FPrevCTEToken;
555 FClause := TSelectSQLTokeniser(source).FClause;
556 end;
557 end;
558
559 function TSelectSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
560
561 procedure swap(var a,b: TSQLTokens);
562 var c: TSQLTokens;
563 begin
564 c:= a;
565 a := b;
566 b := c;
567 end;
568
569 procedure ChangeState(AllowStates: TSQLStates; DoNesting: boolean);
570 var SaveState: TSQLState;
571 begin
572 SaveState := FSQLState;
573 if DoNesting then
574 case token of
575 sqltOpenBracket:
576 begin
577 Inc(FNested);
578 Exit;
579 end;
580
581 sqltCloseBracket:
582 Begin
583 Dec(FNested);
584 Exit;
585 end;
586 end;
587
588 if FNested = 0 then
589 case token of
590 sqltFrom:
591 FSQLState := stInFrom;
592
593 sqltWhere:
594 FSQLState := stInWhere;
595
596 sqltGroup:
597 FSQLState := stInGroupBy;
598
599 sqltHaving:
600 FSQLState := stInHaving;
601
602 sqltPlan:
603 FSQLState := stInPlan;
604
605 sqltUnion:
606 FSQLState := stInUnion;
607
608 sqltOrder:
609 begin
610 if FUnionMember then
611 {stop and return to owning object}
612 begin
613 ResetQueue(sqltEOF,'');
614 QueueToken(token);
615 ReleaseQueue;
616 token := sqltEOF;
617 FSQLState := stUnionEnd;
618 end
619 else
620 FSQLState := stInOrderBy;
621 end;
622
623 sqltRows:
624 if FUnionMember then
625 {stop and return to owning object}
626 begin
627 ResetQueue(sqltEOF,'');
628 QueueToken(token);
629 ReleaseQueue;
630 token := sqltEOF;
631 FSQLState := stUnionEnd;
632 end
633 else
634 FSQLState := stInRows;
635
636 sqltAll:
637 FSQLState := stInUnionAll;
638 end;
639 if not (FSQLState in AllowStates + [stDefault]) then
640 FSQLState := SaveState
641 else
642 if SaveState <> FSQLState then
643 swap(token,FNextToken);
644 end;
645
646 var StateOnEntry: TSQLState;
647 DoNotReturnToken: boolean;
648
649 function TokenIncomplete: boolean;
650 begin
651 {we are not done if we are in not the default state and no state change,
652 unless we are a union member and the state is stUnionEnd}
653 Result := (FUnionMember and (StateOnEntry = stUnionEnd)) or
654 ((StateOnEntry = stDefault) or (StateOnEntry = FSQLState));
655 end;
656
657 begin
658 Result := inherited TokenFound(token);
659 if not Result or NotaSelectStmt then Exit;
660
661 // writeln(token);
662 StateOnEntry := FSQLState;
663 DoNotReturnToken := false;
664
665 if not (token in [sqltComment,sqltCommentLine]) then
666 begin
667 if token in [sqltParam, sqltQuotedParam] then
668 FParamList.Add(TokenText);
669
670 if (token = sqltEOF) or ((FNested = 0) and
671 not (token in [sqltQuotedString,sqltIdentifierInDoubleQuotes]) and
672 (TokenText = DefaultTerminator)) then
673 begin
674 if not FHasText then
675 FSQLState := stNotASelectStmt {empty statements are not select statements}
676 else
677 if FSQLState <> stUnionEnd then
678 FSQLState := stDefault;
679 swap(token,FNextToken);
680 end
681 else
682 if not (token in [sqltSpace,sqltEOL,sqltCR]) then
683 case FSQLState of
684 stDefault:
685 begin
686 if FNested = 0 then {not inside a pair of brackets}
687 case token of
688 sqltSelect:
689 FSQLState := stInSelect;
690
691 sqltWith:
692 FSQLState := stWith;
693
694 else
695 FSQLState := stNotASelectStmt;
696 end;
697 FNextToken := token;
698 end;
699
700 stWith:
701 begin
702 case token of
703 sqltRecursive:
704 begin
705 FSQLState := stInRecursiveCTE;
706 FNextToken := token;
707 end;
708
709 sqltIdentifier:
710 begin
711 FCTEName := TokenText;
712 FSQLState := stCTEAs;
713 FPrevCTEToken := FNextToken;
714 token := FNextToken;
715 end
716
717 else
718 IBError(ibxErrorParsing,['with']);
719 end;
720 DoNotReturnToken := true;
721 end;
722
723 stInRecursiveCTE:
724 case token of
725 sqltIdentifier:
726 begin
727 FCTEName := TokenText;
728 FSQLState := stCTEAs;
729 token := FNextToken;
730 FPrevCTEToken := FNextToken;
731 DoNotReturnToken := true;
732 end;
733
734 else
735 IBError(ibxErrorParsing,['with recursive']);
736 end;
737
738 stInNextCTE:
739 case token of
740 sqltIdentifier:
741 begin
742 FCTEName := TokenText;
743 FSQLState := stCTEAs;
744 token := FPrevCTEToken;
745 DoNotReturnToken := true;
746 end;
747
748 else
749 IBError(ibxErrorParsing,['with']);
750 end;
751
752 stCTEAs:
753 if token = sqltAs then
754 begin
755 FSQLState := stInCTE;
756 DoNotReturnToken := true;
757 end
758 else
759 IBError(ibxErrorParsing,['with']);
760
761 stInCTE:
762 begin
763 case token of
764 sqltOpenBracket:
765 Inc(FNested);
766
767 sqltCloseBracket:
768 Dec(FNested);
769
770 sqltComma:
771 if FNested = 0 then
772 begin
773 FSQLState := stInNextCTE;
774 token := FNextToken;
775 end;
776
777 sqltSelect:
778 if FNested = 0 then
779 begin
780 FSQLState := stInSelect;
781 swap(FNextToken,token);
782 end;
783 end;
784 end;
785
786 stInSelect:
787 ChangeState([stInFrom],true);
788
789 stInFrom:
790 ChangeState([stInWhere,stInGroupBy, stInHaving,stInPlan, stInUnion,stUnionEnd,
791 stInOrderBy, stInRows],true);
792
793 stInWhere:
794 ChangeState([stInGroupBy, stInHaving,stInPlan, stInUnion,stUnionEnd,
795 stInOrderBy, stInRows],true);
796
797 stInGroupBy:
798 if token = sqltBy then
799 begin
800 FClause := '';
801 SetTokenText('');
802 DoNotReturnToken := true;
803 end
804 else
805 ChangeState([stInHaving,stInPlan, stInUnion, stUnionEnd, stInOrderBy, stInRows],false);
806
807 stInHaving:
808 ChangeState([stInPlan, stInUnion, stUnionEnd, stInOrderBy, stInRows],true);
809
810 stInPlan:
811 ChangeState([stInUnion, stUnionEnd, stInOrderBy, stInRows],true);
812
813 stInUnion:
814 case token of
815 sqltAll:
816 begin
817 FSQLState := stDefault;
818 FNextToken := token;
819 end;
820 else
821 begin
822 ResetQueue(token);
823 ReleaseQueue;
824 swap(token,FNextToken);
825 FSQLState := stDefault;
826 end;
827 end;
828
829 stUnionEnd: {On return from union clause}
830 ChangeState([stInOrderBy, stInRows],false);
831
832 stInOrderBy:
833 if token = sqltBy then
834 begin
835 FClause := '';
836 SetTokenText('');
837 DoNotReturnToken := true;
838 end
839 else
840 ChangeState([stInRows],false);
841
842 stInRows:
843 ChangeState([],false);
844
845 end;
846
847 {On EOF or state change return the next element, otherwise just add to text buffer}
848
849 if (token <> sqltEOF) and TokenIncomplete then
850 begin
851 if StateOnEntry <> stDefault then
852 case token of
853 sqltQuotedString:
854 FClause += '''' + SQLSafeString(TokenText) + '''';
855
856 sqltIdentifierInDoubleQuotes:
857 FClause += '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
858
859 sqltParam:
860 FClause += ':' + TokenText;
861
862 sqltQuotedParam:
863 FClause += ':"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
864
865 else
866 FClause += TokenText;
867 end;
868 DoNotReturnToken := true;
869 end
870 else
871 begin
872 FHasText := true;
873 SetTokenText(FClause);
874 FClause := '';
875 end;
876
877 end;
878 Result := not DoNotReturnToken ;
879 end;
880
881 procedure TSelectSQLTokeniser.Reset;
882 begin
883 inherited Reset;
884 FSQLState := stDefault;
885 FNested := 0;
886 FNextToken := sqltSpace;
887 end;
888
889 constructor TSelectSQLTokeniser.Create(UnionMember: boolean);
890 begin
891 inherited Create;
892 FUnionMember := UnionMember;
893 FParamList := TStringList.Create;
894 end;
895
896 destructor TSelectSQLTokeniser.Destroy;
897 begin
898 if assigned(FParamList) then FParamList.Free;
899 FParamList := nil;
900 inherited Destroy;
901 end;
902
903 procedure TSelectSQLTokeniser.Clear;
904 begin
905 Reset;
906 FHasText := false;
907 if assigned(FParamList) then
908 FParamList.Clear;
909 end;
910
911
912
913 end.
914
915