ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBSQLParser.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 25801 byte(s)
Log Message:
Fixes Merged

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;
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 TSQLSymbol = (sqNone,sqSpace,sqSemiColon,sqSingleQuotes,sqDoubleQuotes, sqComma,
68 sqString,sqCommentStart,sqUnion,sqAll,sqColon,
69 sqCommentEnd,sqCommentLine,sqAsterisk,sqForwardSlash,
70 sqSelect,sqFrom,sqWhere,sqGroup,sqOrder,sqBy,sqOpenBracket,
71 sqCloseBracket,sqHaving,sqPlan,sqEOL,sqWith,sqRecursive,sqAs);
72
73 TSQLStates = (stInit, stError, stInSelect,stInFrom,stInWhere,stInGroupBy,
74 stInHaving,stInPlan, stNestedSelect,stInSingleQuotes, stInGroup,
75 stInDoubleQuotes, stInComment, stInCommentLine, stInOrder,
76 stNestedWhere,stNestedFrom,stInOrderBy,stDone,stUnion,
77 stInParam,stNestedGroupBy,stCTE,stCTE1,stCTE2,stCTE3, stCTEquoted,
78 stInCTE,stCTEClosed);
79
80 PCTEDef = ^TCTEDef;
81 TCTEDef = record
82 Recursive: boolean;
83 Name: string;
84 Text: string;
85 end;
86
87 { TSelectSQLParser }
88
89 TSelectSQLParser = class
90 private
91 FDataSet: TDataSet;
92 FHavingClause: string;
93 FOriginalHavingClause: string;
94 FOnSQLChanging: TNotifyEvent;
95 FSelectClause: string;
96 FGroupClause: string;
97 FUnionAll: boolean;
98 FWhereClause: string;
99 FOriginalWhereClause: string;
100 FOrderByClause: string;
101 FOriginalOrderByClause: string;
102 FPlanClause: string;
103 FFromClause: string;
104 FState: TSQLStates;
105 FString: string;
106 FLastSymbol: TSQLSymbol;
107 FLastChar: char;
108 FStack: array [0..16] of TSQLStates;
109 FStackindex: integer;
110 FIndex: integer;
111 FStartLine: integer;
112 FUnion: TSelectSQLParser;
113 FAllowUnionAll: boolean;
114 FLiteral: string;
115 FParamList: TStringList;
116 FCTEs: TList;
117 FCTE: TCTEDef;
118 FNested: integer;
119 FDestroying: boolean;
120 FOwner: TSelectSQLParser;
121 procedure AddToSQL(const Word: string);
122 procedure CTEClear;
123 function GetCTE(Index: integer): PCTEDef;
124 function GetCTECount: integer;
125 function GetSQlText: string;
126 function Check4ReservedWord(const Text: string): TSQLSymbol;
127 procedure AnalyseLine(const Line: string);
128 procedure AnalyseSQL(Lines: TStrings);
129 procedure InitCTE;
130 procedure AddCTE;
131 function GetNextSymbol(C: char): TSQLSymbol;
132 function GetSymbol(const Line: string; var index: integer): TSQLSymbol;
133 function PopState: TSQLStates;
134 procedure SetState(AState: TSQLStates);
135 procedure SetSelectClause(const Value: string);
136 procedure SetOrderByClause(const Value: string);
137 procedure SetGroupClause(const Value: string);
138 procedure SetFromClause(const Value: string);
139 protected
140 constructor Create(aOwner: TSelectSQLParser; SQLText: TStrings; StartLine, StartIndex: integer); overload;
141 procedure Changed;
142 public
143 constructor Create(aDataSet: TDataSet; SQLText: TStrings); overload;
144 constructor Create(aDataSet: TDataSet; const SQLText: string); overload;
145 destructor Destroy; override;
146 procedure Add2WhereClause(const Condition: string; OrClause: boolean=false;
147 IncludeUnions: boolean = false);
148 procedure Add2HavingClause(const Condition: string; OrClause: boolean=false;
149 IncludeUnions: boolean = false);
150 procedure DropUnion;
151 function GetFieldPosition(AliasName: string): integer;
152 procedure ResetWhereClause;
153 procedure ResetHavingClause;
154 procedure ResetOrderByClause;
155 procedure Reset;
156 property CTEs[Index: integer]: PCTEDef read GetCTE;
157 property CTECount: integer read GetCTECount;
158 property DataSet: TDataSet read FDataSet;
159 property SelectClause: string read FSelectClause write SetSelectClause;
160 property FromClause: string read FFromClause write SetFromClause;
161 property GroupClause: string read FGroupClause write SetGroupClause;
162 property HavingClause: string read FHavingClause write FHavingClause;
163 property PlanClause: string read FPlanClause;
164 property WhereClause: string read FWhereClause write FWhereClause;
165 property OrderByClause: string read FOrderByClause write SetOrderByClause;
166 property SQLText: string read GetSQLText;
167 property Union: TSelectSQLParser read FUnion;
168 property UnionAll: boolean read FUnionAll write FUnionAll;
169 {When true this is joined by "Union All" to the parent Select}
170 property ParamList: TStringList read FParamList;
171 property OnSQLChanging: TNotifyEvent read FOnSQLChanging write FOnSQLChanging;
172 end;
173
174 TFilterCallback = procedure(Parser: TSelectSQLParser; Key: integer) of object;
175
176 implementation
177
178 uses Sysutils, IBCustomDataSet;
179
180 resourcestring
181 sBadBy = 'Unexpected symbol "BY" in: %s';
182 sBadSymbol = 'Unknown Symbol';
183 sIncomplete = 'Incomplete Union';
184 sBadSQL = 'Error processing SQL "%s" - %s';
185 sStackUnderFlow = 'Stack Underflow';
186 sStackOverFlow = 'Stack Overflow';
187 sBadParameter = 'Bad SQL Parameter';
188
189 { TSelectSQLParser }
190
191 procedure TSelectSQLParser.AddToSQL(const Word: string);
192 begin
193 case FState of
194 stNestedSelect,
195 stInSelect:
196 FSelectClause := FSelectClause + Word;
197 stNestedFrom,
198 stInFrom:
199 FFromClause := FFromClause + Word;
200 stNestedWhere,
201 stInWhere:
202 FWhereClause := FWhereClause + Word;
203 stNestedGroupBy,
204 stInGroupBy:
205 FGroupClause := FGroupClause + Word;
206 stInHaving:
207 FHavingClause := FHavingClause + Word;
208 stInPlan:
209 FPlanClause := FPlanClause + Word;
210 stInOrderBy:
211 FOrderByClause := FOrderByClause + Word;
212 stInDoubleQuotes,
213 stInSingleQuotes:
214 FLiteral := FLiteral + Word;
215 stInCTE:
216 FCTE.Text := FCTE.Text + Word;
217 stCTE2:
218 FCTE.Name := Trim(FCTE.Name + Word);
219 end;
220 end;
221
222 procedure TSelectSQLParser.CTEClear;
223 var i: integer;
224 begin
225 for i := 0 to FCTEs.Count - 1 do
226 dispose(PCTEDef(FCTEs[i]));
227 FCTEs.Clear;
228 end;
229
230 function TSelectSQLParser.GetCTE(Index: integer): PCTEDef;
231 begin
232 if (Index < 0) or (index >= FCTEs.Count) then
233 raise Exception.Create('CTE Index out of bounds');
234
235 Result := FCTEs[Index]
236 end;
237
238 function TSelectSQLParser.GetCTECount: integer;
239 begin
240 Result := FCTEs.Count;
241 end;
242
243 procedure TSelectSQLParser.Add2WhereClause(const Condition: string;
244 OrClause: boolean; IncludeUnions: boolean);
245 begin
246 if WhereClause <> '' then
247 if OrClause then
248 FWhereClause := '(' + WhereClause + ') OR (' + Condition + ')'
249 else
250 FWhereClause := '(' + WhereClause + ') AND (' + Condition + ')'
251 else
252 FWhereClause := Condition;
253 if IncludeUnions and (Union <> nil) then
254 Union.Add2WhereClause(Condition,OrClause,IncludeUnions);
255 Changed;
256 end;
257
258 procedure TSelectSQLParser.Add2HavingClause(const Condition: string;
259 OrClause: boolean; IncludeUnions: boolean);
260 begin
261 if HavingClause <> '' then
262 if OrClause then
263 FHavingClause := '(' + HavingClause + ') OR (' + Condition + ')'
264 else
265 FHavingClause := '(' + HavingClause + ') AND (' + Condition + ')'
266 else
267 FHavingClause := Condition;
268 if IncludeUnions and (Union <> nil) then
269 Union.Add2HavingClause(Condition,OrClause,IncludeUnions);
270 Changed;
271 end;
272
273 procedure TSelectSQLParser.AnalyseLine(const Line: string);
274 var Symbol: TSQLSymbol;
275 begin
276 while true do
277 begin
278 if FState = stError then
279 raise Exception.Create('Entered Error State');
280 Symbol := GetSymbol(Line,FIndex);
281 if (FState = stInParam) and (Symbol <> sqString) then
282 raise Exception.Create(sBadParameter);
283
284 case Symbol of
285 sqSpace:
286 if not (FState in [stInComment,stInCommentLine]) then
287 AddToSQL(' ');
288
289 sqColon:
290 if not (FState in [stInComment,stInCommentLine]) then
291 begin
292 AddToSQL(':');
293 if not (FState in [stInSingleQuotes,stInDoubleQuotes]) then
294 SetState(stInParam);
295 end;
296
297 sqSemiColon:
298 if not (FState in [stInComment,stInCommentLine]) then
299 case FState of
300 stInWhere,stInGroupBy,
301 stInHaving,stInPlan,stInFrom:
302 begin
303 FState := stDone;
304 Exit
305 end;
306
307 stInSingleQuotes, stInDoubleQuotes:
308 AddToSQL(';');
309
310 else
311 raise Exception.Create('Unexpected ";"')
312 end;
313
314 sqAsterisk:
315 if not (FState in [stInComment,stInCommentLine]) then
316 AddToSQL('*');
317
318 sqForwardSlash:
319 if not (FState in [stInComment,stInCommentLine]) then
320 AddToSQL('/');
321
322 sqOpenBracket:
323 if not (FState in [stInComment,stInCommentLine]) then
324 begin
325 if FNested = 0 then
326 case FState of
327 stInSelect,
328 stNestedSelect:
329 SetState(stNestedSelect);
330
331 stInFrom,
332 stNestedFrom:
333 SetState(stNestedFrom);
334
335 stInWhere,
336 stNestedWhere:
337 SetState(stNestedWhere);
338
339 stInGroupBy,
340 stNestedGroupBy:
341 SetState(stNestedGroupBy);
342
343 stCTE3:
344 begin
345 FState := stCTEClosed;
346 SetState(stInCTE);
347 end;
348 end;
349 if (FNested > 0 ) or (FState <> stInCTE) then
350 AddToSQL('(');
351 Inc(FNested);
352 end;
353
354 sqCloseBracket:
355 if not (FState in [stInComment,stInCommentLine]) then
356 begin
357 Dec(FNested);
358 if (FNested > 0) or (FState <> stInCTE) then
359 AddToSQL(')');
360 if FNested = 0 then
361 begin
362 if FState = stInCTE then
363 FState := PopState
364 else
365 if FState in [stNestedSelect,stNestedFrom,stNestedWhere,stNestedGroupBy] then
366 FState := PopState;
367 end;
368 if FState = stCTEClosed then
369 AddCTE;
370 end;
371
372 sqComma:
373 if FState = stCTEClosed then
374 FState := stCTE
375 else
376 AddToSQL(',');
377
378 sqCommentStart:
379 if not (FState in [stInComment,stInCommentLine]) then
380 SetState(stInComment);
381
382 sqCommentEnd:
383 if FState = stInComment then
384 FState := PopState
385 else
386 FState := stError;
387
388 sqCommentLine:
389 if not (FState in [stInComment,stInCommentLine]) then
390 SetState(stInCommentLine);
391
392 sqSingleQuotes:
393 if not (FState in [stInComment,stInCommentLine]) then
394 begin
395 case FState of
396 stInSingleQuotes:
397 begin
398 FState := PopState;
399 AddToSQL(FLiteral)
400 end;
401 stInDoubleQuotes:
402 {Ignore};
403 else
404 begin
405 FLiteral := '';
406 SetState(stInSingleQuotes)
407 end
408 end;
409 AddToSQL('''')
410 end;
411
412 sqDoubleQuotes:
413 if not (FState in [stInComment,stInCommentLine]) then
414 begin
415 case FState of
416 stInSingleQuotes:
417 {Ignore};
418 stInDoubleQuotes:
419 begin
420 FState := PopState;
421 AddToSQL(FLiteral)
422 end;
423 else
424 begin
425 FLiteral := '';
426 SetState(stInDoubleQuotes)
427 end
428 end;
429 AddToSQL('"')
430 end;
431
432 sqString:
433 if not (FState in [stInComment,stInCommentLine]) then
434 begin
435 if FState = stInParam then
436 begin
437 FState := PopState;
438 ParamList.Add(FString)
439 end
440 else
441 if FState in [stCTE, stCTE1] then
442 FState := stCTE2;
443 AddToSQL(FString)
444 end;
445
446 sqEOL:
447 begin
448 case FState of
449 stInCommentLine:
450 FState := PopState;
451 stInDoubleQuotes,
452 stInSingleQuotes:
453 Begin
454 FLiteral := FLiteral + #$0A;
455 Exit;
456 End;
457 end;
458 AddToSQL(' ');
459 Exit;
460 end;
461
462 sqSelect:
463 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stNestedSelect,stInCTE] then
464 AddToSql(FString)
465 else
466 FState := stInSelect;
467
468 sqFrom:
469 if FState = stInSelect then
470 FState := stInFrom
471 else
472 AddToSql(FString);
473 { if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,
474 stNestedGroupBy,stNestedSelect] then
475 AddToSql(FString)
476 else
477 FState := stInFrom;}
478
479 sqGroup:
480 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stInCTE] then
481 AddToSql(FString)
482 else
483 FState := stInGroup;
484
485 sqWhere:
486 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stNestedSelect,stInCTE] then
487 AddToSql(FString)
488 else
489 FState := stInWhere;
490
491 sqHaving:
492 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stInCTE] then
493 AddToSql(FString)
494 else
495 FState := stInHaving;
496
497 sqPlan:
498 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stInCTE] then
499 AddToSql(FString)
500 else
501 FState := stInPlan;
502
503 sqOrder:
504 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere] then
505 AddToSql(FString)
506 else
507 FState := stInOrder;
508
509 sqUnion:
510 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stInCTE] then
511 AddToSql(FString)
512 else
513 begin
514 FState := stUnion;
515 Exit
516 end;
517
518 sqAll:
519 if FState in [stInSingleQuotes,stInDoubleQuotes,stNestedFrom,stNestedWhere,stInCTE] then
520 AddToSql(FString)
521 else
522 if (FState = stInit) and FAllowUnionAll and not FUnionAll then
523 FUnionAll := true
524 else
525 raise Exception.Create('Unexpected symbol "all"');
526
527 sqBy:
528 case FState of
529 stInGroup:
530 FState := stInGroupBy;
531 stInOrder:
532 FState := stInOrderBy;
533 stNestedFrom,stNestedWhere,stInCTE,
534 stInSingleQuotes,
535 stInDoubleQuotes:
536 AddToSql(FString);
537 else
538 raise Exception.CreateFmt(sBadBy,[Line])
539 end;
540
541 sqWith:
542 if FState = stInit then
543 begin
544 FState := stCTE;
545 InitCTE;
546 end
547 else
548 raise Exception.Create('Unexpected symbol "with"');
549
550 sqRecursive:
551 if FState = stCTE then
552 begin
553 FCTE.Recursive := true;
554 FState := stCTE1
555 end
556 else
557 raise Exception.Create('Unexpected symbol "recursive"');
558
559 sqAs:
560 if FState = stCTE2 then
561 FState := stCTE3
562 else
563 AddToSQL('as');
564
565 else
566 raise Exception.Create(sBadSymbol);
567 end
568 end
569 end;
570
571 procedure TSelectSQLParser.AnalyseSQL(Lines: TStrings);
572 var I: integer;
573 begin
574 try
575 for I := FStartLine to Lines.Count - 1 do
576 try
577 AnalyseLine(Lines[I]);
578 case FState of
579 stDone:
580 break;
581 stUnion:
582 begin
583 if FIndex > length(Lines[I]) then
584 if I+1 < Lines.Count then
585 FUnion := TSelectSQLParser.Create(self,Lines,I+1,1)
586 else
587 raise Exception.Create(sIncomplete)
588 else
589 FUnion := TSelectSQLParser.Create(self,Lines,I,FIndex);
590 Exit
591 end;
592 end;
593 FIndex := 1;
594 except on E: Exception do
595 raise Exception.CreateFmt(sBadSQL,[Lines[I],E.Message])
596 end;
597 finally
598 FOriginalWhereClause := WhereClause;
599 FOriginalHavingClause := HavingClause;
600 FOriginalOrderByClause := OrderByClause
601 end;
602 end;
603
604 procedure TSelectSQLParser.InitCTE;
605 begin
606 with FCTE do
607 begin
608 Recursive := false;
609 Name := '';
610 Text := '';
611 end;
612 end;
613
614 procedure TSelectSQLParser.AddCTE;
615 var cte: PCTEDef;
616 begin
617 new(cte);
618 cte^.Name := FCTE.Name;
619 cte^.Recursive := FCTE.Recursive;
620 cte^.Text := FCTE.Text;
621 FCTEs.add(cte);
622 InitCTE;
623 end;
624
625 function TSelectSQLParser.Check4ReservedWord(const Text: string): TSQLSymbol;
626 begin
627 Result := sqString;
628 if CompareText(Text,'select') = 0 then
629 Result := sqSelect
630 else
631 if CompareText(Text,'from') = 0 then
632 Result := sqFrom
633 else
634 if CompareText(Text,'where') = 0 then
635 Result := sqWhere
636 else
637 if CompareText(Text,'group') = 0 then
638 Result := sqGroup
639 else
640 if CompareText(Text,'by') = 0 then
641 Result := sqBy
642 else
643 if CompareText(Text,'having') = 0 then
644 Result := sqHaving
645 else
646 if CompareText(Text,'plan') = 0 then
647 Result := sqPlan
648 else
649 if CompareText(Text,'union') = 0 then
650 Result := sqUnion
651 else
652 if CompareText(Text,'all') = 0 then
653 Result := sqAll
654 else
655 if CompareText(Text,'order') = 0 then
656 Result := sqOrder
657 else
658 if CompareText(Text,'with') = 0 then
659 Result := sqWith
660 else
661 if CompareText(Text,'recursive') = 0 then
662 Result := sqRecursive
663 else
664 if CompareText(Text,'as') = 0 then
665 Result := sqAs
666 end;
667
668 constructor TSelectSQLParser.Create(aDataSet: TDataSet; SQLText: TStrings);
669 begin
670 FDataSet := aDataSet;
671 Create(nil,SQLText,0,1)
672 end;
673
674 constructor TSelectSQLParser.Create(aDataSet: TDataSet; const SQLText: string);
675 var Lines: TStringList;
676 begin
677 Lines := TStringList.Create;
678 try
679 Lines.Text := SQLText;
680 Create(aDataSet,Lines)
681 finally
682 Lines.Free
683 end
684 end;
685
686 constructor TSelectSQLParser.Create(aOwner: TSelectSQLParser;
687 SQLText: TStrings; StartLine, StartIndex: integer);
688 begin
689 inherited Create;
690 FOwner := aOwner;
691 FParamList := TStringList.Create;
692 FCTEs := TList.Create;
693 FLastSymbol := sqNone;
694 FState := stInit;
695 FStartLine := StartLine;
696 FIndex := StartIndex;
697 FAllowUnionAll := true;
698 AnalyseSQL(SQLText);
699 end;
700
701 procedure TSelectSQLParser.Changed;
702 begin
703 if FOwner <> nil then
704 FOwner.Changed
705 else
706 if assigned(FOnSQLChanging) and not FDestroying then
707 OnSQLChanging(self)
708 end;
709
710 function TSelectSQLParser.GetNextSymbol(C: char): TSQLSymbol;
711 begin
712 case C of
713 ' ',#9:
714 Result := sqSpace;
715 ';':
716 Result := sqSemiColon;
717 '"':
718 Result := sqDoubleQuotes;
719 '''':
720 Result := sqSingleQuotes;
721 '/':
722 Result := sqForwardSlash;
723 '*':
724 Result := sqAsterisk;
725 '(':
726 Result := sqOpenBracket;
727 ')':
728 Result := sqCloseBracket;
729 ':':
730 Result := sqColon;
731 ',':
732 Result := sqComma;
733 else
734 begin
735 Result := sqString;
736 FLastChar := C
737 end
738 end
739 end;
740
741 function TSelectSQLParser.GetSymbol(const Line: string; var index: integer): TSQLSymbol;
742 begin
743 Result := FLastSymbol;
744 if Result = sqString then
745 FString := FLastChar;
746 FLastSymbol := sqNone;
747
748 while (index <= Length(Line)) and (FLastSymbol = sqNone) do
749 begin
750 FLastSymbol := GetNextSymbol(Line[index]);
751 {combine if possible}
752 case Result of
753 sqNone:
754 begin
755 Result := FLastSymbol;
756 if FLastSymbol = sqString then
757 FString := FLastChar;
758 FLastSymbol := sqNone
759 end;
760
761 sqSpace:
762 if FLastSymbol = sqSpace then
763 FLastSymbol := sqNone;
764
765 sqForwardSlash:
766 if FLastSymbol = sqAsterisk then
767 begin
768 Result := sqCommentStart;
769 FLastSymbol := sqNone
770 end
771 else
772 if FLastSymbol = sqForwardSlash then
773 begin
774 Result := sqCommentLine;
775 FLastSymbol := sqNone
776 end;
777
778 sqAsterisk:
779 if FLastSymbol = sqForwardSlash then
780 begin
781 Result := sqCommentEnd;
782 FLastSymbol := sqNone
783 end;
784
785 sqString:
786 if FLastSymbol = sqString then
787 begin
788 FString := FString + FLastChar;
789 FLastSymbol := sqNone
790 end;
791 end;
792 Inc(index)
793 end;
794
795 if (Result = sqString) and not (FState in [stInComment,stInCommentLine, stInSingleQuotes,stInDoubleQuotes])then
796 Result := Check4ReservedWord(FString);
797
798 if (index > Length(Line)) then
799 begin
800 if (Result = sqNone) then
801 Result := sqEOL
802 else
803 if (FLastSymbol = sqNone) and (Result <> sqEOL) then
804 FLastSymbol := sqEOL;
805 end;
806
807 end;
808
809 function TSelectSQLParser.GetSQlText: string;
810 var SQL: TStringList;
811 I: integer;
812 begin
813 SQL := TStringList.Create;
814 try
815 for I := 0 to CTECount - 1 do
816 begin
817 if I = 0 then
818 begin
819 if CTEs[I]^.Recursive then
820 SQL.Add('WITH RECURSIVE ' + CTEs[I]^.Name + ' AS (' + CTES[I]^.Text + ')')
821 else
822 SQL.Add('WITH ' + CTEs[I]^.Name + ' AS (' + CTES[I]^.Text +')')
823 end
824 else
825 begin
826 SQL.Add(',');
827 SQL.Add(CTEs[I]^.Name + ' AS (' + CTES[I]^.Text +')')
828 end
829 end;
830 if CTECount > 0 then
831 SQL.Add('');
832 SQL.Add('SELECT ' + SelectClause + #13#10' FROM ' + FromClause);
833 if WhereClause <> '' then
834 SQL.Add('Where ' + WhereClause);
835 if GroupClause <> '' then
836 SQL.Add('GROUP BY ' + GroupClause);
837 if HavingClause <> '' then
838 SQL.Add('HAVING ' + HavingClause);
839 if PlanClause <> '' then
840 SQL.Add('PLAN ' + PlanClause);
841 if OrderByClause <> '' then
842 SQL.Add('ORDER BY ' + OrderByClause);
843 if Union <> nil then
844 begin
845 if Union.UnionAll then
846 SQL.Add('UNION ALL')
847 else
848 SQL.Add('UNION');
849 SQL.Add(Union.SQLText)
850 end;
851 Result := SQL.Text
852 finally
853 SQL.Free
854 end
855 end;
856
857 function TSelectSQLParser.PopState: TSQLStates;
858 begin
859 if FStackIndex = 0 then
860 raise Exception.Create(sStackUnderFlow);
861 Dec(FStackIndex);
862 Result := FStack[FStackIndex]
863 end;
864
865 procedure TSelectSQLParser.SetState(AState: TSQLStates);
866 begin
867 if FStackIndex > 16 then
868 raise Exception.Create(sStackOverFlow);
869 FStack[FStackIndex] := FState;
870 Inc(FStackIndex);
871 FState := AState
872 end;
873
874 procedure TSelectSQLParser.SetSelectClause(const Value: string);
875 begin
876 if FSelectClause <> Value then
877 begin
878 FSelectClause := Value;
879 Changed
880 end;
881 end;
882
883 procedure TSelectSQLParser.SetFromClause(const Value: string);
884 begin
885 if FFromClause <> Value then
886 begin
887 FFromClause := Value;
888 Changed
889 end;
890 end;
891
892 procedure TSelectSQLParser.SetGroupClause(const Value: string);
893 begin
894 if FGroupClause <> Value then
895 begin
896 FGroupClause := Value;
897 Changed
898 end;
899 end;
900
901 procedure TSelectSQLParser.SetOrderByClause(const Value: string);
902 begin
903 if Union <> nil then
904 Union.OrderByClause := Value
905 else
906 if FOrderByClause <> Value then
907 begin
908 FOrderByClause := Value;
909 Changed
910 end;
911 end;
912
913 procedure TSelectSQLParser.DropUnion;
914 begin
915 if FUnion <> nil then
916 begin
917 FUnion.Free;
918 FUnion := nil;
919 Changed
920 end
921 end;
922
923 function TSelectSQLParser.GetFieldPosition(AliasName: string): integer;
924 begin
925 if assigned(FDataSet) and (FDataSet is TIBCustomDataset) then
926 Result := TIBCustomDataset(FDataSet).GetFieldPosition(AliasName)
927 else
928 Result := 0;
929 end;
930
931 procedure TSelectSQLParser.ResetWhereClause;
932 begin
933 FWhereClause := FOriginalWhereClause;
934 if Union <> nil then
935 Union.ResetWhereClause;
936 Changed
937 end;
938
939 procedure TSelectSQLParser.ResetHavingClause;
940 begin
941 FHavingClause := FOriginalHavingClause;
942 if Union <> nil then
943 Union.ResetHavingClause;
944 Changed
945 end;
946
947 procedure TSelectSQLParser.ResetOrderByClause;
948 begin
949 FOrderbyClause := FOriginalOrderByClause;
950 if Union <> nil then
951 Union.ResetOrderByClause;
952 Changed
953 end;
954
955 procedure TSelectSQLParser.Reset;
956 begin
957 ResetWhereClause;
958 ResetHavingClause;
959 ResetOrderByClause
960 end;
961
962 destructor TSelectSQLParser.Destroy;
963 begin
964 FDestroying := true;
965 DropUnion;
966 if FParamList <> nil then FParamList.Free;
967 if FCTEs <> nil then
968 begin
969 CTEClear;
970 FCTEs.Free;
971 end;
972 inherited;
973 end;
974
975 end.
976
977