Chip 2003 January/ChipCD_1.03.iso/zkuste/delphi/kompon/d56/VKDBF.ZIP/VKDBFParser.pas

Pascal/Delphi Source File | 2002-09-27 | 54.9 KB | 1,622 lines

{
 Copyright:      Vlad Karpov  mailto:[e-mail]
 Author:         Vlad Karpov
}
unit VKDBFParser;

interface

uses  dbcommon, Windows, classes, db,
      {$IFDEF VER140} Variants, {$ENDIF}
      VKDBFUtil;

type

  PDBFExprNode = ^TDBFExprNode;
  TDBFExprNode = record
    FNext: PDBFExprNode;
    FKind: TExprNodeKind;
    FPartial: Boolean;
    FOperator: TCANOperator;
    FData: Variant;
    FLeft: PDBFExprNode;
    FRight: PDBFExprNode;
    FDataType: TFieldType;
    FDataSize: Integer;
    FDataLen: Integer;
    FDataPrec: Integer;
    FArgs: TList;
    FScopeKind: TExprScopeKind;
    FField: TField;
  end;

  {TVKDBFFilterExpr}
  TVKDBFFilterExpr = class
  private
    FDataSet: TDataSet;
    FFieldMap: TFieldMap;
    FOptions: TFilterOptions;
    FParserOptions: TParserOptions;
    FNodes: PDBFExprNode;
    FFieldName: string;
    FDependentFields: TBits;
    function GetFieldByName(Name: string) : TField;
  public
    constructor Create(DataSet: TDataSet; Options: TFilterOptions;
      ParseOptions: TParserOptions; const FieldName: string; DepFields: TBits;
      FieldMap: TFieldMap);
    destructor Destroy; override;
    function NewCompareNode(Field: TField; Operator: TCANOperator;
      const Value: Variant): PDBFExprNode;
    function NewNode(Kind: TExprNodeKind; Operator: TCANOperator;
      const Data: Variant; Left, Right: PDBFExprNode): PDBFExprNode;
    property DataSet: TDataSet write FDataSet;
  end;

  {TVKDBFExprParser}
  TVKDBFExprParser = class(TVKDBFFilterExpr)
    FFilter: TVKDBFFilterExpr;
    FFieldMap: TFieldMap;
    FText: string;
    FSourcePtr: PChar;
    FTokenPtr: PChar;
    FTokenString: string;
    FStrTrue: string;
    FStrFalse: string;
    FToken: TExprToken;
    FPrevToken: TExprToken;
    FNumericLit: Boolean;
    FParserOptions: TParserOptions;
    FFieldName: string;
    FDataSet: TDataSet;
    FDependentFields: TBits;
    FIndexKeyValue: boolean;
    FFields: TList;
    FKeyValues: Variant;
    FKeyFromValues: boolean;
    FFC: Char;
    procedure NextToken;
    function NextTokenIsLParen : Boolean;
    function ParseExpr: PDBFExprNode;
    function ParseExpr2: PDBFExprNode;
    function ParseExpr3: PDBFExprNode;
    function ParseExpr4: PDBFExprNode;
    function ParseExpr5: PDBFExprNode;
    function ParseExpr6: PDBFExprNode;
    function ParseExpr7: PDBFExprNode;
    function TokenName: string;
    function TokenSymbolIs(const S: string): Boolean;
    function TokenSymbolIsFunc(const S: string) : Boolean;
    procedure GetFuncResultInfo(Node: PDBFExprNode);
    procedure TypeCheckArithOp(Node: PDBFExprNode);
    procedure GetScopeKind(Root, Left, Right : PDBFExprNode);
    function Execute(Root: PDBFExprNode): Variant; overload;
  private
    FLastRoot: PDBFExprNode;
    FValue: Variant;
    FKey: String;
    function GetDataLen: Integer;
    function GetDataPrec: Integer;
  public
    constructor Create(DataSet: TDataSet; const Text: string;
      Options: TFilterOptions; ParserOptions: TParserOptions;
      const FieldName: string; DepFields: TBits; FieldMap: TFieldMap);
    destructor Destroy; override;
    procedure SetExprParams(const Text: string; Options: TFilterOptions;
      ParserOptions: TParserOptions; const FieldName: string);
    procedure SetExprParams1(const Text: string; Options: TFilterOptions;
      ParserOptions: TParserOptions; const FieldName: string);
    function Execute: Variant; overload;
    function EvaluteKey: String; overload;
    function EvaluteKey(const KeyFields: string; const KeyValues: Variant; const CF: Char = #$20): String; overload;
    function SuiteFieldList(fl: String; out m: Integer): Integer;
    function GetFieldList: String;
    property IndexKeyValue: boolean read FIndexKeyValue write FIndexKeyValue;
    property Value: Variant read FValue;
    property Key: String read FKey;
    property Len: Integer read GetDataLen; //FLastRoot.FDataLen;
    property Prec: Integer read GetDataPrec; //FLastRoot.FDataPrec;
  end;

  function LikeOperator(const Var1, Var2: Variant; const CaseInsensitive: Boolean; const ManyChars, OneChar: Char): boolean;

implementation

uses SysUtils, DBConsts, VKDBFDataSet, ActiveX;

const
  StringFieldTypes = [ftString, ftFixedChar, ftWideString, ftGuid];
  BlobFieldTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
    ftTypedBinary, ftOraBlob, ftOraClob];

function IsNumeric(DataType: TFieldType): Boolean;
begin
  Result := DataType in [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
    ftBCD, ftAutoInc, ftLargeint];
end;

function IsTemporal(DataType: TFieldType): Boolean;
begin
  Result := DataType in [ftDate, ftTime, ftDateTime];
end;

function LikeOperator(const Var1, Var2: Variant; const CaseInsensitive: Boolean; const ManyChars, OneChar: Char): boolean;
var
  sStr, sPatt: String;
begin
  if VarIsNull(Var1) or VarIsNull(Var2) then
    Result := False
  else begin
    sStr := Var1;
    sPatt := Var2;
    if CaseInsensitive then
    begin
      sStr := AnsiUpperCase(sStr);
      sPatt := AnsiUpperCase(sPatt);
    end;
    Result := wildc(pChar(sPatt), pChar(sStr), Length(sStr), ManyChars, OneChar);
  end;
end;

{TVKDBFFilterExpr}
constructor TVKDBFFilterExpr.Create(DataSet: TDataSet; Options: TFilterOptions;
  ParseOptions: TParserOptions; const FieldName: string; DepFields: TBits;
  FieldMap: TFieldMap);
begin
  FFieldMap := FieldMap;
  FDataSet := DataSet;
  FOptions := Options;
  FFieldName := FieldName;
  FParserOptions := ParseOptions;
  FDependentFields := DepFields;
end;

destructor TVKDBFFilterExpr.Destroy;
var
  Node: PDBFExprNode;
begin
  while FNodes <> nil do
  begin
    Node := FNodes;
    FNodes := Node^.FNext;
    if (Node^.FKind = enFunc) and (Node^.FArgs <> nil) then
      Node^.FArgs.Free;
    Dispose(Node);
  end;
end;

function TVKDBFFilterExpr.NewCompareNode(Field: TField; Operator: TCANOperator;
  const Value: Variant): PDBFExprNode;
