ezbaseexpr.pas

很管用的GIS控件

Unit EzBaseExpr;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}
Interface

Uses
  SysUtils, Classes;

Type

  TExprType = ( ttString, ttFloat, ttInteger, ttBoolean );

  TExpression = Class
  Private
    Function GetMaxLen: Integer;
  Protected
    Function GetAsString: String; Virtual;
    Function GetAsFloat: Double; Virtual;
    Function GetAsInteger: Integer; Virtual;
    Function GetAsBoolean: Boolean; Virtual;
    Function GetExprType: TExprType; Virtual; Abstract;
    Function GetMaxString: String; Virtual;
  Public
    Function CanReadAs( aExprType: TExprType ): Boolean;
    {means 'can be interpreted as'. Sort of}
    Property MaxString: String Read GetMaxString;
    Property AsString: String Read GetAsString;
    Property AsFloat: Double Read GetAsFloat;
    Property AsInteger: Integer Read GetAsInteger;
    Property AsBoolean: Boolean Read GetAsBoolean;
    Property ExprType: TExprType Read GetExprType;
    Property MaxLen: Integer read GetMaxLen;
  End;

  TStringLiteral = Class( TExpression )
  Private
    FAsString: String;
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( const aAsString: String );
  End;

  TFloatLiteral = Class( TExpression )
  Private
    FAsFloat: Double;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aAsFloat: Double );
  End;

  TIntegerLiteral = Class( TExpression )
  Private
    FAsInteger: Integer;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aAsInteger: Integer );
  End;

  TBooleanLiteral = Class( TExpression )
  Private
    FAsBoolean: Boolean;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aAsBoolean: Boolean );
  End;

  TParameterList = Class( TList )
  Private
    Function GetAsString( i: Integer ): String;
    Function GetAsFloat( i: Integer ): Double;
    Function GetAsInteger( i: Integer ): Integer;
    Function GetAsBoolean( i: Integer ): Boolean;
    Function GetExprType( i: Integer ): TExprType;
    Function GetParam( i: Integer ): TExpression;
  Public
    Destructor Destroy; Override;
    Property Param[i: Integer]: TExpression Read GetParam;
    Property ExprType[i: Integer]: TExprType Read GetExprType;
    Property AsString[i: Integer]: String Read GetAsString;
    Property AsFloat[i: Integer]: Double Read GetAsFloat;
    Property AsInteger[i: Integer]: Integer Read GetAsInteger;
    Property AsBoolean[i: Integer]: Boolean Read GetAsBoolean;
  End;

  TFunction = Class( TExpression )
  Private
    FParameterList: TParameterList;
    Function GetParam( n: Integer ): TExpression;
  {$IFDEF BCB} (*_*)
    function GetParameterList: TParameterList;
  {$ENDIF}
  Public
    Constructor Create( aParameterList: TParameterList );
    Destructor Destroy; Override;
    Function ParameterCount: Integer;
    Property Param[n: Integer]: TExpression Read GetParam;
    Property ParameterList: TParameterList
      Read {$IFDEF BCB} GetParameterList {$ELSE} FParameterList {$ENDIF}; (*_*)
  End;

  TTypeCast = Class( TFunction )
  Private
    Operator: TExprType;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aParameterList: TParameterList;
      aOperator: TExprType );
  End;

  TMF =
    ( mfTrunc, mfRound, mfAbs, mfArcTan, mfCos, mfExp, mfFrac, mfInt,
      mfLn, mfPi, mfSin, mfSqr, mfSqrt, mfPower );

  TMathExpression = Class( TFunction )
  Private
    Operator: TMF;
    Procedure CheckParameters;
  Protected
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aParameterList: TParameterList;
      aOperator: TMF );
  End;

  TSF = ( sfUpper, sfLower, sfCopy, sfPos, sfLength, sfLTrim, sfRTrim, sfTrim );

  TStringExpression = Class( TFunction )
  Private
    Operator: TSF;
    Procedure CheckParameters;
  Protected
    Function GetMaxString: String; Override;
    Function GetAsString: String; Override;
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aParameterList: TParameterList;
      aOperator: TSF );
  End;

  TConditional = Class( TFunction )
  Private
    Procedure CheckParameters;
    Function Rex: TExpression;
  Protected
    Function GetMaxString: String; Override;
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  End;

