
//////////////////////////////////////////////////
//  Copyright © 1998-2014 Devart. All right reserved.
//  CRParser
//  Created:            27.03.98
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$IFNDEF EntityDAC}
{$I Dac.inc}
unit CRParser;
{$ENDIF}
{$ENDIF}

interface

{$IFNDEF CLR}
{$IFNDEF IS_UNICODE}
{$IFNDEF PUREPASCAL}
  {$DEFINE USEANSIQUOTE}
{$ENDIF}
{$ENDIF}
{$ENDIF}

uses
  Classes,
{$IFDEF PERF_COUNTER}
  Debug,
{$ENDIF}
{$IFDEF CLR}
  System.Text,
{$ELSE}
  {$IFNDEF EntityDAC}
  CLRClasses,
  {$ELSE}
  EntityDAC.Common.CLRClasses,
  {$ENDIF}
{$ENDIF}
{$IFNDEF EntityDAC}
  CRTypes;
{$ELSE}
  EntityDAC.Common.Types;
{$ENDIF}

const
  lcEnd     =  0;
  lcLexem   = -100;
  lcSymbol  = -102;
  lcIdent   = -103;  // identificator
  lcNumber  = -105;
  lcString  = -106;
  lcBlank   = -107;
  lcComment = -108;

  lxSQLFirst  = 100;
  lxALL       = lxSQLFirst;
  lxAND       = lxALL + 1;
  lxAS        = lxAND + 1;
  lxBEGIN     = lxAS + 1;
  lxBY        = lxBEGIN + 1;
  lxCOMMIT    = lxBY + 1;
  lxDELETE    = lxCOMMIT + 1;
  lxDISTINCT  = lxDELETE + 1;
  lxEND       = lxDISTINCT + 1;
  lxEXECUTE   = lxEND + 1;
  lxFETCH     = lxEXECUTE + 1;
  lxFOR       = lxFETCH + 1;
  lxFROM      = lxFOR + 1;
  lxFULL      = lxFROM + 1;
  lxGROUP     = lxFULL + 1;
  lxHAVING    = lxGROUP + 1;
  lxINNER     = lxHAVING + 1;
  lxINSERT    = lxINNER + 1;
  lxINTERSECT = lxINSERT + 1;
  lxINTO      = lxINTERSECT + 1;
  lxIS        = lxINTO + 1;
  lxJOIN      = lxIS + 1;
  lxLEFT      = lxJOIN + 1;
  lxLIMIT     = lxLEFT + 1;
  lxLOCK      = lxLIMIT + 1;
  lxMINUS     = lxLOCK + 1;
  lxNOT       = lxMINUS + 1;
  lxOFFSET    = lxNOT + 1;
  lxON        = lxOFFSET + 1;
  lxONLY      = lxON + 1; // PostgreSQL lexeme in the FROM statement
  lxOR        = lxONLY + 1;
  lxORDER     = lxOR + 1;
  lxOUTER     = lxORDER + 1;
  lxRELEASE   = lxOUTER + 1;
  lxRETURNING = lxRELEASE + 1;
  lxRIGHT     = lxRETURNING + 1;
  lxROLLBACK  = lxRIGHT + 1;
  lxSAVEPOINT = lxROLLBACK + 1;
  lxSELECT    = lxSAVEPOINT + 1;
  lxSET       = lxSELECT + 1;
  lxTO        = lxSET + 1;
  lxTRANSACTION = lxTO + 1;
  lxUNION     = lxTRANSACTION + 1;
  lxUPDATE    = lxUNION + 1;
  lxWHERE     = lxUPDATE + 1;
  lxWITH      = lxWHERE + 1;

  BLOCK_SIZE = 64 * 1024;

type
  TParserClass = class of TParser;
  TSQLParserClass = class of TSQLParser;
  TClausesArr = array of integer;
{$IFNDEF CLR}
  TCharSet = set of AnsiChar;
{$ENDIF}

  TParser = class
  protected
    OldPos: Int64;
    OldOldPos: Int64;
    FOmitBlank: boolean;
    FOmitComment: boolean;
    FOmitInlineComment: Boolean;
    FUppered: boolean;
    FCurrLine: Int64;
    FPrevLine: Int64;
    FCurrBegLine: integer;
    FPrevBegLine: Int64;
    FQuotedString: boolean;
    FAdvancedStringParsing: boolean;
    FDecSeparator: char;
    FCommentBegin: string;
    FCommentEnd: string;

    FSavedPos: integer; // local var buf in previous version
    FLexemPos: integer; // start Lexem pos in Text
    FLexemLength: integer; // actual length of FLexemArray;
    FToken: integer;
    FLexem: string;

    FStream: TStream;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FEncoding: Encoding;
    FStartOffset: int64; // bytes
    FStoredBlocks: TStringList;
    FCurrentBlock: string;
    FFirstBlockOffset: integer;
    FBlockOffset: integer;
    FBlockSize: integer;
    FAlternativeQuoting: boolean; // supported in Oracle 10
    FDollarQuoting: boolean; // supported in PostgreSQL

    function GetCharSize(ByteSize: int64): int64;
    procedure ReadNextBlock;
    function GetChar(Index: integer): char;
    function GetStoredChar(Index: integer): char;
    procedure DecreaseBlockParameters;
  protected
    TextLength: integer;
    Pos: integer;
    StreamLength: Int64;
    Offset: Int64;

    FSymbolLexems: TIntValueStringList;
  {$IFNDEF CLR}
    FSymbolChars: TCharSet;
  {$ENDIF}
    FKeywordLexems: TIntValueStringList;
    FOmitKeywords: boolean;
    FDesiredLexem: string;
    FDesiredLexemFound: boolean;

    procedure InitParser; virtual;

    function IsSymbol(Ch: char): boolean; virtual;
    function IsAlpha(Ch: char): boolean; virtual;
    function IsNumber(Ch: char): boolean; virtual;
    function IsStringQuote(Ch: char): boolean; virtual;
    procedure ToRightQuoteP(RightQuote: char); virtual;
  {$IFDEF USEANSIQUOTE}
    procedure ToRightQuoteA(RightQuote: AnsiChar); virtual;
  {$ENDIF}
    procedure ToRightQuote(RightQuote: char); virtual; // Search right quote of quoted string value or quoted identifier
    function IsIdentQuote(Ch: char): boolean; virtual;
    function IsInlineComment(Ch: char; Pos: integer): boolean; virtual;
    function FindLexemIndex(const LexemPos, LexemLength: integer; Lexems: TIntValueStringList): integer;
    function InternalGetNext: integer;

    function CopyText(const Pos, Count: integer): string;
    procedure AddToLexemArray(Index: integer; const Len: integer);

    property Text[Index: integer]: char read GetChar;
    property AlternativeQuoting: boolean read FAlternativeQuoting write FAlternativeQuoting;
    property DollarQuoting: boolean read FDollarQuoting write FDollarQuoting;

  public
    constructor Create(const Text: string); overload; virtual;
    constructor Create(const Stream: TStream; AEncoding: Encoding = nil); overload; virtual;
    destructor Destroy; override;

    procedure SetText(const Text: string);

    procedure ToBegin; virtual;
    procedure Back;
    function GetNext(out Lexem: string): integer; virtual;
    function GetNextToken: integer;

    function ToLexem(const Code: integer; const SkipSubQueries: boolean = False): integer; overload;
    function ToLexem(const Codes: array of integer): integer; overload;
    function ToLexem(const Lexem: string): boolean; overload;

    function IsSymbolCode(Code: integer): boolean; overload;
    function GetSymbolByCode(Code: integer): string;

    function CurrPos: Int64;
    function PrevPos: Int64;
    function PrevPrevPos: Int64;
    function CurrLine: Int64;
    function PrevLine: Int64;
    function CurrCol: Int64;
    function PrevCol: Int64;

    property Token: integer read FToken;
    property Lexem: string read FLexem;

    property OmitBlank: boolean read FOmitBlank write FOmitBlank;
    property OmitComment: boolean read FOmitComment write FOmitComment;
    property OmitInlineComment: boolean read FOmitInlineComment write FOmitInlineComment;
    property OmitKeywords: boolean read FOmitKeywords write FOmitKeywords;
    property Uppered: boolean read FUppered write FUppered;
    property QuotedString: boolean read FQuotedString write FQuotedString;
    property AdvancedStringParsing: boolean read FAdvancedStringParsing write FAdvancedStringParsing;
    property DecSeparator: char read FDecSeparator write FDecSeparator;
    property CommentBegin: string read FCommentBegin write FCommentBegin;
    property CommentEnd: string read FCommentEnd write FCommentEnd;

    property SymbolLexems: TIntValueStringList read FSymbolLexems;
    property KeywordLexems: TIntValueStringList read FKeywordLexems;
  end;

  TSQLParser = class(TParser)
  protected
    FClauses: TClausesArr; // lxWHERE, lxLIMIT, lxORDER etc. Must be filled on Create

    procedure InitParser; override;
    function IsAlpha(Ch: char): boolean; override;
    function IsStringQuote(Ch: char): boolean; override;
    function IsIdentQuote(Ch: char): boolean; override;
    function IsInlineComment(Ch: char; Pos: integer): boolean; override;

  public
    function IsClauseLexem(Code: integer): boolean; // Is SELECT statement clause
    function PosClauseLexem(Code: integer): integer; // Code position in list of SELECT statement clauses. -1 if not found
    function CompareClauseLexems(const Code1, Code2: integer): integer;
    function IsMacroAllowed(Code: integer): boolean; virtual;
    class function IsNumericMacroNameAllowed: boolean; virtual;
    class function IsSelectModifier(Code: integer): boolean; virtual;
    class function IsFunctionOrConst(const UpperedName: string): boolean; virtual;
    class function IsQuasiColumn(const UpperedName: string): boolean; virtual;
  end;