var
  ConstExpr: PDBFExprNode;
begin
  ConstExpr := NewNode(enConst, coNOTDEFINED, Value, nil, nil);
  ConstExpr^.FDataType := Field.DataType;
  ConstExpr^.FDataSize := Field.Size;
  Result := NewNode(enOperator, Operator, Unassigned,
    NewNode(enField, coNOTDEFINED, Field.FieldName, nil, nil), ConstExpr);
end;

function TVKDBFFilterExpr.NewNode(Kind: TExprNodeKind; Operator: TCANOperator;
  const Data: Variant; Left, Right: PDBFExprNode): PDBFExprNode;
var
  Field : TField;
begin
  New(Result);
  with Result^ do
  begin
    FNext := FNodes;
    FKind := Kind;
    FPartial := False;
    FOperator := Operator;
    FData := Data;
    FLeft := Left;
    FRight := Right;
    FDataLen := 0;
    FDataPrec := 0;
    FDataType := ftUnknown;
    FArgs := nil;
  end;
  FNodes := Result;
  if Kind = enField then
  begin
    Field := GetFieldByName(Data);
    if Field = nil then
      DatabaseErrorFmt(SFieldNotFound, [Data]);
    Result^.FDataType := Field.DataType;
    Result^.FDataSize := Field.Size;
    Result^.FField := Field;
  end;
end;

function TVKDBFFilterExpr.GetFieldByName(Name: string) : TField;
//var
//  I: Integer;
//  F: TField;
//  FieldInfo: TFieldInfo;
begin
//  Result := nil;
//  if poFieldNameGiven in FParserOptions then
//    Result := FDataSet.FieldByName(UpperCase(FFieldName))
//  else if poUseOrigNames in FParserOptions then begin
//    for I := 0 to FDataset.FieldCount - 1 do
//    begin
//      F := FDataSet.Fields[I];
//      if GetFieldInfo(F.Origin, FieldInfo) and
//         (AnsiCompareStr(Name, FieldInfo.OriginalFieldName) = 0) then
//      begin
//        Result := F;
//        Exit;
//      end;
//    end;
//  end;
//  if Result = nil then
    Result := FDataSet.FieldByName(UpperCase(Name));
//  if (Result <> nil) and (Result.FieldKind = fkCalculated) and (poAggregate in FParserOptions) then
//    DatabaseErrorFmt(SExprNoAggOnCalcs, [Result.FieldName]);
//  if (poFieldDepend in FParserOptions) and (Result <> nil) and
//     (FDependentFields <> nil) then
//    FDependentFields[Result.FieldNo-1] := True;
end;

{TVKDBFExprParser}
constructor TVKDBFExprParser.Create(DataSet: TDataSet; const Text: string;
  Options: TFilterOptions; ParserOptions: TParserOptions; const FieldName: string;
  DepFields: TBits; FieldMap: TFieldMap);
begin
  FFieldMap := FieldMap;
  FStrTrue := STextTrue;
  FStrFalse := STextFalse;
  FDataSet := DataSet;
  FDependentFields := DepFields;
  FIndexKeyValue := false;
  FFilter := TVKDBFFilterExpr.Create(DataSet, Options, ParserOptions, FieldName,
    DepFields, FieldMap);
  if Text <> '' then
    SetExprParams(Text, Options, ParserOptions, FieldName);
  FFields := nil;
  FKeyFromValues := false;
  FFC := #$20; //' '
end;

destructor TVKDBFExprParser.Destroy;
begin
  FFilter.Free;
end;

procedure  TVKDBFExprParser.SetExprParams(const Text: string; Options: TFilterOptions;
  ParserOptions: TParserOptions; const FieldName: string);
var
  Root, DefField: PDBFExprNode;
begin
  FParserOptions := ParserOptions;
  if FFilter <> nil then
    FFilter.Free;
  FFilter := TVKDBFFilterExpr.Create(FDataSet, Options, ParserOptions, FieldName,
    FDependentFields, FFieldMap);
  FText := Text;
  FSourcePtr := PChar(Text);
  FFieldName := FieldName;
  NextToken;
  Root := nil;
  if FToken <> etEnd then Root := ParseExpr;
  FValue := NULL;
  if Root <> nil then begin
    if FToken <> etEnd then DatabaseError(SExprTermination);

    if (poAggregate in FParserOptions) and (Root^.FScopeKind <> skAgg) then
       DatabaseError(SExprNotAgg);
    if (not (poAggregate in FParserOptions)) and (Root^.FScopeKind = skAgg) then
       DatabaseError(SExprNoAggFilter);
    if poDefaultExpr in ParserOptions then
    begin
      DefField := FFilter.NewNode(enField, coNOTDEFINED, FFieldName, nil, nil);
      if (IsTemporal(DefField^.FDataType) and (Root^.FDataType in StringFieldTypes)) or
         ((DefField^.FDataType = ftBoolean ) and (Root^.FDataType in StringFieldTypes)) then
        Root^.FDataType := DefField^.FDataType;

      if not ((IsTemporal(DefField^.FDataType) and IsTemporal(Root^.FDataType))
         or (IsNumeric(DefField^.FDataType) and IsNumeric(Root^.FDataType))
         or ((DefField^.FDataType in StringFieldTypes) and (Root^.FDataType in StringFieldTypes))
         or ((DefField^.FDataType = ftBoolean) and (Root^.FDataType = ftBoolean))) then
        DatabaseError(SExprTypeMis);
      Root := FFilter.NewNode(enOperator, coASSIGN, Unassigned, Root, DefField);
    end;

    if not (poAggregate in FParserOptions) and not(poDefaultExpr in ParserOptions)
       and (Root^.FDataType <> ftBoolean ) then
       DatabaseError(SExprIncorrect);


    FValue := Execute(Root);

  end;

  FLastRoot := Root;

end;

procedure TVKDBFExprParser.SetExprParams1(const Text: string;
  Options: TFilterOptions; ParserOptions: TParserOptions;
  const FieldName: string);
var
  Root: PDBFExprNode;
begin
  FParserOptions := ParserOptions;
  if FFilter <> nil then
    FFilter.Free;
  FFilter := TVKDBFFilterExpr.Create(FDataSet, Options, ParserOptions, FieldName,
    FDependentFields, FFieldMap);
  FText := Text;
  FSourcePtr := PChar(Text);
  FFieldName := FieldName;
  NextToken;
  Root := nil;
  if FToken <> etEnd then Root := ParseExpr;
  if Root <> nil then
    if FToken <> etEnd then DatabaseError(SExprTermination);

  FLastRoot := Root;

end;

function TVKDBFExprParser.NextTokenIsLParen : Boolean;
var
  P : PChar;
begin
  P := FSourcePtr;
  while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  Result := P^ = '(';
end;

procedure TVKDBFExprParser.NextToken;
type
  ASet = Set of Char;
