psvsql.pas

PIC 单片机 PAS SOURCE CODE SAMPLES

{*******************************************************}
{               RichEdit Syntax HighLight               }
{                     version 3.0                       }
{ Author:                                               }
{ Serhiy Perevoznyk                                     }
{ [e-mail]                          }
{                                                       }
{*******************************************************}

{The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: SynHighlighterSQL.pas, released 2000-04-21.
The Original Code is based on the wmSQLSyn.pas and wmSybaseSyn.pas files from
the mwEdit component suite by Martin Waldenburg and other developers, the
Initial Author of these files is Willo van der Merwe. Initial Author of
SynHighlighterSQL.pas is Michael Hieke.
Portions created by Willo van der Merwe are Copyright 1999 Willo van der Merwe.
Portions created by Michael Hieke are Copyright 2000 Michael Hieke.
All Rights Reserved.
The Original Code can be obtained from http://synedit.sourceforge.net/
}

unit psvSQL;


interface

uses
  SysUtils, 
  Windows, 
  Messages, 
  Classes, 
  Controls, 
  Graphics, 
  psvRichSyntax;

Type
  TtkTokenKind = (
    tkComment,
    tkIdentifier,
    tkKey,
    tkNull,
    tkNumber,
    tkString,
    tkSymbol,
    tkUnknown);

  TRangeState = (rsANil, rsAnsiC, rsUnKnown);

  TProcTableProc = procedure of Object;
  TIdentFuncTableFunc = function: TtkTokenKind of Object;