var
  CommonSymbolLexems, CommonKeywordLexems,
  SQLSymbolLexems, SQLKeywordLexems: TIntValueStringList;
{$IFNDEF CLR}
  CommonSymbolChars, SQLSymbolChars: TCharSet;
{$ENDIF}

  function _GetFrom(
    const SQL: string;
    ParserClass: TSQLParserClass;
    OmitComment: boolean;
    const MacroChar: string
  ): string;
  function _GetWhere(
    const SQL: string;
    ParserClass: TSQLParserClass;
    OmitComment: boolean;
    const MacroChar: string
  ): string;
  function _GetOrderBy(
    const SQL: string;
    ParserClass: TSQLParserClass
  ): string;
  function _AddWhere(
    const SQL: string; const Condition: string;
    ParserClass: TSQLParserClass;
    OmitComment: boolean;
    const MacroChar: string
  ): string;
  function _SetWhere(
    const SQL: string; Condition: string;
    ParserClass: TSQLParserClass;
    OmitComment: boolean
  ): string;
  function _SetOrderBy(
    const SQL: string; Fields: string;
    ParserClass: TSQLParserClass
  ): string;

implementation

uses
  SysUtils,
{$IFNDEF EntityDAC}
  CRFunctions, DAConsts;
{$ELSE}
  EntityDAC.Common.Functions, EntityDAC.Common.Consts;
{$ENDIF}

{ TParser }

constructor TParser.Create(const Text: string);
begin
  inherited Create;

  Self.FCurrentBlock := Text;
  TextLength := Length(Text);
  FBlockSize := TextLength;

  InitParser;
end;

constructor TParser.Create(const Stream: TStream; AEncoding: Encoding = nil);
begin
  inherited Create;

  FStoredBlocks := TStringList.Create;
  FStream := Stream;
  FEncoding := AEncoding;
  if FEncoding = nil then
    FEncoding := Encoding.Default;
  FStartOffset := Stream.Position;
  StreamLength := GetCharSize(Stream.Size - FStartOffset);

  if StreamLength > MaxInt then
    TextLength := MaxInt
  else
    TextLength := StreamLength;

  InitParser;
end;

destructor TParser.Destroy;
begin
  FStoredBlocks.Free;

  inherited;
end;