var
  P, TokenStart: PChar;
  L: Integer;
  StrBuf: array[0..255] of Char;

  function IsKatakana(const Chr: Byte): Boolean;
  begin
    Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
  end;

  procedure Skip(TheSet: ASet);
  begin
    while TRUE do
    begin
      if P^ in LeadBytes then
        Inc(P, 2)
      else if (P^ in TheSet) or IsKatakana(Byte(P^)) then
        Inc(P)
      else
        Exit;
    end;
  end;

  procedure Litr(ltr: Char);
  begin
    Inc(P);
    L := 0;
    while True do
    begin
      if P^ = #0 then DatabaseError(SExprStringError);
      if P^ = ltr then
      begin
        Inc(P);
        if P^ <> ltr then Break;
      end;
      if L < SizeOf(StrBuf) then
      begin
        StrBuf[L] := P^;
        Inc(L);
      end;
      Inc(P);
    end;
    SetString(FTokenString, StrBuf, L);
    FToken := etLiteral;
    FNumericLit := False;
  end;

begin
  FPrevToken := FToken;
  FTokenString := '';
  P := FSourcePtr;
  while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  if (P^ <> #0) and (P^ = '/') and (P[1] <> #0) and (P[1] = '*')then
  begin
    P := P + 2;
    while (P^ <> #0) and (P^ <> '*') do Inc(P);
    if (P^ = '*') and (P[1] <> #0) and (P[1] =  '/')  then
      P := P + 2
    else
      DatabaseErrorFmt(SExprInvalidChar, [P^]);
  end;
  while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  FTokenPtr := P;
  case P^ of
    'A'..'Z', 'a'..'z', '_', #$81..#$fe:
      begin
        TokenStart := P;
        if not SysLocale.FarEast then
        begin
          Inc(P);
          while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '[', ']'] do Inc(P);
        end
        else
          Skip(['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '[', ']']);
        SetString(FTokenString, TokenStart, P - TokenStart);
        FToken := etSymbol;
        if CompareText(FTokenString, 'LIKE') = 0 then   { do not localize }
          FToken := etLIKE
        else if CompareText(FTokenString, 'IN') = 0 then   { do not localize }
          FToken := etIN
        else if CompareText(FTokenString, 'IS') = 0 then    { do not localize }
        begin
          while (P^ <> #0) and (P^ <= ' ') do Inc(P);
          TokenStart := P;
          Skip(['A'..'Z', 'a'..'z']);
          SetString(FTokenString, TokenStart, P - TokenStart);
          if CompareText(FTokenString, 'NOT')= 0 then  { do not localize }
          begin
            while (P^ <> #0) and (P^ <= ' ') do Inc(P);
            TokenStart := P;
            Skip(['A'..'Z', 'a'..'z']);
            SetString(FTokenString, TokenStart, P - TokenStart);
            if CompareText(FTokenString, 'NULL') = 0 then
              FToken := etISNOTNULL
            else
              DatabaseError(SInvalidKeywordUse);
          end
          else if CompareText (FTokenString, 'NULL') = 0  then  { do not localize }
          begin
            FToken := etISNULL;
          end
          else
            DatabaseError(SInvalidKeywordUse);
        end;
      end;
    '[':
      begin
        Inc(P);
        TokenStart := P;
        P := AnsiStrScan(P, ']');
        if P = nil then DatabaseError(SExprNameError);
        SetString(FTokenString, TokenStart, P - TokenStart);
        FToken := etName;
        Inc(P);
      end;
    '''': Litr('''');
    '"': Litr('"');
    '-', '0'..'9':
      begin
        if (FPrevToken <> etLiteral) and (FPrevToken <> etName) and
           (FPrevToken <> etSymbol)and (FPrevToken <> etRParen) then
          begin
            TokenStart := P;
            Inc(P);
            while (P^ in ['0'..'9', '.', 'e', 'E', '+', '-']) do
              Inc(P);
            //if ((P-1)^ = ',') and (DecimalSeparator = ',') and (P^ = ' ') then
            //  Dec(P);
            SetString(FTokenString, TokenStart, P - TokenStart);
            FToken := etLiteral;
            FNumericLit := True;
          end
        else
         begin
           FToken := etSUB;
           Inc(P);
         end;
      end;
    '(':
      begin
        Inc(P);
        FToken := etLParen;
      end;
    ')':
      begin
        Inc(P);
        FToken := etRParen;
      end;
    '<':
      begin
        Inc(P);
        case P^ of
          '=':
            begin
              Inc(P);
              FToken := etLE;
            end;
          '>':
            begin
              Inc(P);
              FToken := etNE;
            end;
        else
          FToken := etLT;
        end;
      end;
    '=':
      begin
        Inc(P);
        FToken := etEQ;
      end;
    '>':
      begin
        Inc(P);
        if P^ = '=' then
        begin
          Inc(P);
          FToken := etGE;
        end else
          FToken := etGT;
      end;
    '+':
      begin
        Inc(P);
        FToken := etADD;
      end;
    '*':
      begin
        Inc(P);
        FToken := etMUL;
      end;
    '/':
      begin
        Inc(P);
        FToken := etDIV;
      end;
    ',':
      begin
        Inc(P);
        FToken := etComma;
      end;
    #0:
      FToken := etEnd;
    '.':
      begin
        TokenStart := P;
        Skip(['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '[', ']']);
        SetString(FTokenString, TokenStart, P - TokenStart);
        if CompareText(FTokenString, '.T.') = 0 then FTokenString := 'TRUE';
        if CompareText(FTokenString, '.F.') = 0 then FTokenString := 'FALSE';
        if CompareText(FTokenString, '.AND.') = 0 then FTokenString := 'AND';
        if CompareText(FTokenString, '.OR.') = 0 then FTokenString := 'OR';
        if CompareText(FTokenString, '.XOR.') = 0 then FTokenString := 'XOR';
        if CompareText(FTokenString, '.NOT.') = 0 then FTokenString := 'NOT';
        FToken := etSymbol;
      end;
    '!':
      begin
        Inc(P);
        FTokenString := 'NOT';
        FToken := etSymbol;
      end;
  else
    DatabaseErrorFmt(SExprInvalidChar, [P^]);
  end;
  FSourcePtr := P;
end;

function TVKDBFExprParser.ParseExpr: PDBFExprNode;
begin
  Result := ParseExpr2;
  while TokenSymbolIs('OR') do
  begin
    NextToken;
    Result := FFilter.NewNode(enOperator, coOR, Unassigned,
      Result, ParseExpr2);
    GetScopeKind(Result, Result^.FLeft, Result^.FRight);
    Result^.FDataType := ftBoolean;
  end;
end;

function TVKDBFExprParser.ParseExpr2: PDBFExprNode;
begin
  Result := ParseExpr3;
  while TokenSymbolIs('AND') do
  begin
    NextToken;
    Result := FFilter.NewNode(enOperator, coAND, Unassigned,
      Result, ParseExpr3);
    GetScopeKind(Result, Result^.FLeft, Result^.FRight);
    Result^.FDataType := ftBoolean;
  end;
end;

function TVKDBFExprParser.ParseExpr3: PDBFExprNode;
begin
  if TokenSymbolIs('NOT') then
  begin
    NextToken;
    Result := FFilter.NewNode(enOperator, coNOT, Unassigned,
      ParseExpr4, nil);
    Result^.FDataType := ftBoolean;
  end else
    Result := ParseExpr4;
  GetScopeKind(Result, Result^.FLeft, Result^.FRight);
end;


function TVKDBFExprParser.ParseExpr4: PDBFExprNode;
const
  Operators: array[etEQ..etLT] of TCANOperator = (
    coEQ, coNE, coGE, coLE, coGT, coLT);
var
  Operator: TCANOperator;
  Left, Right: PDBFExprNode;
begin
  Result := ParseExpr5;
  if (FToken in [etEQ..etLT]) or (FToken = etLIKE)
     or (FToken = etISNULL) or (FToken = etISNOTNULL)
     or (FToken = etIN) then
  begin
    case FToken of
      etEQ..etLT:
        Operator := Operators[FToken];
      etLIKE:
        Operator := coLIKE;
      etISNULL:
        Operator := coISBLANK;
      etISNOTNULL:
        Operator := coNOTBLANK;
      etIN:
        Operator := coIN;
      else
        Operator := coNOTDEFINED;
    end;
    NextToken;
    Left := Result;
    if Operator = coIN then
    begin
      if FToken <> etLParen then
        DatabaseErrorFmt(SExprNoLParen, [TokenName]);
      NextToken;
      Result := FFilter.NewNode(enOperator, coIN, Unassigned,
                 Left, nil);
      Result.FDataType := ftBoolean;
      if FToken <> etRParen then
      begin
        Result.FArgs := TList.Create;
        repeat
          Right := ParseExpr;
          if IsTemporal(Left.FDataType) then
            Right.FDataType := Left.FDataType;
          Result.FArgs.Add(Right);
          if (FToken <> etComma) and (FToken <> etRParen) then
            DatabaseErrorFmt(SExprNoRParenOrComma, [TokenName]);
          if FToken = etComma then NextToken;
        until (FToken = etRParen) or (FToken = etEnd);
        if FToken <> etRParen then
          DatabaseErrorFmt(SExprNoRParen, [TokenName]);
        NextToken;
      end else
        DatabaseError(SExprEmptyInList);
    end else
    begin
      if (Operator <> coISBLANK) and (Operator <> coNOTBLANK) then
        Right := ParseExpr5
      else
        Right := nil;
      Result := FFilter.NewNode(enOperator, Operator, Unassigned,
        Left, Right);
      if Right <> nil then
      begin
        if (Left^.FKind = enField) and (Right^.FKind = enConst) then
          begin
            Right^.FDataType := Left^.FDataType;
            Right^.FDataSize := Left^.FDataSize;
          end
        else if (Right^.FKind = enField) and (Left^.FKind = enConst) then
          begin
            Left^.FDataType := Right^.FDataType;
            Left^.FDataSize := Right^.FDataSize;
          end;
      end;
      if (Left^.FDataType in BlobFieldTypes) and (Operator = coLIKE) then
      begin
        if Right^.FKind = enConst then Right^.FDataType := ftString;
      end
      else if (Operator <> coISBLANK) and (Operator <> coNOTBLANK)
         and ((Left^.FDataType in (BlobFieldTypes + [ftBytes])) or
         ((Right <> nil) and (Right^.FDataType in (BlobFieldTypes + [ftBytes])))) then
        DatabaseError(SExprTypeMis);
      Result.FDataType := ftBoolean;
      if Right <> nil then
      begin
        if IsTemporal(Left.FDataType) and (Right.FDataType in StringFieldTypes) then
          Right.FDataType := Left.FDataType
        else if IsTemporal(Right.FDataType) and (Left.FDataType in StringFieldTypes) then
          Left.FDataType := Right.FDataType;
      end;
      GetScopeKind(Result, Left, Right);
    end;
  end;
end;

function TVKDBFExprParser.ParseExpr5: PDBFExprNode;
const
  Operators: array[etADD..etDIV] of TCANOperator = (
    coADD, coSUB, coMUL, coDIV);
var
  Operator: TCANOperator;
  Left, Right: PDBFExprNode;
begin
  Result := ParseExpr6;
  while FToken in [etADD, etSUB] do
  begin
    if not (poExtSyntax in FParserOptions) then
      DatabaseError(SExprNoArith);
    Operator := Operators[FToken];
    Left := Result;
    NextToken;
    Right := ParseExpr6;
    Result := FFilter.NewNode(enOperator, Operator, Unassigned, Left, Right);
    TypeCheckArithOp(Result);
    GetScopeKind(Result, Left, Right);
  end;
end;

function TVKDBFExprParser.ParseExpr6: PDBFExprNode;
const
  Operators: array[etADD..etDIV] of TCANOperator = (
    coADD, coSUB, coMUL, coDIV);
var
  Operator: TCANOperator;
  Left, Right: PDBFExprNode;
begin
  Result := ParseExpr7;
  while FToken in [etMUL, etDIV] do
  begin
    if not (poExtSyntax in FParserOptions) then
      DatabaseError(SExprNoArith);
    Operator := Operators[FToken];
    Left := Result;
    NextToken;
    Right := ParseExpr7;
    Result := FFilter.NewNode(enOperator, Operator, Unassigned, Left, Right);
    TypeCheckArithOp(Result);
    GetScopeKind(Result, Left, Right);
  end;
end;


function TVKDBFExprParser.ParseExpr7: PDBFExprNode;
var
  FuncName: string;
begin
  case FToken of
    etSymbol:
      if (poExtSyntax in FParserOptions)
         and  NextTokenIsLParen and TokenSymbolIsFunc(FTokenString) then
        begin
          Funcname := FTokenString;
          NextToken;
          if FToken <> etLParen then
            DatabaseErrorFmt(SExprNoLParen, [TokenName]);
          NextToken;
          if (CompareText(FuncName,'count') = 0) and (FToken = etMUL) then
          begin
            FuncName := 'COUNT(*)';
            NextToken;
          end;
          Result := FFilter.NewNode(enFunc, coNOTDEFINED, FuncName,
                    nil, nil);
          if FToken <> etRParen then
          begin
            Result.FArgs := TList.Create;
            repeat
              Result.FArgs.Add(ParseExpr);
              if (FToken <> etComma) and (FToken <> etRParen) then
                DatabaseErrorFmt(SExprNoRParenOrComma, [TokenName]);
              if FToken = etComma then NextToken;
            until (FToken = etRParen) or (FToken = etEnd);
          end else
            Result.FArgs := nil;

          GetFuncResultInfo(Result);
        end
      else if TokenSymbolIs('NULL') then
        begin
          Result := FFilter.NewNode(enConst, coNOTDEFINED, Null, nil, nil);
          Result.FScopeKind := skConst;
        end
      else if TokenSymbolIs(FStrTrue) then
        begin
          Result := FFilter.NewNode(enConst, coNOTDEFINED, True, nil, nil);
          Result.FScopeKind := skConst;
        end
      else if TokenSymbolIs(FStrFalse) then
        begin
          Result := FFilter.NewNode(enConst, coNOTDEFINED, False, nil, nil);
          Result.FScopeKind := skConst;
        end
      else
        begin
          Result := FFilter.NewNode(enField, coNOTDEFINED, FTokenString, nil, nil);
          Result.FScopeKind := skField;
        end;
    etName:
      begin
        Result := FFilter.NewNode(enField, coNOTDEFINED, FTokenString, nil, nil);
        Result.FScopeKind := skField;
      end;
    etLiteral:
      begin
        if FNumericLit then begin
          if DecimalSeparator <> '.' then
            FTokenString := StringReplace(FTokenString, '.', DecimalSeparator, []);
          Result := FFilter.NewNode(enConst, coNOTDEFINED, FTokenString, nil, nil);
          Result^.FDataType := ftFloat;
        end else begin
          Result := FFilter.NewNode(enConst, coNOTDEFINED, FTokenString, nil, nil);
          Result^.FDataType := ftString;
        end;
        Result.FScopeKind := skConst;
      end;
    etLParen:
      begin
        NextToken;
        Result := ParseExpr;
        if FToken <> etRParen then DatabaseErrorFmt(SExprNoRParen, [TokenName]);
      end;
  else
    DatabaseErrorFmt(SExprExpected, [TokenName]);
    Result := nil;
  end;
  NextToken;
end;

procedure  TVKDBFExprParser.GetScopeKind(Root, Left, Right : PDBFExprNode);
begin
  if (Left = nil) and (Right = nil) then Exit;
  if Right = nil then
  begin
    Root.FScopeKind := Left.FScopeKind;
    Exit;
  end;
  if ((Left^.FScopeKind = skField) and (Right^.FScopeKind = skAgg))
     or ((Left^.FScopeKind = skAgg) and (Right^.FScopeKind = skField)) then
    DatabaseError(SExprBadScope);
  if (Left^.FScopeKind = skConst) and (Right^.FScopeKind = skConst) then
    Root^.FScopeKind := skConst
  else if (Left^.FScopeKind = skAgg) or (Right^.FScopeKind = skAgg) then
    Root^.FScopeKind := skAgg
  else if (Left^.FScopeKind = skField) or (Right^.FScopeKind = skField) then
    Root^.FScopeKind := skField;
end;

procedure TVKDBFExprParser.GetFuncResultInfo(Node : PDBFExprNode);
begin
  Node^.FDataType := ftString;
  if (CompareText(Node^.FData, 'COUNT(*)') <> 0 )
     and (CompareText(Node^.FData,'GETDATE') <> 0 )
     and ( (Node^.FArgs = nil ) or ( Node^.FArgs.Count = 0) ) then
      DatabaseError(SExprTypeMis);

  if (Node^.FArgs <> nil) and (Node^.FArgs.Count > 0) then
     Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  if (CompareText(Node^.FData , 'SUM') = 0) or
     (CompareText(Node^.FData , 'AVG') = 0) then
  begin
    Node^.FDataType := ftFloat;
    Node^.FScopeKind := skAgg;
  end
  else if (CompareText(Node^.FData , 'MIN') = 0) or
          (CompareText(Node^.FData , 'MAX') = 0) then
  begin
    Node^.FDataType := PDBFExprNode(Node^.FArgs.Items[0])^.FDataType;
    Node^.FScopeKind := skAgg;
  end
  else if  (CompareText(Node^.FData , 'COUNT') = 0) or
           (CompareText(Node^.FData , 'COUNT(*)') = 0) then
  begin
    Node^.FDataType := ftInteger;
    Node^.FScopeKind := skAgg;
  end
  else if (CompareText(Node^.FData , 'YEAR') = 0) or
          (CompareText(Node^.FData , 'MONTH') = 0) or
          (CompareText(Node^.FData , 'DAY') = 0) or
          (CompareText(Node^.FData , 'HOUR') = 0) or
          (CompareText(Node^.FData , 'MINUTE') = 0) or
          (CompareText(Node^.FData , 'SECOND') = 0 ) then
  begin
    Node^.FDataType := ftInteger;
    Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  end
  else if CompareText(Node^.FData , 'GETDATE') = 0  then
  begin
    Node^.FDataType := ftDateTime;
    Node^.FScopeKind := skConst;
  end
  else if CompareText(Node^.FData , 'DATE') = 0  then
  begin
    Node^.FDataType := ftDate;
    Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  end
  else if CompareText(Node^.FData , 'TIME') = 0  then
  begin
    Node^.FDataType := ftTime;
    Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  end;
end;

function TVKDBFExprParser.TokenName: string;
begin
  if FSourcePtr = FTokenPtr then Result := SExprNothing else
  begin
    SetString(Result, FTokenPtr, FSourcePtr - FTokenPtr);
    Result := '''' + Result + '''';
  end;
end;

function TVKDBFExprParser.TokenSymbolIs(const S: string): Boolean;
begin
  Result := (FToken = etSymbol) and (CompareText(FTokenString, S) = 0);
end;


function TVKDBFExprParser.TokenSymbolIsFunc(const S: string) : Boolean;
begin
  Result := (CompareText(S, 'UPPER') = 0) or
            (CompareText(S, 'LOWER') = 0) or
            (CompareText(S, 'SUBSTRING') = 0) or
            (CompareText(S, 'SUBSTR') = 0) or
            (CompareText(S, 'ALLTRIM') = 0) or
            (CompareText(S, 'TRIM') = 0) or
            (CompareText(S, 'TRIMLEFT') = 0) or
            (CompareText(S, 'LTRIM') = 0) or
            (CompareText(S, 'TRIMRIGHT') = 0) or
            (CompareText(S, 'RTRIM') = 0) or
            (CompareText(S, 'DTOS') = 0) or
            (CompareText(S, 'DTTOS') = 0) or
            (CompareText(S, 'STR') = 0) or
            (CompareText(S, 'YEAR') = 0) or
            (CompareText(S, 'MONTH') = 0) or
            (CompareText(S, 'DAY') = 0) or
            (CompareText(S, 'HOUR') = 0) or
            (CompareText(S, 'MINUTE') = 0) or
            (CompareText(S, 'SECOND') = 0) or
            (CompareText(S, 'GETDATE') = 0) or
            (CompareText(S, 'DATE') = 0) or
            (CompareText(S, 'TIME') = 0) or
            (CompareText(S, 'IF') = 0) or
            (CompareText(S, 'IIF') = 0) or
            (CompareText(S, 'LEFT') = 0) or
            (CompareText(S, 'RIGHT') = 0) or
            (CompareText(S, 'SPACE') = 0) or
            (CompareText(S, 'STRZERO') = 0) or
            (CompareText(S, 'SUM') = 0) or
            (CompareText(S, 'MIN') = 0) or
            (CompareText(S, 'MAX') = 0) or
            (CompareText(S, 'AVG') = 0) or
            (CompareText(S, 'COUNT') = 0);

end;

procedure TVKDBFExprParser.TypeCheckArithOp(Node: PDBFExprNode);
begin
  with Node^ do
  begin
    if IsNumeric(FLeft.FDataType) and IsNumeric(FRight.FDataType)  then
      FDataType := ftFloat
    else if (FLeft.FDataType in StringFieldTypes) and
       (FRight.FDataType in StringFieldTypes) and (FOperator = coADD) then
      FDataType := ftString
    else if IsTemporal(FLeft.FDataType) and IsNumeric(FRight.FDataType) and
       (FOperator = coADD) then
      FDataType := ftDateTime
    else if IsTemporal(FLeft.FDataType) and IsNumeric(FRight.FDataType) and
       (FOperator = coSUB) then
      FDataType := FLeft.FDataType
    else if IsTemporal(FLeft.FDataType) and IsTemporal(FRight.FDataType) and
       (FOperator = coSUB) then
      FDataType := ftFloat
    else if (FLeft.FDataType in StringFieldTypes) and IsTemporal(FRight.FDataType) and
       (FOperator = coSUB) then
    begin
      FLeft.FDataType := FRight.FDataType;
      FDataType := ftFloat;
    end
    else if ( FLeft.FDataType in StringFieldTypes) and  IsNumeric(FRight.FDataType )and
         (FLeft.FKind = enConst)  then
      FLeft.FDataType := ftDateTime
    else
      DatabaseError(SExprTypeMis);
  end;
end;

function TVKDBFExprParser.Execute(Root: PDBFExprNode): Variant;

    function EvaluteNodeValueComplex(ANode: PDBFExprNode): Variant;
    var
      V: PDBFExprNode;
      l, r, Vr: Variant;
      i, j, k: Integer;
      S, S1: String;
      Year, Month, Day: Word;
      Hour, Min, Sec, MSec: Word;
      dt: TDateTime;
      ff: boolean;
      Code: Integer;
      kk: Int64;

      function VarIsString(const V: Variant): Boolean;
      var
          tp: Integer;
      begin
          tp := VarType(l);
          Result := (tp = varString) or (tp = varOleStr);
      end;

      procedure UpperCaseLR;
      begin
          if VarIsString(l) then
              l := AnsiUpperCase(l);
          if VarIsString(r) then
              r := AnsiUpperCase(r);
      end;

      function PartialEQ(AForce: Boolean): Boolean;
      var
          sL, sR: String;
          ln, lnL, lnR: Integer;
          partial: Boolean;
      begin
          if VarIsString(l) and VarIsString(r) then begin
              sL := l;
              sR := r;
              lnL := Length(sL);
              lnR := Length(sR);
              if l <> '' then begin
                  partial := False;
                  if sL[lnL] = '*' then begin
                      partial := True;
                      Dec(lnL);
                  end;
                  if r <> '' then begin
                      if sR[lnR] = '*' then begin
                          partial := True;
                          Dec(lnR);
                      end;
                      if partial or AForce then begin
                          ln := lnR;
                          if ln > lnL then
                              ln := lnL;
                          if (foCaseInsensitive in FOptions) then
                              Result := AnsiStrLIComp(PChar(sL), PChar(sR), ln) = 0
                          else
                              Result := AnsiStrLComp(PChar(sL), PChar(sR), ln) = 0;
                          Exit;
                      end;
                  end;
              end;
              if (foCaseInsensitive in FOptions) then
                  Result := AnsiCompareText(sL, sR) = 0
              else
                  Result := sL = Sr;
          end
          else begin
              UpperCaseLR;
              Result := l = r;
          end;
      end;

    begin
      Result := Unassigned;
      case ANode^.FKind of
      enField:
        begin
          if not FKeyFromValues then
            Result := (ANode^.FField).Value
          else begin
            ff := false;
            for i:=0 to FFields.Count - 1 do
              if TField(FFields[i]).FieldName = (ANode^.FField).FieldName then begin
                if VarIsArray(FKeyValues) then begin
                  if (VarArrayLowBound(FKeyValues, 1) <= i) and (i <= VarArrayHighBound(FKeyValues, 1)) then
                    Result := FKeyValues[i]
                  else
                    Result := Null;
                end else
                  Result := FKeyValues;
                if (not VarIsNull(Result)) then
                  case TField(FFields[i]).DataType of
                    ftString, ftFixedChar               : Result := VarAsType(Result, varString);
                    ftWideString                        : Result := VarAsType(Result, varOleStr);
                    ftSmallint                          : Result := VarAsType(Result, varSmallint);
                    ftInteger, ftWord, ftAutoInc        : Result := VarAsType(Result, varInteger);
                    ftLargeint                          :
                      begin
                        Val(Result, kk, code);
                        if code <> 0 then
                          Result := Null
                        else begin
                                                    {$IFDEF VER130}
                          TVarData(Vr).VType := VT_DECIMAL;
                          Decimal(Vr).lo64 := kk;
                                                    {$ENDIF}
                                                    {$IFDEF VER140}
                                                    Vr := kk;
                                                    {$ENDIF}
                          Result := Vr;
                        end;
                      end;
                    ftBoolean                           : Result := VarAsType(Result, varBoolean);
                    ftFloat                             : Result := VarAsType(Result, varDouble);
                    ftCurrency, ftBCD                   : Result := VarAsType(Result, varCurrency);
                    ftDate, ftTime, ftDateTime          : Result := VarAsType(Result, varDate);
                  end;
                ff := true;
                if (not VarIsNull(Result)) and (ANode^.FDataType in [ftString, ftFixedChar, ftWideString]) and (Length(Result) < ANode^.FDataLen) then
                  Result := Result + StringOfChar(' ', ANode^.FDataLen - Length(Result));
                break;
              end;
            if not ff then Result := Null;
          end;
          if FIndexKeyValue then begin
            if ANode^.FDataType in [ftFloat, ftCurrency] then begin
              ANode^.FDataLen := TVKSmartDBF((ANode^.FField).DataSet).GetLen(ANode^.FField);
              ANode^.FDataPrec := TVKSmartDBF((ANode^.FField).DataSet).GetPrec(ANode^.FField);
            end else begin
              ANode^.FDataLen := TVKSmartDBF((ANode^.FField).DataSet).GetLen(ANode^.FField);
              ANode^.FDataPrec := 0;
            end;
            if VarIsNull(Result) then begin
              case ANode^.FDataType of
                ftString, ftWideString: Result := StringOfChar(FFC, ANode^.FDataSize);
                ftFloat, ftLargeint, ftInteger, ftWord, ftCurrency, ftBCD, ftSmallint: Result := 0;
                ftBoolean: Result := false;
                //ftDateTime: Result := StringOfChar(FFC, 8);
              end;
            end else
              if ANode^.FDataType in [ftString, ftWideString] then
                if Length(Result) < ANode^.FDataSize then
                  Result := Result + StringOfChar(FFC, ANode^.FDataSize - Length(Result));
          end;
        end;
      enConst:
        Result := ANode^.FData;
      enOperator:
        case ANode^.FOperator of
        coNOTDEFINED:;
        coASSIGN:
          begin
            (ANode^.FRight^.FField).Value :=
                EvaluteNodeValueComplex(ANode^.FLeft);
            Result := (ANode^.FRight^.FField).Value;
          end;
        coOR:
            Result := Boolean(EvaluteNodeValueComplex(ANode^.FLeft)) or
                      Boolean(EvaluteNodeValueComplex(ANode^.FRight));
        coAND:
            Result := Boolean(EvaluteNodeValueComplex(ANode^.FLeft)) and
                      Boolean(EvaluteNodeValueComplex(ANode^.FRight));
        coNOT:
            Result := not Boolean(EvaluteNodeValueComplex(ANode^.FLeft));
        coEQ, coNE, coGE, coLE, coGT, coLT:
          begin
            l := EvaluteNodeValueComplex(ANode^.FLeft);
            r := EvaluteNodeValueComplex(ANode^.FRight);
            if (foCaseInsensitive in FOptions) and
               not (foNoPartialCompare in FOptions) then
                UpperCaseLR;
            case ANode^.FOperator of
                coEQ:
                  if foNoPartialCompare in FOptions then
                    Result := l = r
                  else
                    Result := PartialEQ(ANode^.FPartial);
                coNE: Result := l <> r;
                coGE: Result := l >= r;
                coLE: Result := l <= r;
                coGT: Result := l > r;
                coLT: Result := l < r;
            end;
          end;
        coLIKE:
            begin
                Result := LikeOperator( EvaluteNodeValueComplex(ANode^.FLeft), EvaluteNodeValueComplex(ANode^.FRight),
                                        foCaseInsensitive in FOptions, '%', '_');
            end;
        coISBLANK, coNOTBLANK:
            begin
                if ANode^.FLeft^.FKind = enField then
                    Result := ANode^.FLeft^.FField.IsNull
                else
                    //Result := StrIsNull(EvaluteNodeValue(ANode^.FLeft));
                    Result := VarIsNull(EvaluteNodeValueComplex(ANode^.FLeft));
                if ANode^.FOperator = coNOTBLANK then
                    Result := not Result;
            end;
        coIN:
            begin
                Result := False;
                l := EvaluteNodeValueComplex(ANode^.FLeft);
                for i := 0 to ANode^.FArgs.Count - 1 do
                begin
                  r := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[i]));
                  if foNoPartialCompare in FOptions then
                    Result := l = r
                  else
                    Result := PartialEQ(ANode^.FPartial);
                  if Result then Break;
                end;
            end;
        coADD:
          begin
            Result := EvaluteNodeValueComplex(ANode^.FLeft) + EvaluteNodeValueComplex(ANode^.FRight);
            if FIndexKeyValue then begin
              if ANode^.FLeft.FDataLen > ANode^.FRight.FDataLen then
                ANode^.FDataLen := ANode^.FLeft.FDataLen + 1
              else
                ANode^.FDataLen := ANode^.FRight.FDataLen + 1;
              if ANode^.FLeft.FDataPrec > ANode^.FRight.FDataPrec then
                ANode^.FDataPrec := ANode^.FLeft.FDataPrec
              else
                ANode^.FDataPrec := ANode^.FRight.FDataPrec;
              //if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
              //if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
            end;
          end;
        coSUB:
          begin
            Result := EvaluteNodeValueComplex(ANode^.FLeft) - EvaluteNodeValueComplex(ANode^.FRight);
            if FIndexKeyValue then begin
              if ANode^.FLeft.FDataLen > ANode^.FRight.FDataLen then
                ANode^.FDataLen := ANode^.FLeft.FDataLen
              else
                ANode^.FDataLen := ANode^.FRight.FDataLen;
              if ANode^.FLeft.FDataPrec > ANode^.FRight.FDataPrec then
                ANode^.FDataPrec := ANode^.FLeft.FDataPrec
              else
                ANode^.FDataPrec := ANode^.FRight.FDataPrec;
              if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
              if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
            end;
          end;
        coMUL:
          begin
            Result := EvaluteNodeValueComplex(ANode^.FLeft) * EvaluteNodeValueComplex(ANode^.FRight);
            if FIndexKeyValue then begin
              ANode^.FDataLen := ANode^.FLeft.FDataLen + ANode^.FRight.FDataLen;
              ANode^.FDataPrec := ANode^.FLeft.FDataPrec + ANode^.FRight.FDataPrec;
              if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
              if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
            end;
          end;
        coDIV:
          begin
            Result := EvaluteNodeValueComplex(ANode^.FLeft) / EvaluteNodeValueComplex(ANode^.FRight);
            if FIndexKeyValue then begin
              if ANode^.FLeft.FDataLen > ANode^.FRight.FDataLen then
                ANode^.FDataLen := ANode^.FLeft.FDataLen
              else
                ANode^.FDataLen := ANode^.FRight.FDataLen;
              if ANode^.FLeft.FDataPrec > ANode^.FRight.FDataPrec then
                ANode^.FDataPrec := ANode^.FLeft.FDataPrec
              else
                ANode^.FDataPrec := ANode^.FRight.FDataPrec;
              if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
              if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
            end;
          end;
        end;
      enFunc:
        begin
          S := AnsiUpperCase(ANode^.FData);
          if (CompareText(S, 'UPPER') = 0) then
            Result := AnsiUpperCase(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
          else if (CompareText(S, 'LOWER') = 0) then
            Result := AnsiLowerCase(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
          else if (CompareText(S, 'DTOS') = 0) then begin
            Vr := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]));
            if VarType(Vr) = varDate then begin
              if not VarIsNull(Vr) then
                Result := DtoS(VarToDateTime(Vr))
              else
                Result := StringOfChar(FFC, 8);
            end else
              Result := StringOfChar(FFC, 8);
          end else if (CompareText(S, 'DTTOS') = 0) then begin
            Vr := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]));
            if VarType(Vr) = varDate then begin
              if not VarIsNull(Vr) then
                Result := DTtoS(VarToDateTime(Vr))
              else
                Result := StringOfChar(FFC, 14);
            end else
              Result := StringOfChar(FFC, 14);
          end else if (CompareText(S, 'STR') = 0) then begin
            V := PDBFExprNode(ANode^.FArgs.Items[0]);
            Vr := EvaluteNodeValueComplex(V);
            if not VarIsNull(Vr) then begin
              S1 := '';
              case ANode^.FArgs.Count of
                1: Str(Vr:V.FDataLen:V.FDataPrec, S1);
                2:
                  begin
                    j := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]));
                    Str(Vr:j:V.FDataPrec, S1);
                  end;
                3:
                  begin
                    j := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]));
                    k := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[2]));
                    Str(Vr:j:k, S1);
                  end;
              end;
            end else
              S1 := StringOfChar(FFC, V.FDataLen);
            Result := S1;
          end else if (CompareText(S, 'STRZERO') = 0) then
          begin
            j := Integer(Trunc(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))));
            S1 := '';
            case ANode^.FArgs.Count of
              1:
                begin
                  FmtStr(S1, '%d', [j]);
                  Result := StringOfChar('0', 10 - Length(S1)) + S1;
                end;
              2:
                begin
                  k := Integer(Trunc(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))));
                  FmtStr(S1, '%d', [j]);
                  Result := StringOfChar('0', k - Length(S1)) + S1;
                end;
            end;
          end else if (CompareText(S, 'SPACE') = 0) then
          begin
            Result := StringOfChar(FFC, Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))));
          end else if (CompareText(S, 'RIGHT') = 0) then
          begin
            S1 := VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
            j := Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1])));
            k := Length(S1) - j + 1;
            if k <= 0 then k := 1;
            Result := Copy(S1, k, j);
          end else if (CompareText(S, 'LEFT') = 0) then
          begin
            S1 := VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
            Result := Copy(S1, 1, Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))));
          end else if ((CompareText(S, 'IF') = 0) or (CompareText(S, 'IIF') = 0)) then
          begin
            if EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])) then
              Result := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))
            else
              Result := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[2]));
          end else if ((CompareText(S, 'SUBSTRING') = 0) or (CompareText(S, 'SUBSTR') = 0)) then
          begin
            S1 := VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
            Result := Copy(S1, Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))),
                                Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[2]))));
          end else if ( CompareText(S, 'ALLTRIM') = 0 ) then
            Result := Trim(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
          else if ((CompareText(S, 'TRIMLEFT') = 0) or (CompareText(S, 'LTRIM') = 0)) then
            Result := TrimLeft(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
          else if ((CompareText(S, 'TRIMRIGHT') = 0) or (CompareText(S, 'RTRIM') = 0) or (CompareText(S, 'TRIM') = 0)) then
            Result := TrimRight(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
          else if (CompareText(S, 'YEAR') = 0) then
          begin
            DecodeDate(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Year, Month, Day);
            Result := Year;
          end else if (CompareText(S, 'MONTH') = 0) then
          begin
            DecodeDate(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Year, Month, Day);
            Result := Month;
          end else if (CompareText(S, 'DAY') = 0) then
          begin
            DecodeDate(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Year, Month, Day);
            Result := Day;
          end else if (CompareText(S, 'HOUR') = 0) then
          begin
            DecodeTime(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Hour, Min, Sec, MSec);
            Result := Hour;
          end else if (CompareText(S, 'MINUTE') = 0) then
          begin
            DecodeTime(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Hour, Min, Sec, MSec);
            Result := Min;
          end else if (CompareText(S, 'SECOND') = 0) then
          begin
            DecodeTime(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Hour, Min, Sec, MSec);
            Result := Sec;
          end else if (CompareText(S, 'GETDATE') = 0) then
            Result := StrToDate(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
          else if (CompareText(S, 'DATE') = 0) then
            Result := Integer(Trunc(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])))))
          else if (CompareText(S, 'TIME') = 0) then
          begin
            dt := VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
            Result := dt - Trunc(dt);
          end;
          {(CompareText(S, 'SUM') = 0)
          (CompareText(S, 'MIN') = 0)
          (CompareText(S, 'MAX') = 0)
          (CompareText(S, 'AVG') = 0)
          (CompareText(S, 'COUNT') = 0)}
        end;
      else
        Result := Null;
      end;
    end;
