abslexer.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

          inc(column,1);
          break;
         end; // '
       end; // quote symbol

      Commands[command].Tokens[token].Text :=
         Commands[command].Tokens[token].Text + c;
      if (c = lf) then
       begin
        inc(line);
        column := 1;
       end
      else
       if (c <> cr) then
        inc(column);
      inc(i);
     end; // while
    CloseToken;
    if quoteSymbol in [BackQuote, RightSquareBracket] then
      Commands[command].Tokens[token].ReservedWord := rwNone;
   end
  else
  if (c = LeftParenthesis) then
   begin
    Commands[command].Tokens[token].TokenType := tktLeftParenthesis;
    CloseToken;
    inc(numParenthesis);
    LeftParenthesisLine := line;
    LeftParenthesisColumn := column;
   end
  else
  if (c = RightParenthesis) then
   begin
    dec(numParenthesis);
    RightParenthesisLine := line;
    RightParenthesisColumn := column;
    Commands[command].Tokens[token].TokenType := tktRightParenthesis;
    CloseToken;
   end
  else
  if (c = Dot) then //!!
   begin
    Commands[command].Tokens[token].TokenType := tktDot;
    //CloseToken;
   end
  else
  if (c = Comma) then
   begin
    Commands[command].Tokens[token].TokenType := tktComma;
    CloseToken;
   end
  else
  if ((c >= '0') and (c <= '9')) then
    Commands[command].Tokens[token].TokenType := tktInt
  else
   Commands[command].Tokens[token].TokenType := tktString;
  if (c = '-') or (c = '+') or (c = '*') or (c = '/') or (c = '=') then
   CloseToken;
  if (c = '|') then
   begin
    NextSymbol := GetNextSymbol;
    if (NextSymbol = '|') then
     begin
      Commands[command].Tokens[token].Text :=
        Commands[command].Tokens[token].Text + NextSymbol;
      inc(i);
      inc(column);
     end;
    CloseToken;
   end; // <
  if (c = '<') then
   begin
    NextSymbol := GetNextSymbol;
    if (NextSymbol = '=') or (NextSymbol = '>') then
     begin
      Commands[command].Tokens[token].Text :=
        Commands[command].Tokens[token].Text + NextSymbol;
      inc(i);
      inc(column);
     end;
    CloseToken;
   end; // <
  if (c = '>') then
   begin
    NextSymbol := GetNextSymbol;
    if (NextSymbol = '=') then
     begin
      Commands[command].Tokens[token].Text :=
        Commands[command].Tokens[token].Text + NextSymbol;
      inc(i);
      inc(column);
     end;
    CloseToken;
   end; // >
 end; // CreateToken;

 procedure CloseCommand;
 begin
  CloseToken;
  bCommandStarted := false;

  if (numParenthesis > 0) then
    raise EABSException.Create(30059, ErrorGMissingRightParenthesis,
                                  [LeftParenthesisLine,LeftParenthesisColumn]);
  if (numParenthesis < 0) then
    raise EABSException.Create(30060, ErrorGUnexpectedRightParenthesis,
                                  [LeftParenthesisLine,LeftParenthesisColumn]);
  priorSymbol := ' ';

  if (bQuoteNotClosed) then
    raise EABSException.Create(30061, ErrorGUnterminatedString,
                                                       [quoteLine,quoteColumn]);
 end; // CloseCommand;

 var NextSymbol: char;