procedure TParser.InitParser;
begin
  FSymbolLexems := CommonSymbolLexems;
{$IFNDEF CLR}
  FSymbolChars := CommonSymbolChars;
{$ENDIF}
  FKeywordLexems := CommonKeywordLexems;
  FCommentBegin := '/*';
  FCommentEnd := '*/';
  // Performance optimization
  FDecSeparator := char({$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator{$IFDEF CLR}[1]{$ENDIF});

  FOmitBlank := True;
  FUppered := True;
  FQuotedString := False;

  ToBegin;
end;

procedure TParser.SetText(const Text: string);
begin
  Self.FCurrentBlock := Text;
  TextLength := Length(Text);
  FBlockSize := TextLength;

  ToBegin;
end;

function TParser.IsSymbol(Ch: char): boolean;
begin
  case Ch of
    '!'..'/':
      Result := True;
    ':'..'@':
      Result := True;
    '['..'^':
      Result := True;
    '{'..'~':
      Result := True;
    '`':
      Result := True;
    else
      Result := False;
  end;
end;

function TParser.IsAlpha(Ch: char): boolean;
begin
  case Ord(Ch) of
    Ord('a')..Ord('z'):
      Result := True;
    Ord('A')..Ord('Z'):
      Result := True;
    Ord(#128)..Ord(High(char)):
      Result := True;
    else
      Result := False;
  end;
end;

function TParser.IsNumber(Ch: char): boolean;
begin
  case Ch of
    '0'..'9':
      Result := True;
    else
      Result := False;
  end;
end;

function TParser.IsStringQuote(Ch: char): boolean;
begin
  case Ch of
     '''':
      Result := True;
     '"':
      Result := True;
    else
      Result := False;
  end;
end;

procedure TParser.ToRightQuote(RightQuote: char);
begin
  if FAdvancedStringParsing or (FStream <> nil) then
    ToRightQuoteP(RightQuote)
  else
  {$IFDEF USEANSIQUOTE}
    ToRightQuoteA(RightQuote);
  {$ELSE}
    while (Pos <= TextLength) and (Text[Pos] <> RightQuote) do
      Inc(Pos);
  {$ENDIF}
end;

procedure TParser.ToRightQuoteP(RightQuote: char);
var
  c: char;
begin
  while (Pos <= TextLength) do begin
    c := Text[Pos];
    if (c = #13) or (c = #10) then begin
      if (Pos < TextLength) and (Text[Pos + 1] = #10) then
        inc(Pos);
      Inc(FCurrLine);
      FCurrBegLine := Pos + 1;
    end
    else
    if c = RightQuote then
      Break;
    inc(Pos);
  end;
end;

{$IFDEF USEANSIQUOTE}
procedure TParser.ToRightQuoteA(RightQuote: AnsiChar);
var
  i: integer;
begin
  i := TextLength - Pos + 1 {Pos is counted from 1} + 1 {#0};
  asm
{$IFDEF CPUX64}
    PUSH RAX
    PUSH RDI
    PUSH RCX

    MOV RAX, Self
    MOV RDI, RAX

    ADD RAX, Pos
    MOV RAX, [RAX] // RAX := Pos

    ADD RDI, FCurrentBlock
    MOV RDI, [RDI]
    ADD RDI, RAX
    DEC RDI // RDI := PChar(Text) + Pos {Pos is counted from 1};

    MOV RCX, i
    MOV AL, RightQuote
    REPNE   SCASB
    MOV i, RCX

    POP RCX
    POP RDI
    POP RAX
{$ELSE}
    PUSH EAX
    PUSH EDI
    PUSH ECX

    MOV EAX, Self
    MOV EDI, EAX

    ADD EAX, Pos
    MOV EAX, [EAX] // EAX := Pos

    ADD EDI, FCurrentBlock
    MOV EDI, [EDI]
    ADD EDI, EAX
    DEC EDI // EDI := PChar(Text) + Pos {Pos is counted from 1};

    MOV ECX, i
    MOV AL, RightQuote
    REPNE   SCASB
    MOV i, ECX

    POP ECX
    POP EDI
    POP EAX
{$ENDIF}
  end;
  Pos := TextLength - i + 1;
end;
{$ENDIF}

function TParser.IsIdentQuote(Ch: char): boolean;
begin
  Result := False;
end;

function TParser.IsInlineComment(Ch: char; Pos: integer): boolean;
begin
  Result := (Ch = '/') and (TextLength >= Pos + 1) and (Text[Pos + 1] = '/');
end;

function TParser.FindLexemIndex(const LexemPos, LexemLength: integer; Lexems: TIntValueStringList): integer;
var
  L, H, I, C, K: integer;
  MinLen, SLen: integer;
  S: string;
  Lexem: string;
  Ch: Char;
begin
{$IFDEF PERF_COUNTER}
  PerfCounters[9].Start;
{$ENDIF}
  Result := -1;

  SetLength(Lexem, LexemLength);
  I := 1;
  K := LexemPos;
  while I <= LexemLength do begin
    Lexem[I] := Text[K];
    Inc(I);
    Inc(K);
  end;

  L := 0;
  H := Lexems.Count - 1;
  while L <= H do begin
    I := (L + H) shr 1;

    S := Lexems[I];
    SLen := Length(S);
    if SLen > LexemLength then
      MinLen := LexemLength
    else
      MinLen := SLen;

    C := 0;
    for K := 1 to MinLen do begin
      Ch := Lexem[K];
      if CharInSet(Ch, ['a'.. 'z']) then
        Dec(Ch, 32);
      C := Integer(S[K]) - Integer(Ch);
      if C <> 0 then
        break;
    end;

    if C = 0 then
      if SLen > LexemLength then
        C := 1
      else if SLen < LexemLength then
        C := -1;

    if C < 0 then
      L := I + 1
    else if C > 0 then
      H := I - 1
    else begin
      Result := I;
      break;
    end;
  end;

{$IFDEF PERF_COUNTER}
  PerfCounters[9].Stop;
{$ENDIF}
end;

procedure TParser.ToBegin;
begin
  Pos := 1;
  OldPos := Pos;
  OldOldPos := OldPos;
  FCurrLine := 0;
  FPrevLine := 0;
  FCurrBegLine := Pos;
  FPrevBegLine := Pos;

  FFirstBlockOffset := 1;
  FBlockOffset := 1;
  Offset := 0;

  FToken := lcBlank;
  FLexem := '';
end;

procedure TParser.Back;
begin
  Pos := OldPos;
end;

function TParser.InternalGetNext: integer;

  function IsCommentBegin(const Ch: char): boolean;
  var
    i, l: integer;
  begin
    if Ch <> FCommentBegin[1] then begin
      Result := False;
      Exit;
    end;

    l := Length(FCommentBegin);
    Result := Pos <= TextLength - l + 1;
    if not Result then
      Exit;

    for i := 2 to l do
      if Text[Pos + i - 1] <> FCommentBegin[i] then begin
        Result := False;
        Exit;
      end;
  end;

var
  j, CommentLen: integer;
  IsComment: boolean;
  Quote: char;
  c: char;
  DL: boolean;
  i: integer;
  St, StLength: integer;
  SymbolPos: integer;
  QuoteDelimiter: char;
  QuoteDelimiterFound: boolean;
  DollarTag, Tag: string;
  DollarPos: integer;
begin
  DL := FDesiredLexem <> '';
  OldOldPos := OldPos;
  OldPos := Pos + Offset;
  FPrevLine := FCurrLine;
  FPrevBegLine := FCurrBegLine + Offset;

  FSavedPos := -1;
  FLexemPos := -1;
  FLexemLength := 0;

  repeat
    if Pos > TextLength then begin
      Result := lcEnd;
      Exit;
      c := #0; // To Prevent compiler warning
    end
    else
      if FStream = nil then // Performance optimization
        c := FCurrentBlock[Pos]
      else begin
        c := Text[Pos];
        DecreaseBlockParameters;
      end;

    // Blanks
    FLexemPos := -1;
    FLexemLength := 0;
    FSavedPos := Pos;

    // Skip blanks
    while true do begin
      case c of
        #32: begin
          Inc(Pos);
          c := Text[Pos];
        end;
        #13: begin
          Inc(Pos);
          c := Text[Pos];

          if c  = #10 then begin
            Inc(Pos);
            c := Text[Pos];
          end;

          Inc(FCurrLine);
          FCurrBegLine := Pos;
        end;
        #10: begin
          Inc(Pos);
          c := Text[Pos];

          Inc(FCurrLine);
          FCurrBegLine := Pos;
        end;
        #9: begin
          Inc(Pos);
          c := Text[Pos];
        end;
        else
          break;
      end;
    end;

    if Pos > FSavedPos then
      AddToLexemArray(FSavedPos, Pos - FSavedPos)
    else
      FSavedPos := -1;

    if not OmitBlank and (FLexemLength <> 0) then begin
      Result := lcBlank;
      Exit;
    end;

    // End
    if Pos > TextLength then begin
      Result := lcEnd;
      Exit;
    end;

    // Comment
    FLexemPos := -1;
    FLexemLength := 0;
    IsComment := False;
    if not OmitInlineComment and IsInlineComment(c, Pos) then begin
      IsComment := True;
      FSavedPos := Pos;
      while (Pos <= TextLength) and (c <> #13) and (c <> #10) do begin
        Inc(Pos);
        c := Text[Pos];
      end;
      // optimize expression StrLexem := StrLexem + Copy(Buf, 1, Pos - Buf);
      AddToLexemArray(FSavedPos, Pos - FSavedPos);
    end;

    if IsCommentBegin(c) then begin
      IsComment := True;
      if Pos <= TextLength then begin
        FSavedPos := Pos;
        while Pos <= TextLength do begin
          case c of
            #13: begin
              Inc(Pos);
              c := Text[Pos];

              if c  = #10 then begin
                Inc(Pos);
                c := Text[Pos];
              end;

              Inc(FCurrLine);
              FCurrBegLine := Pos;
            end;
            #10: begin
              Inc(Pos);
              c := Text[Pos];

              Inc(FCurrLine);
              FCurrBegLine := Pos;
            end;
            else begin
              j := 0;
              CommentLen := Length(FCommentEnd);
              while (j < CommentLen) and (Text[Pos + j] = FCommentEnd[j + 1]) do
                inc(j);
              if j = CommentLen then begin
                Inc(Pos, CommentLen);
                Break;
              end;

              Inc(Pos);
              c := Text[Pos];
            end;
          end;
        end;
        // optimize expression StrLexem := StrLexem + Copy(Buf, 1, Pos - Buf);
        AddToLexemArray(FSavedPos, Pos - FSavedPos);
      end;
    end;

    if not OmitComment and IsComment then begin
      Result := lcComment;
      Exit;
    end;
  until not IsComment;

  FLexemPos := -1;
  FLexemLength := 0;
  if IsAlpha(c) or (c = '_') then begin
    Result := lcIdent;
    FSavedPos := Pos;
    QuoteDelimiter := c;
    repeat
      if DL then begin
        if CharInSet(c, ['a'..'z']) then
          Dec(c, 32);
        DL := (Pos - FSavedPos + 1 <= Length(FDesiredLexem)) and (FDesiredLexem[Pos - FSavedPos + 1] = c);
      end;

      Inc(Pos);
      c := Text[Pos];
    until not IsAlpha(c) and not IsNumber(c) and (c <> '_');

    if FAlternativeQuoting and
       (Pos - FSavedPos = 1) and
       ((QuoteDelimiter = 'q') or (QuoteDelimiter = 'Q')) and
       IsStringQuote(c)
    then begin
      Result := lcString;
      Quote := c;
      Inc(Pos);
      if Pos <= TextLength then begin
        QuoteDelimiter := Text[Pos];
        case QuoteDelimiter of
          '[': QuoteDelimiter := ']';
          '{': QuoteDelimiter := '}';
          '<': QuoteDelimiter := '>';
          '(': QuoteDelimiter := ')';
        end;
        QuoteDelimiterFound := False;
        Inc(Pos);
        while Pos <= TextLength do begin
          c := Text[Pos];
          Inc(Pos);

          if QuoteDelimiterFound and (c = Quote) then
            break;

          QuoteDelimiterFound := (c = QuoteDelimiter);
        end;
      end;
      if FQuotedString then
        AddToLexemArray(FSavedPos, Pos - FSavedPos)
      else
        if Pos - FSavedPos > 5 then
          AddToLexemArray(FSavedPos + 3, Pos - FSavedPos - 5)
    end
    else begin
      FDesiredLexemFound := DL;
      AddToLexemArray(FSavedPos, Pos - FSavedPos);
    end;
  end
  else if IsNumber(c) then begin
    Result := lcNumber;
    SymbolPos := Pos;
    FSavedPos := Pos;
    repeat
      if DL then
        DL := (Pos - SymbolPos + 1 <= Length(FDesiredLexem)) and (FDesiredLexem[Pos - SymbolPos + 1] = c);

      Inc(Pos);
      c := Text[Pos];
    until not IsNumber(c);
    AddToLexemArray(FSavedPos, Pos - FSavedPos);

    FDesiredLexemFound := DL;
    if (c = FDecSeparator) and (Pos + 1 <= TextLength) and IsNumber(Text[Pos + 1]) then begin
      FSavedPos := Pos;
      Inc(Pos);
      c := Text[Pos];
      while IsNumber(c) do begin
        Inc(Pos);
        c := Text[Pos];
      end;
      AddToLexemArray(FSavedPos, Pos - FSavedPos);
    end;
  end
  else if IsSymbol(c) then begin
    if IsStringQuote(c) then begin
      Result := lcString;
      Quote := c;
      if FQuotedString then
        AddToLexemArray(Pos, 1);
      Inc(Pos);
      FSavedPos := Pos;
      ToRightQuote(Quote);
      // optimize expression StrLexem := StrLexem + Copy(Buf, 1, Pos - Buf);
      if Pos > FSavedPos then
        AddToLexemArray(FSavedPos, Pos - FSavedPos);
      if Pos <= TextLength then begin
        if FQuotedString then
          AddToLexemArray(Pos, 1);
        Inc(Pos);
      end;
    end
    else
    if IsIdentQuote(c) then begin
      Result := lcIdent;
      Quote := c;
      AddToLexemArray(Pos, 1);
      Inc(Pos);
      FSavedPos := Pos;
      ToRightQuote(Quote);
      if Pos > FSavedPos then
        AddToLexemArray(FSavedPos, Pos - FSavedPos);
      if Pos <= TextLength then begin
        AddToLexemArray(Pos, 1);
        Inc(Pos);
      end;
    end
    else
    if FDollarQuoting and (c = '$')
      and (Pos < TextLength) and not IsNumber(Text[Pos + 1])
      and ((Pos = 1) or CharInSet(Text[Pos - 1], [#32, #13, #10, #9]))
    then begin
      Result := lcString;
      if FQuotedString then
        AddToLexemArray(Pos, 1);
      Inc(Pos);
      FSavedPos := Pos;
      ToRightQuote('$');
      DollarTag := CopyText(FSavedPos, Pos - FSavedPos);
      if FQuotedString and (Pos > FSavedPos) then
        AddToLexemArray(FSavedPos, Pos - FSavedPos);
      if Pos <= TextLength then begin
        if FQuotedString then
          AddToLexemArray(Pos, 1);
        Inc(Pos);
        repeat
          FSavedPos := Pos;
          ToRightQuote('$');
          if Pos > FSavedPos then
            AddToLexemArray(FSavedPos, Pos - FSavedPos);
          DollarPos := Pos;
          if Pos <= TextLength then begin
            AddToLexemArray(Pos, 1);
            Inc(Pos);
            FSavedPos := Pos;
            ToRightQuote('$');
            Tag := CopyText(FSavedPos, Pos - FSavedPos);
            if Pos > FSavedPos then
              AddToLexemArray(FSavedPos, Pos - FSavedPos);
          end;
        until (Tag = DollarTag) or (Pos > TextLength);
        if Pos <= TextLength then begin
          if FQuotedString then
            AddToLexemArray(Pos, 1)
          else
            Dec(FLexemLength, Pos - DollarPos);
          Inc(Pos);
        end;
      end;
    end
    else begin
      Result := lcSymbol;
      SymbolPos := Pos + 1;   // WAR
      FLexemPos := Pos;
      FLexemLength := 0;
      St := Pos;
      StLength := 1;

      repeat
        AddToLexemArray(Pos, 1);
        Inc(Pos);
        c := Text[Pos];
        // Find
      {$IFNDEF CLR}
        if not (AnsiChar(Text[FLexemPos]) in FSymbolChars) then
          i := -1
        else
      {$ENDIF}
          i := FindLexemIndex(FLexemPos, FLexemLength, FSymbolLexems);
        if i <> - 1 then begin
          FLexem := FSymbolLexems[i];

          SymbolPos := Pos;
          Result := FSymbolLexems.Values[i];
          Assert(Result > 0);
        end
        else
          Dec(FLexemLength);
      until not IsSymbol(c);

      if Result = lcSymbol then begin
        FLexemPos := St;
        FLexemLength := StLength;
        if DL then begin
          // Assert(Length(FDesiredLexem) <= 1);
          if Length(FDesiredLexem) = 1 then
            FDesiredLexemFound := (FDesiredLexem[1] = Text[FLexemPos]);
        end;
      end
      else
      if DL then
        FDesiredLexemFound := (FDesiredLexem = FLexem);

      Pos := SymbolPos;
    end
  end
  else
    raise Exception.Create('Parser: The unknown symbol ''' + Text[Pos] + '''  $' + IntToHex(Word(Text[Pos]), 4));

  Assert(Result <> - MaxInt);
end;

function TParser.GetNext(out Lexem: string): integer;
begin
  Result := GetNextToken;
  Lexem := FLexem;
end;

function TParser.GetNextToken: integer;
var
  i: integer;
begin
{$IFDEF PERF_COUNTER}
  PerfCounters[2].Start;//}
  try
{$ENDIF}

  FToken := InternalGetNext; // FToken is not in KeywordLexems
  if FToken <= 0 then
    if FLexemLength = 0 then
      FLexem := ''
    else begin
      Assert(FLexemPos > 0);
      FLexem := CopyText(FLexemPos, FLexemLength);
    end
  else
    Assert(FLexem <> '');

  if not FOmitKeywords and (FToken = lcIdent) then begin
    Assert(FLexemPos > 0);
    Assert(FLexemLength > 0);
    i := FindLexemIndex(FLexemPos, FLexemLength, FKeywordLexems);
    if i <> -1 then begin
      FToken := FKeywordLexems.Values[i];
      Assert(FToken > 0);
      if Uppered then
        FLexem := AnsiUpperCase(FLexem);  //WAR problem with macros as key words
    end;
  end;

  Assert(FToken <> - MaxInt);

  Result := FToken;

{$IFDEF PERF_COUNTER}
  finally
    PerfCounters[2].Stop;
  end;
{$ENDIF}
end;

function TParser.ToLexem(const Code: integer; const SkipSubQueries: boolean = False): integer;
var
  BracketCount: integer;
  St: string;
begin
  if SkipSubQueries then begin
    BracketCount := 0;
    repeat
      Result := GetNext(St);
      if Result = lcSymbol then begin
        if St = '(' then
          Inc(BracketCount)
        else
          if St = ')' then
            Dec(BracketCount);
      end;
    until ((Result = Code) and (BracketCount = 0)) or (Result = lcEnd);
  end
  else
    repeat
      Result := GetNext(St);
    until (Result = Code) or (Result = lcEnd);
end;

function TParser.ToLexem(const Codes: array of integer): integer;
var
  BracketCount: integer;
  St: string;
  i: integer;
begin
  BracketCount := 0;
  repeat
    Result := GetNext(St);
    if Result = lcSymbol then begin
      if St = '(' then
        Inc(BracketCount)
      else
        if St = ')' then
          Dec(BracketCount);
    end
    else
    if BracketCount = 0 then
      for i := Low(Codes) to High(Codes) do
        if Result = Codes[i] then
          Exit;
  until Result = lcEnd;
end;

function TParser.ToLexem(const Lexem: string): boolean;
begin
  try
    FDesiredLexem := UpperCase(Lexem);
    FDesiredLexemFound := False;

    while (InternalGetNext <> lcEnd) and not FDesiredLexemFound do;

    Result := FDesiredLexemFound;
  finally
    FDesiredLexem := '';
    FDesiredLexemFound := False;
  end;
end;

function TParser.IsSymbolCode(Code: integer): boolean;
begin
  Result := (Code > 0) and (Code <= SymbolLexems.Count);
end;

function TParser.GetSymbolByCode(Code: integer): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to SymbolLexems.Count - 1 do
    if Code = SymbolLexems.Values[i] then begin
      Result := SymbolLexems[i];
      exit;
    end;
end;

function TParser.CurrPos: Int64;
begin
  Result := {$IFDEF FPC}Int64{$ENDIF}(Pos) - 1 + Offset;
end;

function TParser.PrevPos: Int64;
begin
  Result := OldPos - 1;
end;

function TParser.PrevPrevPos: Int64;
begin
  Result := OldOldPos - 1;
end;

function TParser.CurrLine: Int64;
begin
  Result := FCurrLine;
end;

function TParser.PrevLine: Int64;
begin
  Result := FPrevLine;
end;

function TParser.CurrCol: Int64;
begin
  Result := {$IFDEF FPC}Int64{$ENDIF}(Pos) - FCurrBegLine;
end;

function TParser.PrevCol: Int64;
begin
  Result := OldPos - FPrevBegLine;
end;

function TParser.GetCharSize(ByteSize: int64): int64;
begin
  if FEncoding = Encoding.Unicode then
    Result := ByteSize div 2
  else
    Result := ByteSize
end;

procedure TParser.ReadNextBlock;
var
  SavedPos: integer;
  StoredBlockPos: integer;
  Buffer: TBytes;
  Size: integer;
begin
  if (FSavedPos > -1) and ((FSavedPos < FLexemPos) or (FLexemPos = -1)) then
    SavedPos := FSavedPos
  else
    SavedPos := FLexemPos;

  if ((SavedPos > Pos) or (SavedPos = -1)) and (FCurrentBlock <> '') then
    SavedPos := Pos;

  if SavedPos > -1 then begin
    StoredBlockPos := FFirstBlockOffset;
    while FStoredBlocks.Count > 0 do begin
      StoredBlockPos := StoredBlockPos + Length(FStoredBlocks[0]);
      if SavedPos >= StoredBlockPos then
        FStoredBlocks.Delete(0)
      else
        break;
    end;

    if SavedPos < FBlockOffset + FBlockSize then
      FStoredBlocks.Add(FCurrentBlock);
  end;

  if FStoredBlocks.Count = 0 then
    FFirstBlockOffset := FBlockOffset + FBlockSize
  else
  if FStoredBlocks.Count = 1 then
    FFirstBlockOffset := FBlockOffset;

  FBlockOffset := FBlockOffset + FBlockSize;

{$IFNDEF CLR}
  if FEncoding = Encoding.{$IFDEF IS_UNICODE}Unicode{$ELSE}Default{$ENDIF} then begin
    SetLength(FCurrentBlock, BLOCK_SIZE div sizeof(char));
    FBlockSize := FStream.Read(FCurrentBlock[1], BLOCK_SIZE) div sizeof(char);
    SetLength(FCurrentBlock, FBlockSize);
  end
  else
{$ENDIF}
  begin
    SetLength(Buffer, BLOCK_SIZE);
    Size := FStream.Read(Buffer{$IFNDEF CLR}[0]{$ENDIF}, BLOCK_SIZE);
    FCurrentBlock := FEncoding.GetString(Buffer, 0, Size);
    FBlockSize := Length(FCurrentBlock);

    if (Size <> FBlockSize) and (FEncoding <> Encoding.Unicode) then begin // Variable char length included
      StreamLength := StreamLength - ({$IFDEF FPC}Int64{$ENDIF}(Size) - FBlockSize);
      TextLength := TextLength - (Size - FBlockSize);
    end;
  end;
end;

function TParser.GetStoredChar(Index: integer): char;
var
  StoredBlockPos: integer;
  i, n: Integer;
begin
  if Index >= FFirstBlockOffset then begin
    StoredBlockPos := FFirstBlockOffset;
    for i := 0 to FStoredBlocks.Count - 1 do begin
      n := Length(FStoredBlocks[i]);
      if Index < StoredBlockPos + n then begin
        Result := FStoredBlocks[i][Index - StoredBlockPos + 1];
        exit;
      end;
      StoredBlockPos := StoredBlockPos + n;
    end;
  end;
  
  Result := #0;
  Assert(False);
end;

function TParser.GetChar(Index: integer): char;
begin
  if Index > TextLength then
    Result := #0
  else begin
    if Index >= FBlockOffset + FBlockSize then
      ReadNextBlock;

    if Index >= FBlockOffset then
      Result := FCurrentBlock[Index - FBlockOffset + 1]
    else
      Result := GetStoredChar(Index);
  end;
end;

procedure TParser.DecreaseBlockParameters;
begin
  if FFirstBlockOffset > BLOCK_SIZE then begin
    FCurrBegLine := FCurrBegLine - FFirstBlockOffset + 1;
    FBlockOffset := FBlockOffset - FFirstBlockOffset + 1;
    Pos := Pos - FFirstBlockOffset + 1;
    if FLexemPos > -1 then
      FLexemPos := FLexemPos - FFirstBlockOffset + 1;

    Offset := Offset + FFirstBlockOffset - 1;
    FFirstBlockOffset := 1;

    if StreamLength - Offset > MaxInt then
      TextLength := MaxInt
    else
      TextLength := StreamLength - Offset;
  end;
end;

procedure TParser.AddToLexemArray(Index: integer; const Len: integer);
begin
  FSavedPos := -1;
  if FLexemPos = -1 then
    FLexemPos := Index;
  Inc(FLexemLength, Len);
end;

function TParser.CopyText(const Pos, Count: integer): string;
var
  sb: StringBuilder;
  i: integer;
begin
  if Pos < FBlockOffset then begin
    sb := StringBuilder.Create(Count);
    try
      for i := 0 to FStoredBlocks.Count - 1 do
        if i = 0 then
          sb.Append(Copy(FStoredBlocks[i], Pos - FFirstBlockOffset + 1, Count))
        else
          sb.Append(FStoredBlocks[i]);

      sb.Append(Copy(FCurrentBlock, 1, Pos + Count - FBlockOffset));
      Result := sb.ToString;
    finally
      sb.Free;
    end;
  end
  else
    Result := Copy(FCurrentBlock, Pos - FBlockOffset + 1, Count);
end;

{ TSQLParser }

procedure TSQLParser.InitParser;
begin
  inherited;

  FKeywordLexems := SQLKeywordLexems;
  FSymbolLexems := SQLSymbolLexems;
{$IFNDEF CLR}
  FSymbolChars := SQLSymbolChars;
{$ENDIF}

  SetLength(FClauses, 7);
  FClauses[0] := lxWHERE;
  FClauses[1] := lxGROUP;
  FClauses[2] := lxHAVING;
  FClauses[3] := lxUNION;
  FClauses[4] := lxINTERSECT;
  FClauses[5] := lxMINUS;
  FClauses[6] := lxORDER;

  FDecSeparator := '.'; // To avoid 'INSERT INTO t(f1, f2) VALUES(:1,2)'
end;

function TSQLParser.IsAlpha(Ch: char): boolean;
begin
  case Ord(Ch) of
    Ord('a')..Ord('z'):
      Result := True;
    Ord('A')..Ord('Z'):
      Result := True;
    Ord('$'):
      Result := True;
    Ord('#'):
      Result := True;
    Ord(#128)..Ord(High(char)):
      Result := True;
    else
      Result := False;
  end;
end;

function TSQLParser.IsStringQuote(Ch: char): boolean;
begin
  case Ch of
    '''':
      Result := True;
    else
      Result := False;
  end;
end;

function TSQLParser.IsIdentQuote(Ch: char): boolean;
begin
  case Ch of
    '"':
      Result := True;
    else
      Result := False;
  end;
end;

function TSQLParser.IsInlineComment(Ch: char; Pos: integer): boolean;
begin
  Result := (Ch = '-') and (TextLength >= Pos + 1) and (Text[Pos + 1] = '-');
end;

function TSQLParser.IsClauseLexem(Code: integer): boolean;
begin
  Result := PosClauseLexem(Code) <> -1;
end;

function TSQLParser.PosClauseLexem(Code: integer): integer;
var
  i: integer;
begin
  Assert(Length(FClauses) > 0);
  Result := -1;
  for i := Low(FClauses) to High(FClauses) do
    if Code = FClauses[i] then begin
      Result := i;
      Exit;
    end;
end;

function TSQLParser.CompareClauseLexems(const Code1, Code2: integer): integer;
var
  Pos1, Pos2: Integer;
begin
  Pos1 := PosClauseLexem(Code1);
  Pos2 := PosClauseLexem(Code2);

  if (Pos1 = -1) or (Pos2 = -1) then
    Result := -2
  else
  if Pos1 > Pos2 then
    Result := 1
  else
  if Pos1 < Pos2 then
    Result := -1
  else
    Result := 0;
end;

function TSQLParser.IsMacroAllowed(Code: integer): boolean;
begin
  Result := Code <> lcString;
end;

class function TSQLParser.IsNumericMacroNameAllowed: boolean;
begin
  Result := False;
end;

class function TSQLParser.IsSelectModifier(Code: integer): boolean;
begin
  case Code of
    lxALL, lxDISTINCT:
      Result := True;
  else
    Result := False;
  end;
end;

class function TSQLParser.IsFunctionOrConst(const UpperedName: string): boolean;
begin
  if UpperedName = 'NULL' then
    Result := True
  else
    Result := False;
end;

class function TSQLParser.IsQuasiColumn(const UpperedName: string): boolean;
begin
  Result := False;
end;

function _GetFromOrWhere(
  const SQL: string;
  ParserClass: TSQLParserClass;
  OmitComment: boolean;
  NeedCode: integer; // From or Where code
  const MacroChar: string
): string;
var
  Parser: TSQLParser;
  FirstPos: integer;
  StLex: string;
  Code, BracketCount: integer;
  IsMacro: boolean;
begin
  Result := '';
  Parser := ParserClass.Create(SQL);
  Parser.OmitComment := OmitComment;
  try
    if Parser.ToLexem(lxSELECT) <> lcEnd then begin
      FirstPos := 0;
      BracketCount := 0;
      IsMacro := False;
      repeat
        Code := Parser.GetNext(StLex);
        if (Code = NeedCode) and (not IsMacro) and (BracketCount = 0) then
          FirstPos := Parser.CurrPos + 2
        else
          if Code = lcSymbol then
            if StLex = '(' then
              Inc(BracketCount)
            else
              if StLex = ')' then
                Dec(BracketCount);

        IsMacro := (Code <> lcString) and (StLex = MacroChar);
        if (BracketCount = 0) and Parser.IsClauseLexem(Code) and (Code <> NeedCode) then begin
          Parser.Back;
          Break;
        end;
      until Code = lcEnd;

      if FirstPos > 0 then
        Result := Copy(SQL, FirstPos, Parser.CurrPos - FirstPos + 1);
    end;
  finally
    Parser.Free;
  end;
end;

function _GetFrom(
  const SQL: string;
  ParserClass: TSQLParserClass;
  OmitComment: boolean;
  const MacroChar: string
): string;
begin
  Result := _GetFromOrWhere(SQL, ParserClass, OmitComment, lxFROM, MacroChar);
end;

function _GetWhere(
  const SQL: string;
  ParserClass: TSQLParserClass;
  OmitComment: boolean;
  const MacroChar: string
): string;
begin
  Result := _GetFromOrWhere(SQL, ParserClass, OmitComment, lxWHERE, MacroChar);
end;

function _GetOrderBy(
  const SQL: string;
  ParserClass: TSQLParserClass
): string;
var
  Parser: TSQLParser;
  FirstPos: integer;
  StLex: string;
  Code, BracketCount: integer;
begin
  Result := '';
  Parser := ParserClass.Create(SQL);
  Parser.OmitComment := True;
  try
    if Parser.ToLexem(lxSELECT) <> lcEnd then begin
      FirstPos := 0;
      BracketCount := 0;
      repeat
        Code := Parser.GetNext(StLex);
        if (Code = lxORDER) and (BracketCount = 0) then begin
          if Parser.GetNextToken = lxBY then begin
            FirstPos := Parser.CurrPos + 2;
            Break;
          end;
        end
        else if Code = lcSymbol then
          if StLex = '(' then
            Inc(BracketCount)
          else
            if (StLex = ')') and (BracketCount > 0) then
              Dec(BracketCount);
      until Code = lcEnd;

      if FirstPos > 0 then begin
        repeat
          Code := Parser.GetNextToken;
          if Code = lcSymbol then begin
            if Parser.Lexem = '(' then
              Inc(BracketCount)
            else
              if Parser.Lexem = ')' then
                Dec(BracketCount);
          end;
          if Parser.IsClauseLexem(Code) and (BracketCount = 0) then begin
            Parser.Back;
            Break;
          end;
        until Code = lcEnd;

        Result := Trim(Copy(SQL, FirstPos, Parser.CurrPos - FirstPos + 1));
      end;
    end;
  finally
    Parser.Free;
  end;
end;

function _AddWhere(
  const SQL: string; const Condition: string;
  ParserClass: TSQLParserClass;
  OmitComment: boolean;
  const MacroChar: string
): string;
var
  Parser: TSQLParser;
  IsWhere: boolean;
  Code: integer;
  PrevCode: integer;
  St, StLex: string;
  BracketCount: integer;
  WherePos: integer;
  NeedBracket: boolean;
  Bracket: string;
  IsMacro: boolean;
begin
  Result := SQL;

  if Trim(Condition) = '' then
    Exit;

  Parser := ParserClass.Create(SQL);
  Parser.OmitComment := OmitComment;

  try
    Code := Parser.ToLexem([lxWITH, lxSELECT]);
    if Code = lxWITH then
      Code := Parser.ToLexem(lxSELECT, True);

    if Code <> lcEnd then begin
      IsMacro := False;
      IsWhere := False;
      NeedBracket := False;
      WherePos := 0;
      Code := 0;
      BracketCount := 0;
      repeat
        PrevCode := Code;
        Code := Parser.GetNext(StLex);
        if (Code = lxWHERE) and (not IsMacro) and (BracketCount = 0) then begin
          IsWhere := True;
          WherePos := Parser.CurrPos + 2;
          NeedBracket := True;
        end
        else
          if Code = lcSymbol then
            if StLex = '(' then
              Inc(BracketCount)
            else
              if StLex = ')' then
                Dec(BracketCount);

        IsMacro := (Code <> lcString) and (StLex = MacroChar);
        if (BracketCount = 0) and Parser.IsClauseLexem(Code) and (Code <> lxWHERE) then
          Break;
      until Code = lcEnd;

      if NeedBracket then begin
        if PrevCode = lcComment then
          Bracket := SLLineSeparator + ')'
        else
          Bracket := ')';
      end;

      if not IsWhere then
        St := SLLineSeparator + 'WHERE ' + Condition + ' '
      else
        if (PrevCode = lcComment) and not NeedBracket then
          St := SLLineSeparator +'AND ' + Condition + ' '
        else
          St := ' AND ' + Condition + ' ';

      if Code = lcEnd then begin
        if NeedBracket then begin
          Insert('(', Result, WherePos);
          Result := Trim(Result) + Bracket + St;
        end
        else
          if PrevCode <> 7 {';'} then
            Result := Trim(Result) + St
          else
            Insert(St, Result, Parser.PrevPos);
      end
      else
        if NeedBracket then begin
          Insert(Bracket + St, Result, Parser.PrevPos + 1);
          Insert('(', Result, WherePos);
        end
        else
          Insert(St, Result, Parser.PrevPos + 1);
    end;
  finally
    Parser.Free;
  end;
end;

function _SetWhere(
  const SQL: string; Condition: string;
  ParserClass: TSQLParserClass;
  OmitComment: boolean
): string;
var
  Parser: TSQLParser;
  FirstPos: integer;
  LastPos: integer;
  Code, PrevCode: integer;
  StLex: string;
  BracketCount: integer;
begin
  Result := SQL;
  Parser := ParserClass.Create(SQL);
  Parser.OmitBlank := False;
  Parser.OmitComment := OmitComment;
  try
    Code := Parser.ToLexem([lxWITH, lxSELECT]);
    if Code = lxWITH then
      Code := Parser.ToLexem(lxSELECT, True);

    if Code <> lcEnd then begin
      FirstPos := 0;
      LastPos := 0;
      BracketCount := 0;
      PrevCode := lcEnd;
      Code := Parser.GetNext(StLex);
      repeat
        if Code = lcBlank then begin
          if LastPos = 0 then
            LastPos := Parser.PrevPos;
        end
        else begin
          LastPos := 0;

          if Code = lxWHERE then begin
            if BracketCount = 0 then begin
              if Condition = '' then begin
                if PrevCode = lcBlank then
                  FirstPos := Parser.PrevPrevPos + 1
                else
                  FirstPos := Parser.PrevPos + 1;
              end
              else begin
                Parser.GetNext(StLex); // blank
                FirstPos := Parser.CurrPos + 1;
              end;
            end;
          end
          else
          if Code = lcSymbol then begin
            if StLex = '(' then
              Inc(BracketCount)
            else
              if StLex = ')' then
                Dec(BracketCount);
          end;
        end;

        PrevCode := Code;
        Code := Parser.GetNext(StLex);
      until (Code = lcEnd) or (Parser.IsClauseLexem(Code) and (Code <> lxWHERE)) and (BracketCount = 0);

      if LastPos = 0 then
        LastPos := Length(Result);

      if FirstPos > 0 then
        Delete(Result, FirstPos, LastPos - FirstPos + 1);

      if Condition <> '' then begin
        if FirstPos = 0 then begin
          FirstPos := LastPos + 1;
          Condition := ' WHERE ' + Condition;
          if Pos(#13, Copy(Result, 1, FirstPos)) > 0 then
            Condition := SLLineSeparator + ' ' + Condition;
        end;
        Insert(Condition, Result, FirstPos);
      end;
    end;
  finally
    Parser.Free;
  end;
end;

function _SetOrderBy(
  const SQL: string; Fields: string;
  ParserClass: TSQLParserClass
): string;
var
  Parser: TSQLParser;
  FirstPos: integer;
  LastPos: integer;
  Code, PrevCode: integer;
  StLex: string;
  i, BracketCount: integer;
begin
  for i := 1 to Length(Fields) do
    if Fields[i] = ';' then
      Fields[i] := ',';

  Result := SQL;
  Parser := ParserClass.Create(Result);
  Parser.OmitBlank := False;
  Parser.OmitComment := True;
  try
    if Parser.ToLexem(lxSELECT) <> lcEnd then begin
      FirstPos := 0;
      LastPos := 0;
      BracketCount := 0;
      PrevCode := lcEnd;
      Code := Parser.GetNext(StLex);
      repeat
        if Code = lcBlank then begin
          if LastPos = 0 then
            LastPos := Parser.PrevPos;
        end
        else begin
          LastPos := 0;

          if Code = lxORDER then begin
            if BracketCount = 0 then begin
              if Fields = '' then
                if PrevCode = lcBlank then
                  FirstPos := Parser.PrevPrevPos + 1
                else
                  FirstPos := Parser.PrevPos + 1;
              Parser.GetNext(StLex);  // blank
              if Parser.GetNext(StLex) = lxBY then begin
                if Fields <> '' then begin
                  Parser.GetNext(StLex); // blank
                  FirstPos := Parser.CurrPos + 1;
                end;
                repeat
                  Code := Parser.GetNext(StLex);
                  // To ommit SELECT and etc in brackets
                  if Code = lcSymbol then begin
                    if StLex = '(' then
                      Inc(BracketCount)
                    else
                    if StLex = ')' then
                      Dec(BracketCount);
                  end;
                until (Code in [lcEnd, lxSQLFirst..lxWITH]) and (BracketCount = 0);
                if Code <> lcEnd then
                  LastPos := Parser.PrevPos - 1;
                Break;
              end
              else
                FirstPos := 0;
            end;
          end
          else
          if Code = lcSymbol then begin
            if StLex = '(' then
              Inc(BracketCount)
            else
              if (StLex = ')') and (BracketCount > 0) then
                Dec(BracketCount);
          end;
        end;

        PrevCode := Code;
        Code := Parser.GetNext(StLex);
      until (Code = lcEnd) or ((Parser.CompareClauseLexems(Code, lxORDER) > 0) and (BracketCount = 0));

      if LastPos = 0 then
        LastPos := Length(Result);

      if FirstPos > 0 then
        Delete(Result, FirstPos, LastPos - FirstPos + 1);

      if Fields <> '' then begin
        if FirstPos = 0 then begin
          FirstPos := LastPos + 1;
          Fields := ' ORDER BY ' + Fields;
          if Pos(#13, Copy(Result, 1, FirstPos)) > 0 then
            Fields := SLLineSeparator + ' ' + Fields;
        end;
        Insert(Fields, Result, FirstPos);
      end;
    end;
  finally
    Parser.Free;
  end;
end;

{$IFNDEF CLR}
var
  i: integer;
{$ENDIF}

initialization
  CommonSymbolLexems := TIntValueStringList.Create;
  CommonKeywordLexems := TIntValueStringList.Create;

  CommonSymbolLexems.Add('!', 1);
  CommonSymbolLexems.Add('"', 2);
  CommonSymbolLexems.Add('#', 3);
  CommonSymbolLexems.Add('$', 4);
  CommonSymbolLexems.Add('%', 5);
  CommonSymbolLexems.Add('&', 6);
  CommonSymbolLexems.Add('''', 7);
  CommonSymbolLexems.Add('(', 8);
  CommonSymbolLexems.Add(')', 9);
  CommonSymbolLexems.Add('*', 10);
  CommonSymbolLexems.Add('+', 11);
  CommonSymbolLexems.Add(',', 12);
  CommonSymbolLexems.Add('-', 13);
  CommonSymbolLexems.Add('.', 14);
  CommonSymbolLexems.Add('/', 15);
  CommonSymbolLexems.Add(':', 16);
  CommonSymbolLexems.Add(';', 17);
  CommonSymbolLexems.Add('<', 18);
  CommonSymbolLexems.Add('=', 19);
  CommonSymbolLexems.Add('>', 20);
  CommonSymbolLexems.Add('?', 21);
  CommonSymbolLexems.Add('@', 22);
  CommonSymbolLexems.Add('[', 23);
  CommonSymbolLexems.Add('\', 24);
  CommonSymbolLexems.Add(']', 25);
  CommonSymbolLexems.Add('^', 26);
  CommonSymbolLexems.Add('_', 27);
  CommonSymbolLexems.Add('`', 28);
  CommonSymbolLexems.Sort;

{$IFNDEF CLR}
  // Performance optimization
  CommonSymbolChars := [];
  for i := 0 to CommonSymbolLexems.Count - 1 do
    CommonSymbolChars := CommonSymbolChars + [AnsiChar(CommonSymbolLexems[i][1])];
{$ENDIF}

  CommonKeywordLexems.Add('AND', 29);
  CommonKeywordLexems.Add('NOT', 30);
  CommonKeywordLexems.Add('OR', 31);
  CommonKeywordLexems.Sort;

  SQLSymbolLexems := TIntValueStringList.Create;
  SQLKeywordLexems := TIntValueStringList.Create;

  SQLSymbolLexems.Add('*', 1);
  SQLSymbolLexems.Add('=', 2);
  SQLSymbolLexems.Add(':', 3);
  SQLSymbolLexems.Add(',', 4);
  SQLSymbolLexems.Add('.', 5);
  SQLSymbolLexems.Add('/', 6);
  SQLSymbolLexems.Add(';', 7);
  SQLSymbolLexems.Sort;

{$IFNDEF CLR}
  // Performance optimization
  SQLSymbolChars := [];
  for i := 0 to SQLSymbolLexems.Count - 1 do
    SQLSymbolChars := SQLSymbolChars + [AnsiChar(SQLSymbolLexems[i][1])];
{$ENDIF}

  SQLKeywordLexems.Add('ALL',       lxALL      );
  SQLKeywordLexems.Add('AND',       lxAND      );
  SQLKeywordLexems.Add('AS',        lxAS       );
  SQLKeywordLexems.Add('BEGIN',     lxBEGIN    );
  SQLKeywordLexems.Add('BY',        lxBY       );
  SQLKeywordLexems.Add('COMMIT',    lxCOMMIT   );
  SQLKeywordLexems.Add('DELETE',    lxDELETE   );
  SQLKeywordLexems.Add('DISTINCT',  lxDISTINCT );
  SQLKeywordLexems.Add('END',       lxEND      );
  SQLKeywordLexems.Add('EXECUTE',   lxEXECUTE  );
  SQLKeywordLexems.Add('FETCH',     lxFETCH    );
  SQLKeywordLexems.Add('FOR',       lxFOR      );
  SQLKeywordLexems.Add('FROM',      lxFROM     );
  SQLKeywordLexems.Add('FULL',      lxFULL     );
  SQLKeywordLexems.Add('GROUP',     lxGROUP    );
  SQLKeywordLexems.Add('HAVING',    lxHAVING   );
  SQLKeywordLexems.Add('INNER',     lxINNER    );
  SQLKeywordLexems.Add('INSERT',    lxINSERT   );
  SQLKeywordLexems.Add('INTO',      lxINTO     );
  SQLKeywordLexems.Add('IS',        lxIS       );
  SQLKeywordLexems.Add('JOIN',      lxJOIN     );
  SQLKeywordLexems.Add('LEFT',      lxLEFT     );
  SQLKeywordLexems.Add('LIMIT',     lxLIMIT    );
  SQLKeywordLexems.Add('LOCK',      lxLOCK     );
  SQLKeywordLexems.Add('MINUS',     lxMINUS    );
  SQLKeywordLexems.Add('NOT',       lxNOT      );
  SQLKeywordLexems.Add('OFFSET',    lxOFFSET   );
  SQLKeywordLexems.Add('ON',        lxON       );
  SQLKeywordLexems.Add('OR',        lxOR       );
  SQLKeywordLexems.Add('ORDER',     lxORDER    );
  SQLKeywordLexems.Add('OUTER',     lxOUTER    );
  SQLKeywordLexems.Add('RELEASE',   lxRELEASE  );
  SQLKeywordLexems.Add('RETURNING', lxRETURNING);
  SQLKeywordLexems.Add('RIGHT',     lxRIGHT    );
  SQLKeywordLexems.Add('ROLLBACK',  lxROLLBACK );
  SQLKeywordLexems.Add('SAVEPOINT', lxSAVEPOINT);
  SQLKeywordLexems.Add('SELECT',    lxSELECT   );
  SQLKeywordLexems.Add('SET',       lxSET      );
  SQLKeywordLexems.Add('TO',        lxTO       );
  SQLKeywordLexems.Add('TRANSACTION', lxTRANSACTION);
  SQLKeywordLexems.Add('UNION',     lxUNION    );
  SQLKeywordLexems.Add('UPDATE',    lxUPDATE   );
  SQLKeywordLexems.Add('WHERE',     lxWHERE    );
  SQLKeywordLexems.Add('WITH',      lxWITH     );
  SQLKeywordLexems.Sort;

{$IFDEF PERF_COUNTER}
  PerfCounters[2].Name := 'Parser.Next';
  PerfCounters[8].Name := 'Parser.Code';
  PerfCounters[9].Name := 'Parser.FindLexemIndex';
{$ENDIF}

finalization
  CommonSymbolLexems.Free;
  CommonKeywordLexems.Free;
  SQLSymbolLexems.Free;
  SQLKeywordLexems.Free;

end.