begin
    Result := EvaluteNodeValueComplex(Root);
end;

function TVKDBFExprParser.Execute: Variant;
begin
  FValue := Null;
  if FLastRoot <> nil then
    FValue := Execute(FLastRoot);
  Result := FValue;
end;

function TVKDBFExprParser.EvaluteKey: String;
var
  sign: boolean;
  vType: Integer;
  i64: Int64;
begin
  FValue := Null;
  if FLastRoot <> nil then
    FValue := Execute(FLastRoot);
  vType := VarType(FValue);
    {$IFDEF VER130}
  if (vType = 14) then begin
    i64 := Decimal(FValue).lo64;
    {$ENDIF}
    {$IFDEF VER140}
  if (vType = varInt64) then begin
    i64 := FValue;
    {$ENDIF}
    if i64 >= 0 then
      sign := false
    else begin
      sign := true;
      i64 := -i64;
    end;
    FmtStr(Result, '%d', [i64]);
    Result := StringOfChar('0', FLastRoot.FDataLen - Length(Result)) + Result;
    if sign then
      ReplSign(Result);
  end else if (vType in [varDouble, varInteger, varSmallint, varSingle, varCurrency] ) then begin
    if FValue >= 0 then
      sign := false
    else begin
      sign := true;
      FValue := -FValue;
    end;
    // use $U- for escape GPF
    Str(FValue:FLastRoot.FDataLen:FLastRoot.FDataPrec, Result);
    //
    ReplBlanks(Result);
    if sign then
      ReplSign(Result);
  end else if (vType = varBoolean) then begin
    if FValue then
      Result := 'T'
    else
      Result := 'F';
  end else if (vType = varDate) then begin
    case FLastRoot.FDataType of
      ftDate: Result := DtoS(VarToDateTime(FValue));
      ftTime: Result := TtoS(VarToDateTime(FValue));
      ftDateTime: Result := DTtoS(VarToDateTime(FValue));
    else
      Result := DtoS(VarToDateTime(FValue))
    end;
  end else if ((vType = varEmpty) or (vType = varNull)) then begin
    Result := StringOfChar(FFC, FLastRoot.FDataLen);
  end else
    Result := VarToStr(FValue);
  FKey := Result;