begin
 l := Length(FSQL);
 line := 1;
 column := 1;
 NumCommands := 0;
 Commands := nil;
 bTokenStarted := false;
 bQuoteNotClosed := false;
 bCommandStarted := false;
 command := 0;
 token := 0;
 priorSymbol := ' ';
 numParenthesis := 0;
 LeftParenthesisLine := 0;
 LeftParenthesisColumn := 0;
 RightParenthesisLine := 0;
 RightParenthesisColumn := 0;
 LastParamNo := 0;
 i := 0;
 while (i < l) do
  begin
   // get current character
   c := pChar(pChar(FSQL)+i)^;

   // end of the current comand
   if (c = ';') then
    begin
     CloseCommand;
     inc(i);
     continue;
    end;

   // check for comment
   if (c = '-') then
    begin
     NextSymbol := GetNextSymbol;
     if (NextSymbol = '-') then
      begin
       // seek for end of line
       inc(i);
       column := 1;
       inc(line);
       while (i < l) do
        begin
         c := pChar(pChar(FSQL)+i)^;
         if (c = lf) then
           break;
         inc(i);
        end;
       inc(i);
       continue;
      end;
    end; // comment --

   // check for comment
   if (c = '/') then
    begin
     NextSymbol := GetNextSymbol;
     if (NextSymbol = '*') then
      begin
       // commentary started
       inc(i,2);
       inc(column,2);
       while (i < l) do
        begin
          c := pChar(pChar(FSQL)+i)^;
          if (c = '*') then
           begin
             NextSymbol := GetNextSymbol;
             if (NextSymbol = '/') then
              begin
               inc(i,2);
               inc(column,2);
               break;
              end;
           end;
          if (c = lf) then
           begin
            inc(line);
            column := 1;
           end
          else
           if (c <> cr) then
            inc(column);
          inc(i);
        end; // while
       continue;
      end; // comment /* */ started
    end;


   // is this symbol a delimiter?
   bIsDelimiter := false;
   if (c = Tab) or (c = CR) or (c = LF) or (c = Space) then
    bIsDelimiter := true;

   bTokenFinished := IsTokenFinished;
   bNewTokenStarted := IsNewTokenStarted;
   if (bTokenFinished) or (bTokenStarted and bNewTokenStarted) then
    CloseToken;
   if (bNewTokenStarted) then
    CreateToken;

   // add current symbol to token
   if (not bNewTokenStarted) and (bTokenStarted) and (not bIsDelimiter) then
    begin
     // check for number
     if Commands[command].Tokens[token].TokenType in [tktInt,tktFloat] then
      if not ((c >= '0') and (c <= '9') or (c = Dot) or
              (UpperCase(c)='E') or (c = '+') or (c = '-') ) then
        raise EABSException.Create(30062, ErrorGInvalidNumericSymbol,
                                                              [c,line,column]);
      // check float type .22
      if (Commands[command].Tokens[token].TokenType = tktDot) and
         (c >= '0') and (c <= '9') then
       begin
        Commands[command].Tokens[token].TokenType := tktInt;
       end;
     // add current symbol to token
    Commands[command].Tokens[token].Text :=
      Commands[command].Tokens[token].Text + c;
    end;

   if (c = lf) then
    begin
     inc(line);
     column := 1;
    end
   else
    if (c <> cr) then
     inc(column);
   // skip delimiters
   if (bIsDelimiter) then
    begin
     if (bTokenStarted) then
      CloseToken;
    end;
   // next symbol
   priorSymbol := c;
   inc(i);
  end; // for all symbols in FSQL

 CloseCommand;
end; // Parse


//------------------------------------------------------------------------------
// create
//------------------------------------------------------------------------------
constructor TABSLexer.Create(SQLScript: string; SQLParams: TABSSQLParams);
var
  i: integer;
begin
  FSQL := SQLScript;
  FSQLParams := SQLParams;
  NumCommands := 0;
  Parse;
  CurrentCommandNo := -1;
  for i := 0 to NumCommands-1 do
    Commands[i].CurrentTokenNo := 0;
end; // Create


//------------------------------------------------------------------------------
// destroy
//------------------------------------------------------------------------------
destructor TABSLexer.Destroy;
var i,j: integer;
begin
 for i:=0 to NumCommands - 1 do
  for j:=0 to  Length(Commands[i].Tokens)-1 do
   if (Commands[i].Tokens[j].ParamValue <> nil) then
     Commands[i].Tokens[j].ParamValue.Free;
end; // Destroy


//------------------------------------------------------------------------------
// test
//------------------------------------------------------------------------------
function TABSLexer.Test(bGenerate: Boolean = true; bShowDetails: Boolean = true): string;
var i,j: integer;
    s: string;
begin
 result := 'Number of commands: '+IntToStr(NumCommands);
 if (bGenerate) then
  begin
   // generate
  end;

 for i := 0 to NumCommands - 1 do
  begin
   result := result + Crlf+'Command #'+IntToStr(i+1)+':' + Crlf;
   for j := 0 to Commands[i].NumTokens - 1 do
    begin
     result := result + Commands[i].Tokens[j].Text + Crlf;
     if (bShowDetails) then
      begin
       if (Commands[i].Tokens[j].ReservedWord = rwNone) then
        s := 'ReservedWord = None'+Crlf
       else
        s :=  'ReservedWord = ' +
              ABSSQLReservedWords[Integer(Commands[i].Tokens[j].ReservedWord)] +
              Crlf;
        result := result +
                  'Type = ' +
                  EABSTokenType[Integer(Commands[i].Tokens[j].TokenType)] +
                  Crlf + s +
                  'Line = ' + IntToStr(Commands[i].Tokens[j].LineNum) + Crlf +
                  'Column = ' + IntToStr(Commands[i].Tokens[j].ColumnNum) +
                  Crlf + Crlf;
      end;
    end;

  end;