type
  TpsvSQLRTF = class(TpsvRTFSyntax)
  private
    fRange: TRangeState;
    fLine: PChar;
    fProcTable: array[#0..#255] of TProcTableProc;
    Run: LongInt;
    fStringLen: Integer;
    fLineNumber : Integer;
    fToIdent: PChar;
    fTokenPos: Integer;
    FTokenID: TtkTokenKind;
    fIdentFuncTable: array[0..156] of TIdentFuncTableFunc;
    function KeyHash(ToHash: PChar): Integer;
    function KeyComp(const aKey: String): Boolean;
    function Func15:TtkTokenKind;
    function Func19:TtkTokenKind;
    function Func20:TtkTokenKind;
    function Func21:TtkTokenKind;
    function Func23:TtkTokenKind;
    function Func25:TtkTokenKind;
    function Func27:TtkTokenKind;
    function Func28:TtkTokenKind;
    function Func29:TtkTokenKind;
    function Func30:TtkTokenKind;
    function Func31:TtkTokenKind;
    function Func33:TtkTokenKind;
    function Func35:TtkTokenKind;
    function Func37:TtkTokenKind;
    function Func39:TtkTokenKind;
    function Func40:TtkTokenKind;
    function Func41:TtkTokenKind;
    function Func43:TtkTokenKind;
    function Func44:TtkTokenKind;
    function Func47:TtkTokenKind;
    function Func48:TtkTokenKind;
    function Func49:TtkTokenKind;
    function Func50:TtkTokenKind;
    function Func51:TtkTokenKind;
    function Func52:TtkTokenKind;
    function Func53:TtkTokenKind;
    function Func55:TtkTokenKind;
    function Func56:TtkTokenKind;
    function Func57:TtkTokenKind;
    function Func58:TtkTokenKind;
    function Func59:TtkTokenKind;
    function Func60:TtkTokenKind;
    function Func61:TtkTokenKind;
    function Func62:TtkTokenKind;
    function Func63:TtkTokenKind;
    function Func64:TtkTokenKind;
    function Func66:TtkTokenKind;
    function Func67:TtkTokenKind;
    function Func69:TtkTokenKind;
    function Func70:TtkTokenKind;
    function Func73:TtkTokenKind;
    function Func74:TtkTokenKind;
    function Func76:TtkTokenKind;
    function Func77:TtkTokenKind;
    function Func78:TtkTokenKind;
    function Func79:TtkTokenKind;
    function Func83:TtkTokenKind;
    function Func84:TtkTokenKind;
    function Func85:TtkTokenKind;
    function Func87:TtkTokenKind;
    function Func91:TtkTokenKind;
    function Func94:TtkTokenKind;
    function Func96:TtkTokenKind;
    function Func97:TtkTokenKind;
    function Func98:TtkTokenKind;
    function Func99:TtkTokenKind;
    function Func100:TtkTokenKind;
    function Func102:TtkTokenKind;
    function Func103:TtkTokenKind;
    function Func105:TtkTokenKind;
    function Func106:TtkTokenKind;
    function Func111:TtkTokenKind;
    function Func112:TtkTokenKind;
    function Func114:TtkTokenKind;
    function Func115:TtkTokenKind;
    function Func116:TtkTokenKind;
    function Func117:TtkTokenKind;
    function Func122:TtkTokenKind;
    function Func133:TtkTokenKind;
    function Func134:TtkTokenKind;
    function Func137:TtkTokenKind;
    function Func156:TtkTokenKind;
    procedure AndSymbolProc;
    procedure BackslashProc;
    procedure CRProc;
    procedure ColonProc;
    procedure CommaProc;
    procedure CommentProc;
    procedure EqualProc;
    procedure GreaterProc;
    procedure IdentProc;
    procedure LFProc;
    procedure LowerProc;
    procedure MinusProc;
    procedure NullProc;
    procedure NumberProc;
    procedure OrSymbolProc;
    procedure PlusProc;
    procedure QuestionProc;
    procedure RoundCloseProc;
    procedure RoundOpenProc;
    procedure SemiColonProc;
    procedure SlashProc;
    procedure SpaceProc;
    procedure SquareCloseProc;
    procedure SquareOpenProc;
    procedure StarProc;
    procedure StringInterpProc;
    procedure StringLiteralProc;
    procedure XOrSymbolProc;
    procedure UnknownProc;
    procedure AnsiCProc;
    function AltFunc: TtkTokenKind;
    procedure InitIdent;
    function IdentKind(MayBe: PChar): TtkTokenKind;
    procedure MakeMethodTables;
   protected
    procedure PrepareToken(var AToken : string); override;
    function GetEol: Boolean; override;
    function GetRange: Pointer; 
    function GetTokenID: TtkTokenKind;
    procedure SetLine(NewValue : string; LineNumber : Integer); override;
    function GetToken: String;  override;
    function GetTokenAttribute: integer; override;
    function GetTokenKind: integer; 
    function GetTokenPos: Integer; 
    procedure Next;  override;
    procedure SetRange(Value: Pointer); 
    procedure ReSetRange; 
    function PrepareOutput(Attr: integer; AToken : string): string; override;
   public
    constructor Create; override;
    procedure SetupDefaultColors; override;
  end;


implementation


var
  Identifiers: array[#0..#255] of ByteBool;
  mHashTable: array[#0..#255] of Integer;

procedure MakeIdentTable;
var
  I,J: Char;
begin
  for I := #0 to #255 do
  begin
    Case I of
      '_', '0'..'9', 'a'..'z', 'A'..'Z': Identifiers[I] := True;
    else Identifiers[I] := False;
    end;
    J := UpperCase(I)[1];
    Case I of
      'a'..'z', 'A'..'Z', '_': mHashTable[I] := Ord(J) - 64;
    else mHashTable[Char(I)] := 0;
    end;
  end;
end;

procedure TpsvSQLRTF.InitIdent;
var
  I: Integer;
begin
  for I := 0 to 156 do
    Case I of
      15: fIdentFuncTable[I] := Func15;
      19: fIdentFuncTable[I] := Func19;
      20: fIdentFuncTable[I] := Func20;
      21: fIdentFuncTable[I] := Func21;
      23: fIdentFuncTable[I] := Func23;
      25: fIdentFuncTable[I] := Func25;
      27: fIdentFuncTable[I] := Func27;
      28: fIdentFuncTable[I] := Func28;
      29: fIdentFuncTable[I] := Func29;
      30: fIdentFuncTable[I] := Func30;
      31: fIdentFuncTable[I] := Func31;
      33: fIdentFuncTable[I] := Func33;
      35: fIdentFuncTable[I] := Func35;
      37: fIdentFuncTable[I] := Func37;
      39: fIdentFuncTable[I] := Func39;
      40: fIdentFuncTable[I] := Func40;
      41: fIdentFuncTable[I] := Func41;
      43: fIdentFuncTable[I] := Func43;
      44: fIdentFuncTable[I] := Func44;
      47: fIdentFuncTable[I] := Func47;
      48: fIdentFuncTable[I] := Func48;
      49: fIdentFuncTable[I] := Func49;
      50: fIdentFuncTable[I] := Func50;
      51: fIdentFuncTable[I] := Func51;
      52: fIdentFuncTable[I] := Func52;
      53: fIdentFuncTable[I] := Func53;
      55: fIdentFuncTable[I] := Func55;
      56: fIdentFuncTable[I] := Func56;
      57: fIdentFuncTable[I] := Func57;
      58: fIdentFuncTable[I] := Func58;
      59: fIdentFuncTable[I] := Func59;
      60: fIdentFuncTable[I] := Func60;
      61: fIdentFuncTable[I] := Func61;
      62: fIdentFuncTable[I] := Func62;
      63: fIdentFuncTable[I] := Func63;
      64: fIdentFuncTable[I] := Func64;
      66: fIdentFuncTable[I] := Func66;
      67: fIdentFuncTable[I] := Func67;
      69: fIdentFuncTable[I] := Func69;
      70: fIdentFuncTable[I] := Func70;
      73: fIdentFuncTable[I] := Func73;
      74: fIdentFuncTable[I] := Func74;
      76: fIdentFuncTable[I] := Func76;
      77: fIdentFuncTable[I] := Func77;
      78: fIdentFuncTable[I] := Func78;
      79: fIdentFuncTable[I] := Func79;
      83: fIdentFuncTable[I] := Func83;
      84: fIdentFuncTable[I] := Func84;
      85: fIdentFuncTable[I] := Func85;
      87: fIdentFuncTable[I] := Func87;
      91: fIdentFuncTable[I] := Func91;
      94: fIdentFuncTable[I] := Func94;
      96: fIdentFuncTable[I] := Func96;
      97: fIdentFuncTable[I] := Func97;
      98: fIdentFuncTable[I] := Func98;
      99: fIdentFuncTable[I] := Func99;
      100: fIdentFuncTable[I] := Func100;
      102: fIdentFuncTable[I] := Func102;
      103: fIdentFuncTable[I] := Func103;
      105: fIdentFuncTable[I] := Func105;
      106: fIdentFuncTable[I] := Func106;
      111: fIdentFuncTable[I] := Func111;
      112: fIdentFuncTable[I] := Func112;
      114: fIdentFuncTable[I] := Func114;
      115: fIdentFuncTable[I] := Func115;
      116: fIdentFuncTable[I] := Func116;
      117: fIdentFuncTable[I] := Func117;
      122: fIdentFuncTable[I] := Func122;
      133: fIdentFuncTable[I] := Func133;
      134: fIdentFuncTable[I] := Func134;
      137: fIdentFuncTable[I] := Func137;
      156: fIdentFuncTable[I] := Func156;
    else fIdentFuncTable[I] := AltFunc;
    end;
end;

function TpsvSQLRTF.KeyHash(ToHash: PChar): Integer;
begin
  Result := 0;
  while ToHash^ in ['_', '0'..'9', 'a'..'z', 'A'..'Z'] do
  begin
    inc(Result, mHashTable[ToHash^]);
    inc(ToHash);
  end;
  fStringLen := ToHash - fToIdent;
end; { KeyHash }

function TpsvSQLRTF.KeyComp(const aKey: String): Boolean;
var
  I: Integer;
  Temp: PChar;
begin
  Temp := fToIdent;
  if Length(aKey) = fStringLen then
  begin
    Result := True;
    for i := 1 to fStringLen do
    begin
      if mHashTable[Temp^] <> mHashTable[aKey[i]] then
      begin
        Result := False;
        break;
      end;
      inc(Temp);
    end;
  end else Result := False;
end; { KeyComp }

function TpsvSQLRTF.Func15: TtkTokenKind;
begin
  if KeyComp('IF') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func19: TtkTokenKind;
begin
  if KeyComp('AND') then Result := tkKey else
    if KeyComp('DO') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func20: TtkTokenKind;
begin
  if KeyComp('AS') then Result := tkKey else
    if KeyComp('CACHE') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func21: TtkTokenKind;
begin
  if KeyComp('AT') then Result := tkKey else
    if KeyComp('OF') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func23: TtkTokenKind;
begin
  if KeyComp('END') then Result := tkKey else
    if KeyComp('IN') then Result := tkKey else
      if KeyComp('ASC') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func25: TtkTokenKind;
begin
  if KeyComp('ALL') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func27: TtkTokenKind;
begin
  if KeyComp('BY') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func28: TtkTokenKind;
begin
  if KeyComp('READ') then Result := tkKey else
    if KeyComp('IS') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func29: TtkTokenKind;
begin
  if KeyComp('NO') then Result := tkKey else
    if KeyComp('ON') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func30: TtkTokenKind;
begin
  if KeyComp('CHECK') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func31: TtkTokenKind;
begin
  if KeyComp('DESC') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func33: TtkTokenKind;
begin
  if KeyComp('OR') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvSQLRTF.Func35: TtkTokenKind;
begin
  if KeyComp('TO') then Result := tkKey else Result := tkIdentifier;