end;

function TVKDBFExprParser.SuiteFieldList(fl: String; out m: Integer): Integer;
var
  fs, fn: String;
  fc: Integer;
  q: boolean;

  procedure SuiteFieldListInternal(ANode: PDBFExprNode);
  var
    i: Integer;
  begin
    case ANode^.FKind of
    enField:
      begin
        Inc(m);
        if not q then begin
          fn := UpperCase((ANode^.FField).FieldName);
          if Pos(fn, fs) <> 0 then
            Inc(fc)
          else
            q := true;
        end;
      end;
    enOperator, enFunc:
      begin
        if ANode^.FLeft <> nil then
          SuiteFieldListInternal(ANode^.FLeft);
        if ANode^.FRight <> nil then
          SuiteFieldListInternal(ANode^.FRight);
        if ANode^.FArgs <> nil then
          for i := 0 to ANode^.FArgs.Count - 1 do
            if ANode^.FArgs.Items[i] <> nil then
              SuiteFieldListInternal(PDBFExprNode(ANode^.FArgs.Items[i]));
      end;
    end;
  end;

begin
  fs := UpperCase(fl);
  fc := 0;
  m := 0;
  q := false;
  if FLastRoot <> nil then SuiteFieldListInternal(FLastRoot);
  Result := fc;
