1 {*********************************************************}
3 { Zeos Database Objects }
4 { SQL Statements Analysing classes }
6 { Originally written by Sergey Seroukhov }
8 {*********************************************************}
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
13 { License Agreement: }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
46 { http://www.sourceforge.net/projects/zeoslib. }
49 { Zeos Development Group. }
50 {********************************************************@}
52 unit ZGenericSqlAnalyser;
58 uses Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} Contnrs,
59 ZClasses, ZTokenizer, ZSelectSchema, ZCompatibility;
63 {** Implements a section of the parsed SQL statement. }
64 TZStatementSection = class (TObject)
69 constructor Create(const Name: string; Tokens: TStrings);
70 destructor Destroy; override;
72 function Clone: TZStatementSection;
74 property Name: string read FName write FName;
75 property Tokens: TStrings read FTokens;
78 {** Implements a publicly available interface to statement analyser. }
79 IZStatementAnalyser = interface(IZInterface)
80 ['{967635B6-411B-4DEF-990C-9C6C01F3DC0A}']
82 function TokenizeQuery(Tokenizer: IZTokenizer; const SQL: string;
83 Cleanup: Boolean): TStrings;
84 function SplitSections(Tokens: TStrings): TObjectList;
86 function ComposeTokens(Tokens: TStrings): string;
87 function ComposeSections(Sections: TObjectList): string;
89 function DefineSelectSchemaFromSections(
90 Sections: TObjectList): IZSelectSchema;
91 function DefineSelectSchemaFromQuery(Tokenizer: IZTokenizer;
92 const SQL: string): IZSelectSchema;
95 {** Implements an SQL statements analyser. }
96 TZGenericStatementAnalyser = class (TZAbstractObject, IZStatementAnalyser)
98 FSectionNames: TStrings;
99 FSelectOptions: TStrings;
100 FFromJoins: TStrings;
101 FFromClauses: TStrings;
103 function ArrayToStrings(const Value: array of string): TStrings;
104 function CheckForKeyword(Tokens: TStrings; TokenIndex: Integer;
105 Keywords: TStrings; var Keyword: string; var WordCount: Integer): Boolean;
106 function FindSectionTokens(Sections: TObjectList; const Name: string): TStrings;
108 procedure FillFieldRefs(SelectSchema: IZSelectSchema; SelectTokens: TStrings);
109 procedure FillTableRefs(SelectSchema: IZSelectSchema; FromTokens: TStrings);
111 function SkipOptionTokens(Tokens: TStrings; var TokenIndex: Integer;
112 Options: TStrings): Boolean;
113 function SkipBracketTokens(Tokens: TStrings; var TokenIndex: Integer):
116 property SectionNames: TStrings read FSectionNames write FSectionNames;
117 property SelectOptions: TStrings read FSelectOptions write FSelectOptions;
118 property FromJoins: TStrings read FFromJoins write FFromJoins;
119 property FromClauses: TStrings read FFromClauses write FFromClauses;
122 destructor Destroy; override;
124 function TokenizeQuery(Tokenizer: IZTokenizer; const SQL: string;
125 Cleanup: Boolean): TStrings;
126 function SplitSections(Tokens: TStrings): TObjectList;
128 function ComposeTokens(Tokens: TStrings): string;
129 function ComposeSections(Sections: TObjectList): string;
131 function DefineSelectSchemaFromSections(
132 Sections: TObjectList): IZSelectSchema;
133 function DefineSelectSchemaFromQuery(Tokenizer: IZTokenizer; const SQL: string):
139 uses SysUtils, ZSysUtils;
141 { TZStatementSection }
144 Create SQL statement section object.
146 constructor TZStatementSection.Create(const Name: string; Tokens: TStrings);
153 Destroys this object and cleanups the memory.
155 destructor TZStatementSection.Destroy;
162 Clones an object instance.
163 @return a clonned object instance.
165 function TZStatementSection.Clone: TZStatementSection;
169 Temp := TStringList.Create;
170 Temp.AddStrings(FTokens);
171 Result := TZStatementSection.Create(FName, Temp);
175 {** The generic constants.}
176 GenericSectionNames: array[0..12] of string = (
177 'SELECT', 'UPDATE', 'DELETE', 'INSERT', 'FROM',
178 'WHERE', 'INTO', 'GROUP*BY', 'HAVING', 'ORDER*BY',
179 'FOR*UPDATE', 'LIMIT', 'OFFSET'
181 GenericSelectOptions: array[0..1] of string = (
184 GenericFromJoins: array[0..5] of string = (
185 'NATURAL', 'RIGHT', 'LEFT', 'INNER', 'OUTER', 'JOIN'
187 GenericFromClauses: array[0..0] of string = (
191 { TZGenericStatementAnalyser }
194 Creates the object and assignes the main properties.
196 constructor TZGenericStatementAnalyser.Create;
198 FSectionNames := ArrayToStrings(GenericSectionNames);
199 FSelectOptions := ArrayToStrings(GenericSelectOptions);
200 FFromJoins := ArrayToStrings(GenericFromJoins);
201 FFromClauses := ArrayToStrings(GenericFromClauses);
205 Destroys this object and cleanups the memory.
207 destructor TZGenericStatementAnalyser.Destroy;
217 Converts an array of strings into TStrings object.
218 @param Value an array of strings to be converted.
219 @return a TStrings object with specified strings.
221 function TZGenericStatementAnalyser.ArrayToStrings(
222 const Value: array of string): TStrings;
226 Result := TStringList.Create;
227 for I := Low(Value) to High(Value) do
228 Result.Add(Value[I]);
232 Checks for keyword with one, two or three consisted words in the list
233 @param Tokens a list or tokens
234 @param TokenIndex an index of the current token
235 @param Keywords a list of keywords (in uppers case delimited with '*')
236 @param Keyword an out parameter with found keyword.
237 @param WordCount a count of words in the found keyword.
239 function TZGenericStatementAnalyser.CheckForKeyword(Tokens: TStrings;
240 TokenIndex: Integer; Keywords: TStrings; var Keyword: string;
241 var WordCount: Integer): Boolean;
251 if (Tokens.Count <= TokenIndex) then
253 if TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
254 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF}) <> ttWord then
256 if Keyword <> '' then
257 Keyword := Keyword + '*';
258 Keyword := Keyword + AnsiUpperCase(Tokens[TokenIndex]);
260 if Keywords.IndexOf(Keyword) >= 0 then
266 { Skips whitespaces. }
267 while Tokens.Count > TokenIndex do
269 if not (TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
270 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF})
271 in [ttWhitespace, ttComment]) then
286 Finds a section by it's name.
287 @param Sections a list of sections.
288 @param Name a name of the section to be found.
289 @return a list of section tokens or <code>null</code>
290 if section is was not found.
292 function TZGenericStatementAnalyser.FindSectionTokens(
293 Sections: TObjectList; const Name: string): TStrings;
296 Current: TZStatementSection;
299 for I := 0 to Sections.Count - 1 do
301 Current := TZStatementSection(Sections[I]);
302 if Current.Name = Name then
304 Result := Current.Tokens;
311 Tokenizes a given SQL query into a list of tokens with tokenizer.
312 @param Tokenizer a tokenizer object.
313 @param SQL a SQL query to be tokenized.
314 @return a list with tokens.
316 function TZGenericStatementAnalyser.TokenizeQuery(
317 Tokenizer: IZTokenizer; const SQL: string; Cleanup: Boolean): TStrings;
321 Result := Tokenizer.TokenizeBufferToList(SQL,
322 [toSkipEOF, toSkipComments, toUnifyWhitespaces])
324 Result := Tokenizer.TokenizeBufferToList(SQL, [toSkipEOF]);
328 Splits a given list of tokens into the list named sections.
329 @param Tokens a list of tokens.
330 @return a list of section names where object property contains
331 a list of tokens in the section. It initial list is not started
332 with a section name the first section is unnamed ('').
334 function TZGenericStatementAnalyser.SplitSections(Tokens: TStrings): TObjectList;
341 FoundSection: Boolean;
342 BracketCount: Integer;
344 Result := TObjectList.Create;
346 FoundSection := True;
348 CheckForKeyword(Tokens, TokenIndex, SectionNames, Keyword, WordCount);
350 while TokenIndex < Tokens.Count do
354 Elements := TStringList.Create;
355 for I := 0 to WordCount - 1 do
357 Elements.AddObject(Tokens[TokenIndex + I],
358 Tokens.Objects[TokenIndex + I]);
360 Inc(TokenIndex, WordCount);
361 Result.Add(TZStatementSection.Create(Keyword, Elements));
363 FoundSection := CheckForKeyword(Tokens, TokenIndex, SectionNames,
365 if not FoundSection and (TokenIndex < Tokens.Count) then
369 Elements.AddObject(Tokens[TokenIndex], Tokens.Objects[TokenIndex]);
370 if Tokens[TokenIndex] = '(' then
372 else if Tokens[TokenIndex] = ')' then
375 until (BracketCount <= 0) or (TokenIndex >= Tokens.Count);
381 Composes a string from the list of tokens.
382 @param Tokens a list of tokens.
383 @returns a composes string.
385 function TZGenericStatementAnalyser.ComposeTokens(Tokens: TStrings): string;
387 Result := ComposeString(Tokens, '');
391 Composes a string from the list of statement sections.
392 @param Tokens a list of statement sections.
393 @returns a composes string.
395 function TZGenericStatementAnalyser.ComposeSections(Sections: TObjectList): string;
400 for I := 0 to Sections.Count - 1 do
401 Result := Result + ComposeTokens(TZStatementSection(Sections[I]).Tokens);
405 Skips tokens inside brackets.
406 @param Tokens a list of tokens to scan.
407 @param TokenIndex the index of the current token.
408 @return <code>true</code> if some tokens were skipped.
410 function TZGenericStatementAnalyser.SkipBracketTokens(Tokens: TStrings;
411 var TokenIndex: Integer): Boolean;
413 BracketCount: Integer;
416 { Checks for the start bracket. }
417 if (TokenIndex < Tokens.Count) and (Tokens[TokenIndex] <> '(') then
423 { Skips the expression in brackets. }
427 while (TokenIndex < Tokens.Count) and (BracketCount > 0) do
429 Current := Tokens[TokenIndex];
430 if Current = '(' then
432 else if Current = ')' then
439 Skips option tokens specified in the string list.
440 @param Tokens a list of tokens to scan.
441 @param TokenIndex the index of the current token.
442 @param Options a list of option keyword strings in the upper case.
443 @return <code>true</code> if some tokens were skipped.
445 function TZGenericStatementAnalyser.SkipOptionTokens(Tokens: TStrings;
446 var TokenIndex: Integer; Options: TStrings): Boolean;
449 while TokenIndex < Tokens.Count do
451 if not (TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
452 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF})
453 in [ttWhitespace, ttComment])
454 and (Options.IndexOf(AnsiUpperCase(Tokens[TokenIndex])) < 0) then
464 Fills select schema with field references.
465 @param SelectSchema a select schema object.
466 @param SelectTokens a list of tokens in select section.
468 procedure TZGenericStatementAnalyser.FillFieldRefs(
469 SelectSchema: IZSelectSchema; SelectTokens: TStrings);
477 CurrentValue: string;
478 CurrentType: TZTokenType;
479 CurrentUpper: string;
481 HadWhitespace : Boolean;
482 LastWasBracketSection: Boolean;
483 CurrentUpperIs_AS: Boolean; //place holder to avoid compare the token twice
485 procedure ClearElements;
493 LastWasBracketSection := False;
496 { improve fail of fieldname detection if whitespaces and non ttWord or ttQuotedIdentifier previously detected
497 f.e.: select first 100 skip 10 field1, field2}
498 function CheckNextTokenForCommaAndWhiteSpaces: Boolean;
500 CurrentValue: string;
501 CurrentType: TZTokenType;
506 //Check to right side to avoid wrong alias detection
507 while SelectTokens.Count > TokenIndex +i do
509 CurrentValue := SelectTokens[TokenIndex+i];
510 CurrentType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
511 SelectTokens.Objects[TokenIndex+i]{$IFDEF FPC}){$ENDIF});
512 if CurrentType in [ttWhiteSpace, ttSymbol] then
514 if (CurrentValue = ',') then
528 while Tokenindex - i > 0 do
529 if TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
530 SelectTokens.Objects[TokenIndex-i]{$IFDEF FPC}){$ENDIF}) = ttWhiteSpace then
534 Result := Result and (TokenIndex - I > 0) and
535 not ( TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
536 SelectTokens.Objects[TokenIndex-i]{$IFDEF FPC}){$ENDIF}) = ttWord );
542 SkipOptionTokens(SelectTokens, TokenIndex, Self.SelectOptions);
545 while TokenIndex < SelectTokens.Count do
547 CurrentValue := SelectTokens[TokenIndex];
548 CurrentUpper := AnsiUpperCase(CurrentValue);
549 CurrentType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
550 SelectTokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
552 { Switches to alias part. }
553 CurrentUpperIs_AS := (CurrentUpper = 'AS');
554 if (CurrentType = ttWhitespace) or CurrentUpperIs_AS then
555 ReadField := ReadField and (Field = '') and not CurrentUpperIs_AS
557 else if ReadField and ((CurrentType = ttWord) or (CurrentType = ttQuotedIdentifier) or
558 (CurrentValue = '*')) then
563 Field := CurrentValue;
565 { Skips a '.' in field part. }
566 else if ReadField and (CurrentValue = '.') then
570 else if not ReadField and (CurrentType in [ttWord, ttQuotedIdentifier]) then
571 Alias := CurrentValue
572 { Ends field reading. }
573 else if CurrentValue = ',' then
576 SelectSchema.AddField(TZFieldRef.Create(True, Catalog, Schema, Table,
580 { Skips till the next field. }
584 HadWhitespace := False;
585 while (TokenIndex < SelectTokens.Count) and (CurrentValue <> ',') do
587 CurrentValue := SelectTokens[TokenIndex];
588 if CurrentValue = '(' then
590 SkipBracketTokens(SelectTokens, TokenIndex);
591 LastWasBracketSection := True;
594 CurrentType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
595 SelectTokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
596 if HadWhitespace and (CurrentType in [ttWord, ttQuotedIdentifier]) then
597 if not LastWasBracketSection and CheckNextTokenForCommaAndWhiteSpaces then
600 Alias := CurrentValue
601 else if not (CurrentType in [ttWhitespace, ttComment])
602 and (CurrentValue <> ',') then
604 else if CurrentType = ttWhitespace then
605 HadWhitespace := true;
611 SelectSchema.AddField(TZFieldRef.Create(False, '', '', '', '', Alias, nil));
614 Dec(TokenIndex); // go back 1 token(Because of Inc in next lines)
619 { Creates a reference to the last processed field. }
622 SelectSchema.AddField(TZFieldRef.Create(True, Catalog, Schema, Table,
628 Fills select schema with table references.
629 @param SelectSchema a select schema object.
630 @param FromTokens a list of tokens in from section.
633 procedure TZGenericStatementAnalyser.FillTableRefs(
634 SelectSchema: IZSelectSchema; FromTokens: TStrings);
641 CurrentValue: string;
642 CurrentType: TZTokenType;
643 CurrentUpper: string;
646 procedure ClearElements;
659 while TokenIndex < FromTokens.Count do
661 CurrentValue := FromTokens[TokenIndex];
662 CurrentUpper := AnsiUpperCase(CurrentValue);
663 CurrentType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
664 FromTokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
666 { Processes from join keywords. }
667 if FromJoins.IndexOf(CurrentUpper) >= 0 then
670 SelectSchema.AddTable(TZTableRef.Create(Catalog, Schema, Table, Alias));
672 SkipOptionTokens(FromTokens, TokenIndex, FromJoins);
675 { Skips from clause keywords. }
676 else if FromClauses.IndexOf(CurrentUpper) >= 0 then
679 CurrentValue := FromTokens[TokenIndex];
680 CurrentUpper := AnsiUpperCase(CurrentValue);
681 while (TokenIndex < FromTokens.Count)
682 and (FromJoins.IndexOf(CurrentUpper) < 0) and (CurrentUpper <> ',') do
684 if CurrentUpper = '(' then
685 SkipBracketTokens(FromTokens, TokenIndex)
686 else Inc(TokenIndex);
687 if TokenIndex < FromTokens.Count then
689 CurrentValue := FromTokens[TokenIndex];
690 CurrentUpper := AnsiUpperCase(CurrentValue);
691 CurrentType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
692 FromTokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
695 // We must jump 1 tokens back now when we stopped on a Join clause.
696 // Otherwise the next table is skipped
697 if FromJoins.IndexOf(CurrentUpper) >= 0 then
700 CurrentValue := FromTokens[TokenIndex];
701 CurrentUpper := AnsiUpperCase(CurrentValue);
704 { Switches to alias part. }
705 else if (CurrentType = ttWhitespace) or (CurrentUpper = 'AS') then
707 ReadTable := ReadTable and (Table = '') and (CurrentUpper <> 'AS');
710 else if ReadTable and ((CurrentType = ttWord) or (CurrentType = ttQuotedIdentifier)) then
714 Table := CurrentValue;
716 { Skips a '.' in table part. }
717 else if ReadTable and (CurrentValue = '.') then
724 else if not ReadTable and (CurrentType = ttWord) then
726 Alias := CurrentValue;
728 { Ends field reading. }
729 if CurrentValue = ',' then
732 SelectSchema.AddTable(TZTableRef.Create(Catalog, Schema, Table, Alias));
735 { Skips till the next field. }
736 if CurrentValue = '(' then
737 SkipBracketTokens(FromTokens, TokenIndex)
738 else Inc(TokenIndex);
741 { Creates a reference to the last processed field. }
743 SelectSchema.AddTable(TZTableRef.Create(Catalog, Schema, Table, Alias));
747 Extracts a select schema from the specified parsed select statement.
748 @param Sections a list of sections.
749 @return a select statement schema.
751 function TZGenericStatementAnalyser.DefineSelectSchemaFromSections(
752 Sections: TObjectList): IZSelectSchema;
754 SelectTokens: TStrings;
755 FromTokens: TStrings;
758 { Checks for the correct select statement. }
759 if (Sections.Count < 2)
760 or not ((TZStatementSection(Sections[0]).Name = 'SELECT')
761 or ((TZStatementSection(Sections[0]).Name = '')
762 and (TZStatementSection(Sections[1]).Name = 'SELECT'))) then
766 SelectTokens := FindSectionTokens(Sections, 'SELECT');
767 FromTokens := FindSectionTokens(Sections, 'FROM');
768 if (SelectTokens = nil) or (FromTokens = nil) then
771 { Creates and fills the result object. }
772 Result := TZSelectSchema.Create;
773 FillFieldRefs(Result, SelectTokens);
774 FillTableRefs(Result, FromTokens);
778 Defines a select schema from the specified SQL query.
779 @param Tokenizer a tokenizer object.
780 @param SQL a SQL query.
781 @return a select statement schema.
783 function TZGenericStatementAnalyser.DefineSelectSchemaFromQuery(
784 Tokenizer: IZTokenizer; const SQL: string): IZSelectSchema;
787 Sections: TObjectList;
789 Tokens := TokenizeQuery(Tokenizer, SQL, True);
790 Sections := SplitSections(Tokens);
792 Result := DefineSelectSchemaFromSections(Sections);