u_c_sql_scanner.pas

delphi实现的sql解析器

// 002 u_c_sql_scanner
// 04 feb 2005

// -- (C) Felix John COLIBRI 2004
// -- documentation: http://www.felix-colibri.com

(*$r+*)

unit u_c_sql_scanner;
  interface
    uses Classes, u_types_constants
        , u_c_text_file
        , u_sql_symbol_types
        ;

    type c_sql_scanner= class(c_text_file)
                          m_sql_symbol_type: t_sql_symbol_type;
                          m_blank_string, m_symbol_string: String;

                          m_display_symbol_read: Boolean;

                          constructor create_sql_scanner(p_name, p_file_name: String);
                          function f_initialized: Boolean;
                          function f_read_symbol: Boolean;
                          procedure test_sql_scanner;
                          procedure scan_and_save(p_full_file_name: String);
                          destructor Destroy; Override;
                        end; // c_sql_scanner

  implementation
    uses SysUtils, Dialogs, TypInfo, u_c_display;

    constructor c_sql_scanner.create_sql_scanner(p_name, p_file_name: String);
      begin
        Inherited create_text_file(p_name, p_file_name);
      end; // create_sql_scanner

    function c_sql_scanner.f_initialized: Boolean;
      begin
        if f_load
          then begin
              Result:= true;
              m_buffer_index:= 0;
            end
          else begin
              display('*** could not open '+ m_c_file_name.m_complete_name
                  + ' '+ IntToStr(m_io_result));
              Result:= False;
            end;
      end; // f_initialized

    function c_sql_scanner.f_read_symbol: Boolean;
        // -- true until eof
      const k_blanks= [' ', chr(9)];
            k_returns= [chr(13), chr(10)];
            k_blanks_returns= k_blanks+ k_returns;
            k_digits= ['0'..'9'];
            // k_hex_digits= ['A'..'F'];
            k_identifier= ['a'..'z', 'A'..'Z', '_', '0'..'9'];
            k_other= k_blanks_returns+ k_identifier;

      procedure get_blanks;
        var l_start: Integer;
        begin
          l_start:= m_buffer_index;
          while (m_buffer_index< m_buffer_size) and (m_pt_buffer[m_buffer_index] in k_blanks_returns) do
            inc(m_buffer_index);
          m_blank_string:= f_extract_string_start_end(l_start, m_buffer_index- 1);
        end; // get_blanks

      procedure get_identifier;
        var l_start: Integer;
        begin
          l_start:= m_buffer_index;
          while (m_buffer_index< m_buffer_size) and (m_pt_buffer[m_buffer_index] in k_identifier) do
            inc(m_buffer_index);

          m_symbol_string:= f_extract_string_start_end(l_start, m_buffer_index- 1);

          m_sql_symbol_type:= f_sql_identifier_type(m_symbol_string);
        end; // get_identifier

      procedure get_number;
          // -- can have hex, exponent ?
        var l_start: Integer;
        begin
          m_sql_symbol_type:= e_integer_litteral_symbol;
          l_start:= m_buffer_index;
          // -- skip the possible "-"
          Inc(m_buffer_index);
          while (m_buffer_index< m_buffer_size) and (m_pt_buffer[m_buffer_index] in k_digits) do
            inc(m_buffer_index);

          if (m_buffer_index< m_buffer_size) and (m_pt_buffer[m_buffer_index]= '.')
            then begin
                m_sql_symbol_type:= e_double_litteral_symbol;
                Inc(m_buffer_index);
                while (m_buffer_index< m_buffer_size) and (m_pt_buffer[m_buffer_index] in k_digits) do
                  inc(m_buffer_index);
              end;

          m_symbol_string:= f_extract_string_start_end(l_start, m_buffer_index- 1);
        end; // get_number

      procedure get_string_litteral;

        procedure get_quoted_string;
          begin
            repeat
              repeat
                inc(m_buffer_index);
              until m_pt_buffer[m_buffer_index]= '''';

              // -- get rid of double ''
              inc(m_buffer_index);
            until m_pt_buffer[m_buffer_index]<> '''';
          end; // get_quoted_string

        procedure get_diese_character;
          begin
            // -- skip #
            Inc(m_buffer_index);
            while (m_buffer_index< m_buffer_size) and (m_pt_buffer[m_buffer_index] in k_digits) do
              inc(m_buffer_index);
          end; // get_diese_character

        var l_start: Integer;

        begin // get_string_litteral
          m_sql_symbol_type:= e_string_litteral_symbol;
          l_start:= m_buffer_index;

          repeat
            // display('str >'+ m_pt_buffer[m_buffer_index]+ '<');
            case m_pt_buffer[m_buffer_index] of
              '''' : get_quoted_string;
              '#' : get_diese_character;
            end;
          until not (m_pt_buffer[m_buffer_index] in ['''', '#']);
          // display('aft >'+ m_pt_buffer[m_buffer_index]+ '<');

          // -- ?? check -1
          m_symbol_string:= f_extract_string_start_end(l_start, m_buffer_index- 1);
        end; // get_string_litteral

      procedure get_one_operator(p_symbol_type: t_sql_symbol_type);
        begin
          m_sql_symbol_type:= p_symbol_type;
          m_symbol_string:= m_pt_buffer[m_buffer_index];
          Inc(m_buffer_index);
        end; // get_one_operator

      procedure get_two_operator(p_symbol_type: t_sql_symbol_type);
        begin
          m_sql_symbol_type:= p_symbol_type;
          m_symbol_string:= m_pt_buffer[m_buffer_index]+ m_pt_buffer[m_buffer_index+ 1];
          Inc(m_buffer_index, 2);
        end; // get_one_operator

      var // -- for display
          l_start_index: Integer;

      begin // f_read_symbol
        m_symbol_string:= '';
        m_sql_symbol_type:= e_unknown_symbol;
        l_start_index:= m_buffer_index;

        if f_end_of_text
          then begin
              Result:= False;
              m_sql_symbol_type:= e_end_of_parse_symbol;
            end
          else begin
              get_blanks;

              l_start_index:= m_buffer_index;

              if m_buffer_index< m_buffer_size
                then begin
                    case m_pt_buffer[m_buffer_index] of
                      'a'..'z', 'A'..'Z' : get_identifier;
                      '-', '0'..'9' : get_number;
                      '''' : get_string_litteral;

                      '*' : get_one_operator(e_multiply_symbol);
                      ':' : get_one_operator(e_colon_symbol);
                      '.' : get_one_operator(e_point_symbol);
                      ';' : get_one_operator(e_semi_colon_symbol);
                      ',' : get_one_operator(e_comma_symbol);
                      '=' : get_one_operator(e_equal_symbol);

                      '<' : if (m_buffer_index+ 1< m_buffer_size)
                                and (m_pt_buffer[m_buffer_index+ 1]= '=')
                              then get_two_operator(e_lower_or_equal_symbol)
                              else
                                if (m_buffer_index+ 1< m_buffer_size)
                                    and (m_pt_buffer[m_buffer_index+ 1]= '>')
                                  then get_two_operator(e_different_symbol)
                                  else  get_one_operator(e_lower_symbol);
                      '>' : if (m_buffer_index+ 1< m_buffer_size)
                                and (m_pt_buffer[m_buffer_index+ 1]= '=')
                              then get_two_operator(e_greater_or_equal_symbol)
                              else get_one_operator(e_greater_symbol);

                      '(' : get_one_operator(e_opening_parenthesis_symbol);
                      ')' : get_one_operator(e_closing_parenthesis_symbol);
                      else
                        display_bug_stop('unknown_char_in_sql '+ m_pt_buffer[m_buffer_index]
                            + '< '+ IntToStr(Ord(m_pt_buffer[m_buffer_index])));
                    end; // case
                  end
                else m_sql_symbol_type:= e_end_of_parse_symbol;

              Result:= True;
            end; // not eof

        if m_display_symbol_read
          then begin
              display(Format('%5d ', [l_start_index])+ m_symbol_string+ ' '+ f_sql_symbol_type_name(m_sql_symbol_type));
            end;
      end; // f_read_symbol

    procedure c_sql_scanner.test_sql_scanner;
      begin
        if f_initialized
          then begin
              m_buffer_index:= 0;
              repeat
                f_read_symbol;
              until m_sql_symbol_type= e_end_of_parse_symbol;
            end;
      end; // test_sql_scanner

    procedure c_sql_scanner.scan_and_save(p_full_file_name: String);
      var l_c_result_text: tStringList;
      begin
        if f_initialized
          then begin
              l_c_result_text:= tStringList.Create;
              m_buffer_index:= 0;
              repeat
                f_read_symbol;
                if m_symbol_string<> ''
                  then l_c_result_text.Add(m_symbol_string);
              until m_sql_symbol_type= e_end_of_parse_symbol;

              l_c_result_text.SaveToFile(p_full_file_name);
              l_c_result_text.Free;
            end;
      end; // scan_and_save

    destructor c_sql_scanner.Destroy;
      begin
        Inherited Destroy;
      end; // Destroy

    begin // c_sql_scanner
    end. // c_sql_scanner