end;

function TVKDBFExprParser.EvaluteKey(const KeyFields: string;
  const KeyValues: Variant; const CF: Char = #$20): String;
begin
  if CF <> #$20 then FFC := CF;
  FFields := TList.Create;
  FKeyValues := KeyValues;
  FKeyFromValues := true;
  try
    FDataSet.GetFieldList(FFields, KeyFields);
    Result := EvaluteKey;
  finally
    FKeyFromValues := false;
    FFC := #$20;
    FFields.Free;
    FFields := nil;
  end;
end;

function TVKDBFExprParser.GetDataLen: Integer;
begin
  Result := FLastRoot.FDataLen;
end;

function TVKDBFExprParser.GetDataPrec: Integer;
begin
  Result := FLastRoot.FDataPrec;
end;

function TVKDBFExprParser.GetFieldList: String;
var
  lResult: String;

  procedure GetFieldListInternal(ANode: PDBFExprNode);
  var
    i: Integer;
  begin
    case ANode^.FKind of
    enField: lResult := lResult + UpperCase((ANode^.FField).FieldName) + ';';
    enOperator, enFunc:
      begin
        if ANode^.FLeft <> nil then
          GetFieldListInternal(ANode^.FLeft);
        if ANode^.FRight <> nil then
          GetFieldListInternal(ANode^.FRight);
        if ANode^.FArgs <> nil then
          for i := 0 to ANode^.FArgs.Count - 1 do
            if ANode^.FArgs.Items[i] <> nil then
              GetFieldListInternal(PDBFExprNode(ANode^.FArgs.Items[i]));
      end;
    end;
  end;

begin
  lResult := '';
  if FLastRoot <> nil then GetFieldListInternal(FLastRoot);
  Result := lResult;
end;

end.