Type
  TOperator = ( opNot,
    opExp,
    opMult, opDivide, opDiv, opMod, opAnd, opShl, opShr,
    opPlus, opMinus, opOr, opXor,
    opEq, opNEQ, opLT, opGT, opLTE, opGTE );

  TOperators = Set Of TOperator;

  TUnaryOp = Class( TExpression )
  Private
    Operand: TExpression;
    OperandType: TExprType;
    Operator: TOperator;
  Protected
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aOperator: TOperator; aOperand: TExpression );
    Destructor Destroy; Override;
  End;

  TBinaryOp = Class( TExpression )
  Private
    Operand1, Operand2: TExpression;
    Operator: TOperator;
    OperandType: TExprType;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aOperator: TOperator; aOperand1, aOperand2: TExpression );
    Destructor Destroy; Override;
  End;

  TRelationalOp = Class( TExpression )
  Private
    Operand1, Operand2: TExpression;
    Operator: TOperator;
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( aOperator: TOperator; aOperand1, aOperand2: TExpression );
    Destructor Destroy; Override;
  End;

  EExpression = Class( Exception );

  { additional functions }
  { additional functions }
  TASCIIExpr = Class( TFunction )
  Protected
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList );
  End;

  TLeftExpr = Class( TFunction )
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
  End;

  TRightExpr = Class( TFunction )
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
  End;

  { This function is used exclusively for the LIKE predicate in SQL }
  TLikePos = ( lpNone, lpLeft, lpMiddle, lpRight );
  TLikeCode = ( lcSingle, lcMultiple );

  TLikeItem = Class( TObject )
  Public
    LikeText: String; { text to find }
    LikePos: TLikePos; { text must go at left, middle, right or on a column }
    LikeCode: TLikeCode;
  End;

  TLikeList = Class( TObject )
  Private
    fItems: TList;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): TLikeItem;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Function Add: TLikeItem;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: TLikeItem Read GetItem; Default;
  End;

  TSQLLikeExpr = Class( Tfunction )
  Private
    LikeList: TLIKEList;
    FIsNotLike: Boolean;
    Function SQLPos( Var Start: Integer; Const Substr, Str: String ): Integer;
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; IsNotLike: Boolean );
    Destructor Destroy; Override;
    Procedure AddToList( Like: TLikeItem );
  End;

  { TSQLInPredicateExpr }
  { This function is used exclusively for the IN predicate in SQL SELECT
     something like this : SELECT * FROM customer WHERE CustNo IN (1,10,8) }
  TSQLInPredicateExpr = Class( Tfunction )
  Private
    FIsNotIn: Boolean;
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; IsNotIn: Boolean );
  End;

  TBetweenExpr = Class( Tfunction )
  Private
    FIsNotBetween: Boolean;
  Protected
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; IsNotBetween: Boolean );
  End;

  TCaseWhenElseExpr = Class( TFunction )
  Private
    FElseExpr: TExpression;
    FThenParamList: TParameterList;
    Procedure CheckParameters;
  Protected
    Function GetMaxString: String; Override;
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( WhenParamList: TParameterList;
      ThenParamList: TParameterList; ElseExpr: TExpression );
    Destructor Destroy; Override;
  End;

  TDecodeExpr = Class( TFunction )
  Protected
    Function GetAsString: String; Override;
    Function GetAsFloat: Double; Override;
    Function GetAsInteger: Integer; Override;
    Function GetAsBoolean: Boolean; Override;
    Function GetExprtype: TExprtype; Override;
    Function GetMaxString: String; Override;
  Public
    Constructor Create( ParameterList: TParameterList );
  End;

  {Evaluate FormatDateTime('dd/mmm/yyyy', 32767)}
  TFormatDateTimeExpr = Class( TFunction )
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
  End;

  {Evaluate FormatFloat('###,###,##0.00', 12345.567)}
  TFormatFloatExpr = Class( TFunction )
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
  End;

  {Evaluate Format(Format,Args)}
  TFormatExpr = Class( TFunction )
  Protected
    Function GetAsString: String; Override;
    Function GetExprType: TExprType; Override;
  End;

  TDecodeKind = ( dkYear, dkMonth, dkDay, dkHour, dkMin, dkSec, dkMSec );

  { supports syntax: YEAR(expr), MONTH(expr), DAY(expr), HOUR(expr), MIN(expr), SEC(expr), MSEC(expr)}
  TDecodeDateTimeExpr = Class( TFunction )
  Private
    FDecodeKind: TDecodeKind;
  Protected
    Function GetAsInteger: Integer; Override;
    Function GetExprType: TExprType; Override;
  Public
    Constructor Create( ParameterList: TParameterList; DecodeKind: TDecodeKind );
  End;

  {  MINOF(arg1,arg2, ..., argn), MAXOF(ARG1,ARG2, ... ,argn)
      hint by: Fady Geagea
  }
  TMinMaxOfExpr = Class( Tfunction )
  Private
    FIsMin: Boolean;
  Protected
    Function GetAsFloat: Double; Override;
    Function GetExprtype: TExprtype; Override;
  Public
    Constructor Create( ParameterList: TParameterList; IsMin: Boolean );
  End;