end; // Test


//------------------------------------------------------------------------------
// Add Empty Command
//------------------------------------------------------------------------------
procedure TABSLexer.AddCommand;
begin
  SetLength(Commands, Length(Commands)+1);
  NumCommands := Length(Commands);
  CurrentCommandNo := NumCommands - 1;
end;// AddCommand


//------------------------------------------------------------------------------
// AddToken
//------------------------------------------------------------------------------
procedure TABSLexer.AddToken(Token: TToken);
begin
 with Commands[CurrentCommandNo] do
   begin
     SetLength(Tokens, Length(Tokens)+1);
     NumTokens := Length(Tokens);
     CurrentTokenNo := NumTokens - 1;
     Tokens[CurrentTokenNo] := Token;
   end;
end;// AddToken


//------------------------------------------------------------------------------
// makes next command current
//------------------------------------------------------------------------------
function TABSLexer.GetNextCommand: Boolean;
begin
 Inc(CurrentCommandNo);
 Result := (CurrentCommandNo < NumCommands);
end;// GetNextCommand

//------------------------------------------------------------------------------
// gets next token in current command
//------------------------------------------------------------------------------
function TABSLexer.GetNextToken(var Token: TToken): Boolean;
begin
 with Commands[CurrentCommandNo] do
  begin
   Result := LookNextToken(Token);
//   if (Result) then
    Inc(CurrentTokenNo);
  end;
end;// GetNextToken


//------------------------------------------------------------------------------
// gets current token in current command
//------------------------------------------------------------------------------
function TABSLexer.GetCurrentToken(var Token: TToken): Boolean;
begin
 with Commands[CurrentCommandNo] do
  begin
   Result := (CurrentTokenNo < NumTokens);
   if (Result) then
    Token := Tokens[CurrentTokenNo]
   else
    Token.TokenType := tktNone;
  end;
end;// GetCurrentToken


//------------------------------------------------------------------------------
// looks at next token in current command
//------------------------------------------------------------------------------
function TABSLexer.LookNextToken(var Token: TToken): Boolean;
begin
 with Commands[CurrentCommandNo] do
  begin
   Result := (CurrentTokenNo+1 < NumTokens);
   if (Result) then
    Token := Tokens[CurrentTokenNo+1]
   else
     begin
       Token.TokenType := tktNone;
       Token.Text := '';
     end;
  end;
end;// LookNextToken


//------------------------------------------------------------------------------
// gets current token No
//------------------------------------------------------------------------------
function TABSLexer.GetCurrentTokenNo: integer;
begin
  Result := Commands[CurrentCommandNo].CurrentTokenNo;
end;// GetCurrentTokenNo


//------------------------------------------------------------------------------
// sets current token No
//------------------------------------------------------------------------------
function TABSLexer.SetCurrentTokenNo(TokenNo: integer; var Token: TToken): Boolean;
begin
 Commands[CurrentCommandNo].CurrentTokenNo := TokenNo;
 Result := GetCurrentToken(Token);
end;// SetCurrentTokenNo

function TABSLexer.SetCurrentTokenNo(TokenNo: integer): Boolean;
begin
 with Commands[CurrentCommandNo] do
  begin
   CurrentTokenNo := TokenNo;
   Result := (CurrentTokenNo < NumTokens);
  end;
end;


// checks whether token is reserved word
function IsReservedWord(Token: TToken; ReservedWord: TReservedWord=rwNone): Boolean;
begin
 Result := False;
 if (Token.TokenType = tktReservedWord) then
  if ((Token.ReservedWord = ReservedWord) or
      (ReservedWord = rwNone)) then
   Result := True;
end;

//------------------------------------------------------------------------------
// gets first next token specified type
//------------------------------------------------------------------------------
function TABSLexer.GetNextSpecifiedToken(var Token: TToken;
  TokenTypes: TTokenTypes): Boolean;
begin
 with Commands[CurrentCommandNo] do
  begin
   repeat
     Result := LookNextToken(Token);
     if (Result) then
      Inc(CurrentTokenNo);
   until (not Result) or (Token.TokenType in TokenTypes);
  end;
end;// GetNextSpecifiedToken

function FindReservedWord(s: string): Integer;
var i: integer;
begin
  result := -1;
  s := UpperCase(s);
  for i := 0 to ABSMaxSQLReservedWords do
    if (s = ABSSQLReservedWords[i]) then
     begin
      result := i;
      break;
     end;
end; // FindReservedWord


end.