Const
  NBoolean: Array[Boolean] Of String[5] = ( 'False', 'True' );

Implementation

Uses
  ezlib;

Const
  { to get a string representation of TExprType use NExprType[ExprType] }
  NExprType: Array[TExprType] Of String =
  ( 'String', 'Float', 'Integer', 'Boolean' );

Resourcestring
  SEXPR_WRONGWHENEXPR = 'Expression in Case must be boolean';

  SEXPR_WRONGTHENEXPR = 'Expressions in THEN section must be all of same type';

  SEXPR_UNKNOWNID = 'Unknown Identifier %s';

  SEXPR_OPERATORINCOMPAT = 'Operator %s incompatible with %s';

  SEXPR_CANNOTCASTTOSTRING = 'Cannot read %s as String';

  SEXPR_CANNOTCASTTOFLOAT = 'Cannot read %s as Float';

  SEXPR_CANNOTCASTTOINTEGER = 'Cannot read %s as Integer';

  SEXPR_CANNOTCASTTOBOOLEAN = 'Cannot read %s as boolean';

  SEXPR_WRONGUNARYOP = '%s is not simple unary operator';

  SEXPR_WRONGBINARYOP = '%s is not a simple binary operator';

  SEXPR_WRONGBOOLEANOP = 'cannot apply %s to boolean operands';

  SEXPR_WRONGRELATIONALOP = '%s is not relational operator';

  SEXPR_WRONGPARAMETER = 'Invalid parameter to %s';

  SEXPR_INVALIDPARAMETERTO = 'Invalid parameter to %s';

Const
  NOperator: Array[TOperator] Of String =
  ( 'opNot',
    'opExp',
    'opMult', 'opDivide', 'opDiv', 'opMod', 'opAnd', 'opShl', 'opShr',
    'opPlus', 'opMinus', 'opOr', 'opXor',
    'opEq', 'opNEQ', 'opLT', 'opGT', 'opLTE', 'opGTE' );

  RelationalOperators = [opEQ, opNEQ, opLT, opGT, opLTE, opGTE];

Function ResultType( Operator: TOperator; OperandType: TExprType ): TExprType;

  Procedure NotAppropriate;
  Begin
    Result := ttString;
    Raise EExpression.CreateFmt( SEXPR_OPERATORINCOMPAT,
      [NOperator[Operator], NExprType[OperandType]] )
  End;

Begin
  Case OperandType Of
    ttString:
      Case Operator Of
        opPlus: Result := ttString;
        opEq..opGTE: Result := ttBoolean;
      Else
        NotAppropriate;
      End;
    ttFloat:
      Case Operator Of
        opExp, opMult, opDivide, opPlus, opMinus: Result := ttFloat;
        opEq..opGTE: Result := ttBoolean;
      Else
        NotAppropriate;
      End;
    ttInteger:
      Case Operator Of
        opNot, opMult, opDiv, opMod, opAnd, opShl, opShr, opPlus, opMinus,
          opOr, opXor: Result := ttInteger;
        opExp, opDivide: Result := ttFloat;
        opEq..opGTE: Result := ttBoolean;
      Else
        NotAppropriate;
      End;
    ttBoolean:
      Case Operator Of
        opNot, opAnd, opOr, opXor, opEq, opNEQ: Result := ttBoolean;
      Else
        NotAppropriate;
      End;
  End
End;

Function CommonType( Op1Type, Op2Type: TExprType ): TExprType;
Begin
  If Op1Type < Op2Type Then
    Result := Op1Type
  Else
    Result := Op2Type
End;

Procedure Internal( Code: Integer );
Begin
  Raise EExpression.CreateFmt( 'Internal parser error. Code %d', [Code] )
End;

Function TExpression.GetMaxLen: Integer;
Begin
  Result:= 0;
  If ExprType = ttString then
    Result:= Length( GetMaxString );
End;

Function TExpression.GetMaxString: String;
Begin
  Result:= AsString;
End;

Function TExpression.GetAsString: String;
Begin
  Case ExprType Of
    ttString: Raise EExpression.CreateFmt( SEXPR_CANNOTCASTTOSTRING,
        [NExprType[ExprType]] );
    ttFloat: Result := FloatToStr( AsFloat );
    ttInteger: Result := IntToStr( AsInteger );
    ttBoolean: Result := NBoolean[AsBoolean];
  End;
End;