home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / d56 / VKDBF.ZIP / VKDBFParser.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-27  |  56KB  |  1,622 lines
  1. {
  2.  Copyright:      Vlad Karpov  mailto:KarpovVV@protek.ru
  3.  Author:         Vlad Karpov
  4. }
  5. unit VKDBFParser;
  6.  
  7. interface
  8.  
  9. uses  dbcommon, Windows, classes, db,
  10.       {$IFDEF VER140} Variants, {$ENDIF}
  11.       VKDBFUtil;
  12.  
  13. type
  14.  
  15.   PDBFExprNode = ^TDBFExprNode;
  16.   TDBFExprNode = record
  17.     FNext: PDBFExprNode;
  18.     FKind: TExprNodeKind;
  19.     FPartial: Boolean;
  20.     FOperator: TCANOperator;
  21.     FData: Variant;
  22.     FLeft: PDBFExprNode;
  23.     FRight: PDBFExprNode;
  24.     FDataType: TFieldType;
  25.     FDataSize: Integer;
  26.     FDataLen: Integer;
  27.     FDataPrec: Integer;
  28.     FArgs: TList;
  29.     FScopeKind: TExprScopeKind;
  30.     FField: TField;
  31.   end;
  32.  
  33.   {TVKDBFFilterExpr}
  34.   TVKDBFFilterExpr = class
  35.   private
  36.     FDataSet: TDataSet;
  37.     FFieldMap: TFieldMap;
  38.     FOptions: TFilterOptions;
  39.     FParserOptions: TParserOptions;
  40.     FNodes: PDBFExprNode;
  41.     FFieldName: string;
  42.     FDependentFields: TBits;
  43.     function GetFieldByName(Name: string) : TField;
  44.   public
  45.     constructor Create(DataSet: TDataSet; Options: TFilterOptions;
  46.       ParseOptions: TParserOptions; const FieldName: string; DepFields: TBits;
  47.       FieldMap: TFieldMap);
  48.     destructor Destroy; override;
  49.     function NewCompareNode(Field: TField; Operator: TCANOperator;
  50.       const Value: Variant): PDBFExprNode;
  51.     function NewNode(Kind: TExprNodeKind; Operator: TCANOperator;
  52.       const Data: Variant; Left, Right: PDBFExprNode): PDBFExprNode;
  53.     property DataSet: TDataSet write FDataSet;
  54.   end;
  55.  
  56.   {TVKDBFExprParser}
  57.   TVKDBFExprParser = class(TVKDBFFilterExpr)
  58.     FFilter: TVKDBFFilterExpr;
  59.     FFieldMap: TFieldMap;
  60.     FText: string;
  61.     FSourcePtr: PChar;
  62.     FTokenPtr: PChar;
  63.     FTokenString: string;
  64.     FStrTrue: string;
  65.     FStrFalse: string;
  66.     FToken: TExprToken;
  67.     FPrevToken: TExprToken;
  68.     FNumericLit: Boolean;
  69.     FParserOptions: TParserOptions;
  70.     FFieldName: string;
  71.     FDataSet: TDataSet;
  72.     FDependentFields: TBits;
  73.     FIndexKeyValue: boolean;
  74.     FFields: TList;
  75.     FKeyValues: Variant;
  76.     FKeyFromValues: boolean;
  77.     FFC: Char;
  78.     procedure NextToken;
  79.     function NextTokenIsLParen : Boolean;
  80.     function ParseExpr: PDBFExprNode;
  81.     function ParseExpr2: PDBFExprNode;
  82.     function ParseExpr3: PDBFExprNode;
  83.     function ParseExpr4: PDBFExprNode;
  84.     function ParseExpr5: PDBFExprNode;
  85.     function ParseExpr6: PDBFExprNode;
  86.     function ParseExpr7: PDBFExprNode;
  87.     function TokenName: string;
  88.     function TokenSymbolIs(const S: string): Boolean;
  89.     function TokenSymbolIsFunc(const S: string) : Boolean;
  90.     procedure GetFuncResultInfo(Node: PDBFExprNode);
  91.     procedure TypeCheckArithOp(Node: PDBFExprNode);
  92.     procedure GetScopeKind(Root, Left, Right : PDBFExprNode);
  93.     function Execute(Root: PDBFExprNode): Variant; overload;
  94.   private
  95.     FLastRoot: PDBFExprNode;
  96.     FValue: Variant;
  97.     FKey: String;
  98.     function GetDataLen: Integer;
  99.     function GetDataPrec: Integer;
  100.   public
  101.     constructor Create(DataSet: TDataSet; const Text: string;
  102.       Options: TFilterOptions; ParserOptions: TParserOptions;
  103.       const FieldName: string; DepFields: TBits; FieldMap: TFieldMap);
  104.     destructor Destroy; override;
  105.     procedure SetExprParams(const Text: string; Options: TFilterOptions;
  106.       ParserOptions: TParserOptions; const FieldName: string);
  107.     procedure SetExprParams1(const Text: string; Options: TFilterOptions;
  108.       ParserOptions: TParserOptions; const FieldName: string);
  109.     function Execute: Variant; overload;
  110.     function EvaluteKey: String; overload;
  111.     function EvaluteKey(const KeyFields: string; const KeyValues: Variant; const CF: Char = #$20): String; overload;
  112.     function SuiteFieldList(fl: String; out m: Integer): Integer;
  113.     function GetFieldList: String;
  114.     property IndexKeyValue: boolean read FIndexKeyValue write FIndexKeyValue;
  115.     property Value: Variant read FValue;
  116.     property Key: String read FKey;
  117.     property Len: Integer read GetDataLen; //FLastRoot.FDataLen;
  118.     property Prec: Integer read GetDataPrec; //FLastRoot.FDataPrec;
  119.   end;
  120.  
  121.   function LikeOperator(const Var1, Var2: Variant; const CaseInsensitive: Boolean; const ManyChars, OneChar: Char): boolean;
  122.  
  123. implementation
  124.  
  125. uses SysUtils, DBConsts, VKDBFDataSet, ActiveX;
  126.  
  127. const
  128.   StringFieldTypes = [ftString, ftFixedChar, ftWideString, ftGuid];
  129.   BlobFieldTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
  130.     ftTypedBinary, ftOraBlob, ftOraClob];
  131.  
  132. function IsNumeric(DataType: TFieldType): Boolean;
  133. begin
  134.   Result := DataType in [ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency,
  135.     ftBCD, ftAutoInc, ftLargeint];
  136. end;
  137.  
  138. function IsTemporal(DataType: TFieldType): Boolean;
  139. begin
  140.   Result := DataType in [ftDate, ftTime, ftDateTime];
  141. end;
  142.  
  143. function LikeOperator(const Var1, Var2: Variant; const CaseInsensitive: Boolean; const ManyChars, OneChar: Char): boolean;
  144. var
  145.   sStr, sPatt: String;
  146. begin
  147.   if VarIsNull(Var1) or VarIsNull(Var2) then
  148.     Result := False
  149.   else begin
  150.     sStr := Var1;
  151.     sPatt := Var2;
  152.     if CaseInsensitive then
  153.     begin
  154.       sStr := AnsiUpperCase(sStr);
  155.       sPatt := AnsiUpperCase(sPatt);
  156.     end;
  157.     Result := wildc(pChar(sPatt), pChar(sStr), Length(sStr), ManyChars, OneChar);
  158.   end;
  159. end;
  160.  
  161. {TVKDBFFilterExpr}
  162. constructor TVKDBFFilterExpr.Create(DataSet: TDataSet; Options: TFilterOptions;
  163.   ParseOptions: TParserOptions; const FieldName: string; DepFields: TBits;
  164.   FieldMap: TFieldMap);
  165. begin
  166.   FFieldMap := FieldMap;
  167.   FDataSet := DataSet;
  168.   FOptions := Options;
  169.   FFieldName := FieldName;
  170.   FParserOptions := ParseOptions;
  171.   FDependentFields := DepFields;
  172. end;
  173.  
  174. destructor TVKDBFFilterExpr.Destroy;
  175. var
  176.   Node: PDBFExprNode;
  177. begin
  178.   while FNodes <> nil do
  179.   begin
  180.     Node := FNodes;
  181.     FNodes := Node^.FNext;
  182.     if (Node^.FKind = enFunc) and (Node^.FArgs <> nil) then
  183.       Node^.FArgs.Free;
  184.     Dispose(Node);
  185.   end;
  186. end;
  187.  
  188. function TVKDBFFilterExpr.NewCompareNode(Field: TField; Operator: TCANOperator;
  189.   const Value: Variant): PDBFExprNode;
  190. var
  191.   ConstExpr: PDBFExprNode;
  192. begin
  193.   ConstExpr := NewNode(enConst, coNOTDEFINED, Value, nil, nil);
  194.   ConstExpr^.FDataType := Field.DataType;
  195.   ConstExpr^.FDataSize := Field.Size;
  196.   Result := NewNode(enOperator, Operator, Unassigned,
  197.     NewNode(enField, coNOTDEFINED, Field.FieldName, nil, nil), ConstExpr);
  198. end;
  199.  
  200. function TVKDBFFilterExpr.NewNode(Kind: TExprNodeKind; Operator: TCANOperator;
  201.   const Data: Variant; Left, Right: PDBFExprNode): PDBFExprNode;
  202. var
  203.   Field : TField;
  204. begin
  205.   New(Result);
  206.   with Result^ do
  207.   begin
  208.     FNext := FNodes;
  209.     FKind := Kind;
  210.     FPartial := False;
  211.     FOperator := Operator;
  212.     FData := Data;
  213.     FLeft := Left;
  214.     FRight := Right;
  215.     FDataLen := 0;
  216.     FDataPrec := 0;
  217.     FDataType := ftUnknown;
  218.     FArgs := nil;
  219.   end;
  220.   FNodes := Result;
  221.   if Kind = enField then
  222.   begin
  223.     Field := GetFieldByName(Data);
  224.     if Field = nil then
  225.       DatabaseErrorFmt(SFieldNotFound, [Data]);
  226.     Result^.FDataType := Field.DataType;
  227.     Result^.FDataSize := Field.Size;
  228.     Result^.FField := Field;
  229.   end;
  230. end;
  231.  
  232. function TVKDBFFilterExpr.GetFieldByName(Name: string) : TField;
  233. //var
  234. //  I: Integer;
  235. //  F: TField;
  236. //  FieldInfo: TFieldInfo;
  237. begin
  238. //  Result := nil;
  239. //  if poFieldNameGiven in FParserOptions then
  240. //    Result := FDataSet.FieldByName(UpperCase(FFieldName))
  241. //  else if poUseOrigNames in FParserOptions then begin
  242. //    for I := 0 to FDataset.FieldCount - 1 do
  243. //    begin
  244. //      F := FDataSet.Fields[I];
  245. //      if GetFieldInfo(F.Origin, FieldInfo) and
  246. //         (AnsiCompareStr(Name, FieldInfo.OriginalFieldName) = 0) then
  247. //      begin
  248. //        Result := F;
  249. //        Exit;
  250. //      end;
  251. //    end;
  252. //  end;
  253. //  if Result = nil then
  254.     Result := FDataSet.FieldByName(UpperCase(Name));
  255. //  if (Result <> nil) and (Result.FieldKind = fkCalculated) and (poAggregate in FParserOptions) then
  256. //    DatabaseErrorFmt(SExprNoAggOnCalcs, [Result.FieldName]);
  257. //  if (poFieldDepend in FParserOptions) and (Result <> nil) and
  258. //     (FDependentFields <> nil) then
  259. //    FDependentFields[Result.FieldNo-1] := True;
  260. end;
  261.  
  262. {TVKDBFExprParser}
  263. constructor TVKDBFExprParser.Create(DataSet: TDataSet; const Text: string;
  264.   Options: TFilterOptions; ParserOptions: TParserOptions; const FieldName: string;
  265.   DepFields: TBits; FieldMap: TFieldMap);
  266. begin
  267.   FFieldMap := FieldMap;
  268.   FStrTrue := STextTrue;
  269.   FStrFalse := STextFalse;
  270.   FDataSet := DataSet;
  271.   FDependentFields := DepFields;
  272.   FIndexKeyValue := false;
  273.   FFilter := TVKDBFFilterExpr.Create(DataSet, Options, ParserOptions, FieldName,
  274.     DepFields, FieldMap);
  275.   if Text <> '' then
  276.     SetExprParams(Text, Options, ParserOptions, FieldName);
  277.   FFields := nil;
  278.   FKeyFromValues := false;
  279.   FFC := #$20; //' '
  280. end;
  281.  
  282. destructor TVKDBFExprParser.Destroy;
  283. begin
  284.   FFilter.Free;
  285. end;
  286.  
  287. procedure  TVKDBFExprParser.SetExprParams(const Text: string; Options: TFilterOptions;
  288.   ParserOptions: TParserOptions; const FieldName: string);
  289. var
  290.   Root, DefField: PDBFExprNode;
  291. begin
  292.   FParserOptions := ParserOptions;
  293.   if FFilter <> nil then
  294.     FFilter.Free;
  295.   FFilter := TVKDBFFilterExpr.Create(FDataSet, Options, ParserOptions, FieldName,
  296.     FDependentFields, FFieldMap);
  297.   FText := Text;
  298.   FSourcePtr := PChar(Text);
  299.   FFieldName := FieldName;
  300.   NextToken;
  301.   Root := nil;
  302.   if FToken <> etEnd then Root := ParseExpr;
  303.   FValue := NULL;
  304.   if Root <> nil then begin
  305.     if FToken <> etEnd then DatabaseError(SExprTermination);
  306.  
  307.     if (poAggregate in FParserOptions) and (Root^.FScopeKind <> skAgg) then
  308.        DatabaseError(SExprNotAgg);
  309.     if (not (poAggregate in FParserOptions)) and (Root^.FScopeKind = skAgg) then
  310.        DatabaseError(SExprNoAggFilter);
  311.     if poDefaultExpr in ParserOptions then
  312.     begin
  313.       DefField := FFilter.NewNode(enField, coNOTDEFINED, FFieldName, nil, nil);
  314.       if (IsTemporal(DefField^.FDataType) and (Root^.FDataType in StringFieldTypes)) or
  315.          ((DefField^.FDataType = ftBoolean ) and (Root^.FDataType in StringFieldTypes)) then
  316.         Root^.FDataType := DefField^.FDataType;
  317.  
  318.       if not ((IsTemporal(DefField^.FDataType) and IsTemporal(Root^.FDataType))
  319.          or (IsNumeric(DefField^.FDataType) and IsNumeric(Root^.FDataType))
  320.          or ((DefField^.FDataType in StringFieldTypes) and (Root^.FDataType in StringFieldTypes))
  321.          or ((DefField^.FDataType = ftBoolean) and (Root^.FDataType = ftBoolean))) then
  322.         DatabaseError(SExprTypeMis);
  323.       Root := FFilter.NewNode(enOperator, coASSIGN, Unassigned, Root, DefField);
  324.     end;
  325.  
  326.     if not (poAggregate in FParserOptions) and not(poDefaultExpr in ParserOptions)
  327.        and (Root^.FDataType <> ftBoolean ) then
  328.        DatabaseError(SExprIncorrect);
  329.  
  330.  
  331.     FValue := Execute(Root);
  332.  
  333.   end;
  334.  
  335.   FLastRoot := Root;
  336.  
  337. end;
  338.  
  339. procedure TVKDBFExprParser.SetExprParams1(const Text: string;
  340.   Options: TFilterOptions; ParserOptions: TParserOptions;
  341.   const FieldName: string);
  342. var
  343.   Root: PDBFExprNode;
  344. begin
  345.   FParserOptions := ParserOptions;
  346.   if FFilter <> nil then
  347.     FFilter.Free;
  348.   FFilter := TVKDBFFilterExpr.Create(FDataSet, Options, ParserOptions, FieldName,
  349.     FDependentFields, FFieldMap);
  350.   FText := Text;
  351.   FSourcePtr := PChar(Text);
  352.   FFieldName := FieldName;
  353.   NextToken;
  354.   Root := nil;
  355.   if FToken <> etEnd then Root := ParseExpr;
  356.   if Root <> nil then
  357.     if FToken <> etEnd then DatabaseError(SExprTermination);
  358.  
  359.   FLastRoot := Root;
  360.  
  361. end;
  362.  
  363. function TVKDBFExprParser.NextTokenIsLParen : Boolean;
  364. var
  365.   P : PChar;
  366. begin
  367.   P := FSourcePtr;
  368.   while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  369.   Result := P^ = '(';
  370. end;
  371.  
  372. procedure TVKDBFExprParser.NextToken;
  373. type
  374.   ASet = Set of Char;
  375. var
  376.   P, TokenStart: PChar;
  377.   L: Integer;
  378.   StrBuf: array[0..255] of Char;
  379.  
  380.   function IsKatakana(const Chr: Byte): Boolean;
  381.   begin
  382.     Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
  383.   end;
  384.  
  385.   procedure Skip(TheSet: ASet);
  386.   begin
  387.     while TRUE do
  388.     begin
  389.       if P^ in LeadBytes then
  390.         Inc(P, 2)
  391.       else if (P^ in TheSet) or IsKatakana(Byte(P^)) then
  392.         Inc(P)
  393.       else
  394.         Exit;
  395.     end;
  396.   end;
  397.  
  398.   procedure Litr(ltr: Char);
  399.   begin
  400.     Inc(P);
  401.     L := 0;
  402.     while True do
  403.     begin
  404.       if P^ = #0 then DatabaseError(SExprStringError);
  405.       if P^ = ltr then
  406.       begin
  407.         Inc(P);
  408.         if P^ <> ltr then Break;
  409.       end;
  410.       if L < SizeOf(StrBuf) then
  411.       begin
  412.         StrBuf[L] := P^;
  413.         Inc(L);
  414.       end;
  415.       Inc(P);
  416.     end;
  417.     SetString(FTokenString, StrBuf, L);
  418.     FToken := etLiteral;
  419.     FNumericLit := False;
  420.   end;
  421.  
  422. begin
  423.   FPrevToken := FToken;
  424.   FTokenString := '';
  425.   P := FSourcePtr;
  426.   while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  427.   if (P^ <> #0) and (P^ = '/') and (P[1] <> #0) and (P[1] = '*')then
  428.   begin
  429.     P := P + 2;
  430.     while (P^ <> #0) and (P^ <> '*') do Inc(P);
  431.     if (P^ = '*') and (P[1] <> #0) and (P[1] =  '/')  then
  432.       P := P + 2
  433.     else
  434.       DatabaseErrorFmt(SExprInvalidChar, [P^]);
  435.   end;
  436.   while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  437.   FTokenPtr := P;
  438.   case P^ of
  439.     'A'..'Z', 'a'..'z', '_', #$81..#$fe:
  440.       begin
  441.         TokenStart := P;
  442.         if not SysLocale.FarEast then
  443.         begin
  444.           Inc(P);
  445.           while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '[', ']'] do Inc(P);
  446.         end
  447.         else
  448.           Skip(['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '[', ']']);
  449.         SetString(FTokenString, TokenStart, P - TokenStart);
  450.         FToken := etSymbol;
  451.         if CompareText(FTokenString, 'LIKE') = 0 then   { do not localize }
  452.           FToken := etLIKE
  453.         else if CompareText(FTokenString, 'IN') = 0 then   { do not localize }
  454.           FToken := etIN
  455.         else if CompareText(FTokenString, 'IS') = 0 then    { do not localize }
  456.         begin
  457.           while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  458.           TokenStart := P;
  459.           Skip(['A'..'Z', 'a'..'z']);
  460.           SetString(FTokenString, TokenStart, P - TokenStart);
  461.           if CompareText(FTokenString, 'NOT')= 0 then  { do not localize }
  462.           begin
  463.             while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  464.             TokenStart := P;
  465.             Skip(['A'..'Z', 'a'..'z']);
  466.             SetString(FTokenString, TokenStart, P - TokenStart);
  467.             if CompareText(FTokenString, 'NULL') = 0 then
  468.               FToken := etISNOTNULL
  469.             else
  470.               DatabaseError(SInvalidKeywordUse);
  471.           end
  472.           else if CompareText (FTokenString, 'NULL') = 0  then  { do not localize }
  473.           begin
  474.             FToken := etISNULL;
  475.           end
  476.           else
  477.             DatabaseError(SInvalidKeywordUse);
  478.         end;
  479.       end;
  480.     '[':
  481.       begin
  482.         Inc(P);
  483.         TokenStart := P;
  484.         P := AnsiStrScan(P, ']');
  485.         if P = nil then DatabaseError(SExprNameError);
  486.         SetString(FTokenString, TokenStart, P - TokenStart);
  487.         FToken := etName;
  488.         Inc(P);
  489.       end;
  490.     '''': Litr('''');
  491.     '"': Litr('"');
  492.     '-', '0'..'9':
  493.       begin
  494.         if (FPrevToken <> etLiteral) and (FPrevToken <> etName) and
  495.            (FPrevToken <> etSymbol)and (FPrevToken <> etRParen) then
  496.           begin
  497.             TokenStart := P;
  498.             Inc(P);
  499.             while (P^ in ['0'..'9', '.', 'e', 'E', '+', '-']) do
  500.               Inc(P);
  501.             //if ((P-1)^ = ',') and (DecimalSeparator = ',') and (P^ = ' ') then
  502.             //  Dec(P);
  503.             SetString(FTokenString, TokenStart, P - TokenStart);
  504.             FToken := etLiteral;
  505.             FNumericLit := True;
  506.           end
  507.         else
  508.          begin
  509.            FToken := etSUB;
  510.            Inc(P);
  511.          end;
  512.       end;
  513.     '(':
  514.       begin
  515.         Inc(P);
  516.         FToken := etLParen;
  517.       end;
  518.     ')':
  519.       begin
  520.         Inc(P);
  521.         FToken := etRParen;
  522.       end;
  523.     '<':
  524.       begin
  525.         Inc(P);
  526.         case P^ of
  527.           '=':
  528.             begin
  529.               Inc(P);
  530.               FToken := etLE;
  531.             end;
  532.           '>':
  533.             begin
  534.               Inc(P);
  535.               FToken := etNE;
  536.             end;
  537.         else
  538.           FToken := etLT;
  539.         end;
  540.       end;
  541.     '=':
  542.       begin
  543.         Inc(P);
  544.         FToken := etEQ;
  545.       end;
  546.     '>':
  547.       begin
  548.         Inc(P);
  549.         if P^ = '=' then
  550.         begin
  551.           Inc(P);
  552.           FToken := etGE;
  553.         end else
  554.           FToken := etGT;
  555.       end;
  556.     '+':
  557.       begin
  558.         Inc(P);
  559.         FToken := etADD;
  560.       end;
  561.     '*':
  562.       begin
  563.         Inc(P);
  564.         FToken := etMUL;
  565.       end;
  566.     '/':
  567.       begin
  568.         Inc(P);
  569.         FToken := etDIV;
  570.       end;
  571.     ',':
  572.       begin
  573.         Inc(P);
  574.         FToken := etComma;
  575.       end;
  576.     #0:
  577.       FToken := etEnd;
  578.     '.':
  579.       begin
  580.         TokenStart := P;
  581.         Skip(['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '[', ']']);
  582.         SetString(FTokenString, TokenStart, P - TokenStart);
  583.         if CompareText(FTokenString, '.T.') = 0 then FTokenString := 'TRUE';
  584.         if CompareText(FTokenString, '.F.') = 0 then FTokenString := 'FALSE';
  585.         if CompareText(FTokenString, '.AND.') = 0 then FTokenString := 'AND';
  586.         if CompareText(FTokenString, '.OR.') = 0 then FTokenString := 'OR';
  587.         if CompareText(FTokenString, '.XOR.') = 0 then FTokenString := 'XOR';
  588.         if CompareText(FTokenString, '.NOT.') = 0 then FTokenString := 'NOT';
  589.         FToken := etSymbol;
  590.       end;
  591.     '!':
  592.       begin
  593.         Inc(P);
  594.         FTokenString := 'NOT';
  595.         FToken := etSymbol;
  596.       end;
  597.   else
  598.     DatabaseErrorFmt(SExprInvalidChar, [P^]);
  599.   end;
  600.   FSourcePtr := P;
  601. end;
  602.  
  603. function TVKDBFExprParser.ParseExpr: PDBFExprNode;
  604. begin
  605.   Result := ParseExpr2;
  606.   while TokenSymbolIs('OR') do
  607.   begin
  608.     NextToken;
  609.     Result := FFilter.NewNode(enOperator, coOR, Unassigned,
  610.       Result, ParseExpr2);
  611.     GetScopeKind(Result, Result^.FLeft, Result^.FRight);
  612.     Result^.FDataType := ftBoolean;
  613.   end;
  614. end;
  615.  
  616. function TVKDBFExprParser.ParseExpr2: PDBFExprNode;
  617. begin
  618.   Result := ParseExpr3;
  619.   while TokenSymbolIs('AND') do
  620.   begin
  621.     NextToken;
  622.     Result := FFilter.NewNode(enOperator, coAND, Unassigned,
  623.       Result, ParseExpr3);
  624.     GetScopeKind(Result, Result^.FLeft, Result^.FRight);
  625.     Result^.FDataType := ftBoolean;
  626.   end;
  627. end;
  628.  
  629. function TVKDBFExprParser.ParseExpr3: PDBFExprNode;
  630. begin
  631.   if TokenSymbolIs('NOT') then
  632.   begin
  633.     NextToken;
  634.     Result := FFilter.NewNode(enOperator, coNOT, Unassigned,
  635.       ParseExpr4, nil);
  636.     Result^.FDataType := ftBoolean;
  637.   end else
  638.     Result := ParseExpr4;
  639.   GetScopeKind(Result, Result^.FLeft, Result^.FRight);
  640. end;
  641.  
  642.  
  643. function TVKDBFExprParser.ParseExpr4: PDBFExprNode;
  644. const
  645.   Operators: array[etEQ..etLT] of TCANOperator = (
  646.     coEQ, coNE, coGE, coLE, coGT, coLT);
  647. var
  648.   Operator: TCANOperator;
  649.   Left, Right: PDBFExprNode;
  650. begin
  651.   Result := ParseExpr5;
  652.   if (FToken in [etEQ..etLT]) or (FToken = etLIKE)
  653.      or (FToken = etISNULL) or (FToken = etISNOTNULL)
  654.      or (FToken = etIN) then
  655.   begin
  656.     case FToken of
  657.       etEQ..etLT:
  658.         Operator := Operators[FToken];
  659.       etLIKE:
  660.         Operator := coLIKE;
  661.       etISNULL:
  662.         Operator := coISBLANK;
  663.       etISNOTNULL:
  664.         Operator := coNOTBLANK;
  665.       etIN:
  666.         Operator := coIN;
  667.       else
  668.         Operator := coNOTDEFINED;
  669.     end;
  670.     NextToken;
  671.     Left := Result;
  672.     if Operator = coIN then
  673.     begin
  674.       if FToken <> etLParen then
  675.         DatabaseErrorFmt(SExprNoLParen, [TokenName]);
  676.       NextToken;
  677.       Result := FFilter.NewNode(enOperator, coIN, Unassigned,
  678.                  Left, nil);
  679.       Result.FDataType := ftBoolean;
  680.       if FToken <> etRParen then
  681.       begin
  682.         Result.FArgs := TList.Create;
  683.         repeat
  684.           Right := ParseExpr;
  685.           if IsTemporal(Left.FDataType) then
  686.             Right.FDataType := Left.FDataType;
  687.           Result.FArgs.Add(Right);
  688.           if (FToken <> etComma) and (FToken <> etRParen) then
  689.             DatabaseErrorFmt(SExprNoRParenOrComma, [TokenName]);
  690.           if FToken = etComma then NextToken;
  691.         until (FToken = etRParen) or (FToken = etEnd);
  692.         if FToken <> etRParen then
  693.           DatabaseErrorFmt(SExprNoRParen, [TokenName]);
  694.         NextToken;
  695.       end else
  696.         DatabaseError(SExprEmptyInList);
  697.     end else
  698.     begin
  699.       if (Operator <> coISBLANK) and (Operator <> coNOTBLANK) then
  700.         Right := ParseExpr5
  701.       else
  702.         Right := nil;
  703.       Result := FFilter.NewNode(enOperator, Operator, Unassigned,
  704.         Left, Right);
  705.       if Right <> nil then
  706.       begin
  707.         if (Left^.FKind = enField) and (Right^.FKind = enConst) then
  708.           begin
  709.             Right^.FDataType := Left^.FDataType;
  710.             Right^.FDataSize := Left^.FDataSize;
  711.           end
  712.         else if (Right^.FKind = enField) and (Left^.FKind = enConst) then
  713.           begin
  714.             Left^.FDataType := Right^.FDataType;
  715.             Left^.FDataSize := Right^.FDataSize;
  716.           end;
  717.       end;
  718.       if (Left^.FDataType in BlobFieldTypes) and (Operator = coLIKE) then
  719.       begin
  720.         if Right^.FKind = enConst then Right^.FDataType := ftString;
  721.       end
  722.       else if (Operator <> coISBLANK) and (Operator <> coNOTBLANK)
  723.          and ((Left^.FDataType in (BlobFieldTypes + [ftBytes])) or
  724.          ((Right <> nil) and (Right^.FDataType in (BlobFieldTypes + [ftBytes])))) then
  725.         DatabaseError(SExprTypeMis);
  726.       Result.FDataType := ftBoolean;
  727.       if Right <> nil then
  728.       begin
  729.         if IsTemporal(Left.FDataType) and (Right.FDataType in StringFieldTypes) then
  730.           Right.FDataType := Left.FDataType
  731.         else if IsTemporal(Right.FDataType) and (Left.FDataType in StringFieldTypes) then
  732.           Left.FDataType := Right.FDataType;
  733.       end;
  734.       GetScopeKind(Result, Left, Right);
  735.     end;
  736.   end;
  737. end;
  738.  
  739. function TVKDBFExprParser.ParseExpr5: PDBFExprNode;
  740. const
  741.   Operators: array[etADD..etDIV] of TCANOperator = (
  742.     coADD, coSUB, coMUL, coDIV);
  743. var
  744.   Operator: TCANOperator;
  745.   Left, Right: PDBFExprNode;
  746. begin
  747.   Result := ParseExpr6;
  748.   while FToken in [etADD, etSUB] do
  749.   begin
  750.     if not (poExtSyntax in FParserOptions) then
  751.       DatabaseError(SExprNoArith);
  752.     Operator := Operators[FToken];
  753.     Left := Result;
  754.     NextToken;
  755.     Right := ParseExpr6;
  756.     Result := FFilter.NewNode(enOperator, Operator, Unassigned, Left, Right);
  757.     TypeCheckArithOp(Result);
  758.     GetScopeKind(Result, Left, Right);
  759.   end;
  760. end;
  761.  
  762. function TVKDBFExprParser.ParseExpr6: PDBFExprNode;
  763. const
  764.   Operators: array[etADD..etDIV] of TCANOperator = (
  765.     coADD, coSUB, coMUL, coDIV);
  766. var
  767.   Operator: TCANOperator;
  768.   Left, Right: PDBFExprNode;
  769. begin
  770.   Result := ParseExpr7;
  771.   while FToken in [etMUL, etDIV] do
  772.   begin
  773.     if not (poExtSyntax in FParserOptions) then
  774.       DatabaseError(SExprNoArith);
  775.     Operator := Operators[FToken];
  776.     Left := Result;
  777.     NextToken;
  778.     Right := ParseExpr7;
  779.     Result := FFilter.NewNode(enOperator, Operator, Unassigned, Left, Right);
  780.     TypeCheckArithOp(Result);
  781.     GetScopeKind(Result, Left, Right);
  782.   end;
  783. end;
  784.  
  785.  
  786. function TVKDBFExprParser.ParseExpr7: PDBFExprNode;
  787. var
  788.   FuncName: string;
  789. begin
  790.   case FToken of
  791.     etSymbol:
  792.       if (poExtSyntax in FParserOptions)
  793.          and  NextTokenIsLParen and TokenSymbolIsFunc(FTokenString) then
  794.         begin
  795.           Funcname := FTokenString;
  796.           NextToken;
  797.           if FToken <> etLParen then
  798.             DatabaseErrorFmt(SExprNoLParen, [TokenName]);
  799.           NextToken;
  800.           if (CompareText(FuncName,'count') = 0) and (FToken = etMUL) then
  801.           begin
  802.             FuncName := 'COUNT(*)';
  803.             NextToken;
  804.           end;
  805.           Result := FFilter.NewNode(enFunc, coNOTDEFINED, FuncName,
  806.                     nil, nil);
  807.           if FToken <> etRParen then
  808.           begin
  809.             Result.FArgs := TList.Create;
  810.             repeat
  811.               Result.FArgs.Add(ParseExpr);
  812.               if (FToken <> etComma) and (FToken <> etRParen) then
  813.                 DatabaseErrorFmt(SExprNoRParenOrComma, [TokenName]);
  814.               if FToken = etComma then NextToken;
  815.             until (FToken = etRParen) or (FToken = etEnd);
  816.           end else
  817.             Result.FArgs := nil;
  818.  
  819.           GetFuncResultInfo(Result);
  820.         end
  821.       else if TokenSymbolIs('NULL') then
  822.         begin
  823.           Result := FFilter.NewNode(enConst, coNOTDEFINED, Null, nil, nil);
  824.           Result.FScopeKind := skConst;
  825.         end
  826.       else if TokenSymbolIs(FStrTrue) then
  827.         begin
  828.           Result := FFilter.NewNode(enConst, coNOTDEFINED, True, nil, nil);
  829.           Result.FScopeKind := skConst;
  830.         end
  831.       else if TokenSymbolIs(FStrFalse) then
  832.         begin
  833.           Result := FFilter.NewNode(enConst, coNOTDEFINED, False, nil, nil);
  834.           Result.FScopeKind := skConst;
  835.         end
  836.       else
  837.         begin
  838.           Result := FFilter.NewNode(enField, coNOTDEFINED, FTokenString, nil, nil);
  839.           Result.FScopeKind := skField;
  840.         end;
  841.     etName:
  842.       begin
  843.         Result := FFilter.NewNode(enField, coNOTDEFINED, FTokenString, nil, nil);
  844.         Result.FScopeKind := skField;
  845.       end;
  846.     etLiteral:
  847.       begin
  848.         if FNumericLit then begin
  849.           if DecimalSeparator <> '.' then
  850.             FTokenString := StringReplace(FTokenString, '.', DecimalSeparator, []);
  851.           Result := FFilter.NewNode(enConst, coNOTDEFINED, FTokenString, nil, nil);
  852.           Result^.FDataType := ftFloat;
  853.         end else begin
  854.           Result := FFilter.NewNode(enConst, coNOTDEFINED, FTokenString, nil, nil);
  855.           Result^.FDataType := ftString;
  856.         end;
  857.         Result.FScopeKind := skConst;
  858.       end;
  859.     etLParen:
  860.       begin
  861.         NextToken;
  862.         Result := ParseExpr;
  863.         if FToken <> etRParen then DatabaseErrorFmt(SExprNoRParen, [TokenName]);
  864.       end;
  865.   else
  866.     DatabaseErrorFmt(SExprExpected, [TokenName]);
  867.     Result := nil;
  868.   end;
  869.   NextToken;
  870. end;
  871.  
  872. procedure  TVKDBFExprParser.GetScopeKind(Root, Left, Right : PDBFExprNode);
  873. begin
  874.   if (Left = nil) and (Right = nil) then Exit;
  875.   if Right = nil then
  876.   begin
  877.     Root.FScopeKind := Left.FScopeKind;
  878.     Exit;
  879.   end;
  880.   if ((Left^.FScopeKind = skField) and (Right^.FScopeKind = skAgg))
  881.      or ((Left^.FScopeKind = skAgg) and (Right^.FScopeKind = skField)) then
  882.     DatabaseError(SExprBadScope);
  883.   if (Left^.FScopeKind = skConst) and (Right^.FScopeKind = skConst) then
  884.     Root^.FScopeKind := skConst
  885.   else if (Left^.FScopeKind = skAgg) or (Right^.FScopeKind = skAgg) then
  886.     Root^.FScopeKind := skAgg
  887.   else if (Left^.FScopeKind = skField) or (Right^.FScopeKind = skField) then
  888.     Root^.FScopeKind := skField;
  889. end;
  890.  
  891. procedure TVKDBFExprParser.GetFuncResultInfo(Node : PDBFExprNode);
  892. begin
  893.   Node^.FDataType := ftString;
  894.   if (CompareText(Node^.FData, 'COUNT(*)') <> 0 )
  895.      and (CompareText(Node^.FData,'GETDATE') <> 0 )
  896.      and ( (Node^.FArgs = nil ) or ( Node^.FArgs.Count = 0) ) then
  897.       DatabaseError(SExprTypeMis);
  898.  
  899.   if (Node^.FArgs <> nil) and (Node^.FArgs.Count > 0) then
  900.      Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  901.   if (CompareText(Node^.FData , 'SUM') = 0) or
  902.      (CompareText(Node^.FData , 'AVG') = 0) then
  903.   begin
  904.     Node^.FDataType := ftFloat;
  905.     Node^.FScopeKind := skAgg;
  906.   end
  907.   else if (CompareText(Node^.FData , 'MIN') = 0) or
  908.           (CompareText(Node^.FData , 'MAX') = 0) then
  909.   begin
  910.     Node^.FDataType := PDBFExprNode(Node^.FArgs.Items[0])^.FDataType;
  911.     Node^.FScopeKind := skAgg;
  912.   end
  913.   else if  (CompareText(Node^.FData , 'COUNT') = 0) or
  914.            (CompareText(Node^.FData , 'COUNT(*)') = 0) then
  915.   begin
  916.     Node^.FDataType := ftInteger;
  917.     Node^.FScopeKind := skAgg;
  918.   end
  919.   else if (CompareText(Node^.FData , 'YEAR') = 0) or
  920.           (CompareText(Node^.FData , 'MONTH') = 0) or
  921.           (CompareText(Node^.FData , 'DAY') = 0) or
  922.           (CompareText(Node^.FData , 'HOUR') = 0) or
  923.           (CompareText(Node^.FData , 'MINUTE') = 0) or
  924.           (CompareText(Node^.FData , 'SECOND') = 0 ) then
  925.   begin
  926.     Node^.FDataType := ftInteger;
  927.     Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  928.   end
  929.   else if CompareText(Node^.FData , 'GETDATE') = 0  then
  930.   begin
  931.     Node^.FDataType := ftDateTime;
  932.     Node^.FScopeKind := skConst;
  933.   end
  934.   else if CompareText(Node^.FData , 'DATE') = 0  then
  935.   begin
  936.     Node^.FDataType := ftDate;
  937.     Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  938.   end
  939.   else if CompareText(Node^.FData , 'TIME') = 0  then
  940.   begin
  941.     Node^.FDataType := ftTime;
  942.     Node^.FScopeKind := PDBFExprNode(Node^.FArgs.Items[0])^.FScopeKind;
  943.   end;
  944. end;
  945.  
  946. function TVKDBFExprParser.TokenName: string;
  947. begin
  948.   if FSourcePtr = FTokenPtr then Result := SExprNothing else
  949.   begin
  950.     SetString(Result, FTokenPtr, FSourcePtr - FTokenPtr);
  951.     Result := '''' + Result + '''';
  952.   end;
  953. end;
  954.  
  955. function TVKDBFExprParser.TokenSymbolIs(const S: string): Boolean;
  956. begin
  957.   Result := (FToken = etSymbol) and (CompareText(FTokenString, S) = 0);
  958. end;
  959.  
  960.  
  961. function TVKDBFExprParser.TokenSymbolIsFunc(const S: string) : Boolean;
  962. begin
  963.   Result := (CompareText(S, 'UPPER') = 0) or
  964.             (CompareText(S, 'LOWER') = 0) or
  965.             (CompareText(S, 'SUBSTRING') = 0) or
  966.             (CompareText(S, 'SUBSTR') = 0) or
  967.             (CompareText(S, 'ALLTRIM') = 0) or
  968.             (CompareText(S, 'TRIM') = 0) or
  969.             (CompareText(S, 'TRIMLEFT') = 0) or
  970.             (CompareText(S, 'LTRIM') = 0) or
  971.             (CompareText(S, 'TRIMRIGHT') = 0) or
  972.             (CompareText(S, 'RTRIM') = 0) or
  973.             (CompareText(S, 'DTOS') = 0) or
  974.             (CompareText(S, 'DTTOS') = 0) or
  975.             (CompareText(S, 'STR') = 0) or
  976.             (CompareText(S, 'YEAR') = 0) or
  977.             (CompareText(S, 'MONTH') = 0) or
  978.             (CompareText(S, 'DAY') = 0) or
  979.             (CompareText(S, 'HOUR') = 0) or
  980.             (CompareText(S, 'MINUTE') = 0) or
  981.             (CompareText(S, 'SECOND') = 0) or
  982.             (CompareText(S, 'GETDATE') = 0) or
  983.             (CompareText(S, 'DATE') = 0) or
  984.             (CompareText(S, 'TIME') = 0) or
  985.             (CompareText(S, 'IF') = 0) or
  986.             (CompareText(S, 'IIF') = 0) or
  987.             (CompareText(S, 'LEFT') = 0) or
  988.             (CompareText(S, 'RIGHT') = 0) or
  989.             (CompareText(S, 'SPACE') = 0) or
  990.             (CompareText(S, 'STRZERO') = 0) or
  991.             (CompareText(S, 'SUM') = 0) or
  992.             (CompareText(S, 'MIN') = 0) or
  993.             (CompareText(S, 'MAX') = 0) or
  994.             (CompareText(S, 'AVG') = 0) or
  995.             (CompareText(S, 'COUNT') = 0);
  996.  
  997. end;
  998.  
  999. procedure TVKDBFExprParser.TypeCheckArithOp(Node: PDBFExprNode);
  1000. begin
  1001.   with Node^ do
  1002.   begin
  1003.     if IsNumeric(FLeft.FDataType) and IsNumeric(FRight.FDataType)  then
  1004.       FDataType := ftFloat
  1005.     else if (FLeft.FDataType in StringFieldTypes) and
  1006.        (FRight.FDataType in StringFieldTypes) and (FOperator = coADD) then
  1007.       FDataType := ftString
  1008.     else if IsTemporal(FLeft.FDataType) and IsNumeric(FRight.FDataType) and
  1009.        (FOperator = coADD) then
  1010.       FDataType := ftDateTime
  1011.     else if IsTemporal(FLeft.FDataType) and IsNumeric(FRight.FDataType) and
  1012.        (FOperator = coSUB) then
  1013.       FDataType := FLeft.FDataType
  1014.     else if IsTemporal(FLeft.FDataType) and IsTemporal(FRight.FDataType) and
  1015.        (FOperator = coSUB) then
  1016.       FDataType := ftFloat
  1017.     else if (FLeft.FDataType in StringFieldTypes) and IsTemporal(FRight.FDataType) and
  1018.        (FOperator = coSUB) then
  1019.     begin
  1020.       FLeft.FDataType := FRight.FDataType;
  1021.       FDataType := ftFloat;
  1022.     end
  1023.     else if ( FLeft.FDataType in StringFieldTypes) and  IsNumeric(FRight.FDataType )and
  1024.          (FLeft.FKind = enConst)  then
  1025.       FLeft.FDataType := ftDateTime
  1026.     else
  1027.       DatabaseError(SExprTypeMis);
  1028.   end;
  1029. end;
  1030.  
  1031. function TVKDBFExprParser.Execute(Root: PDBFExprNode): Variant;
  1032.  
  1033.     function EvaluteNodeValueComplex(ANode: PDBFExprNode): Variant;
  1034.     var
  1035.       V: PDBFExprNode;
  1036.       l, r, Vr: Variant;
  1037.       i, j, k: Integer;
  1038.       S, S1: String;
  1039.       Year, Month, Day: Word;
  1040.       Hour, Min, Sec, MSec: Word;
  1041.       dt: TDateTime;
  1042.       ff: boolean;
  1043.       Code: Integer;
  1044.       kk: Int64;
  1045.  
  1046.       function VarIsString(const V: Variant): Boolean;
  1047.       var
  1048.           tp: Integer;
  1049.       begin
  1050.           tp := VarType(l);
  1051.           Result := (tp = varString) or (tp = varOleStr);
  1052.       end;
  1053.  
  1054.       procedure UpperCaseLR;
  1055.       begin
  1056.           if VarIsString(l) then
  1057.               l := AnsiUpperCase(l);
  1058.           if VarIsString(r) then
  1059.               r := AnsiUpperCase(r);
  1060.       end;
  1061.  
  1062.       function PartialEQ(AForce: Boolean): Boolean;
  1063.       var
  1064.           sL, sR: String;
  1065.           ln, lnL, lnR: Integer;
  1066.           partial: Boolean;
  1067.       begin
  1068.           if VarIsString(l) and VarIsString(r) then begin
  1069.               sL := l;
  1070.               sR := r;
  1071.               lnL := Length(sL);
  1072.               lnR := Length(sR);
  1073.               if l <> '' then begin
  1074.                   partial := False;
  1075.                   if sL[lnL] = '*' then begin
  1076.                       partial := True;
  1077.                       Dec(lnL);
  1078.                   end;
  1079.                   if r <> '' then begin
  1080.                       if sR[lnR] = '*' then begin
  1081.                           partial := True;
  1082.                           Dec(lnR);
  1083.                       end;
  1084.                       if partial or AForce then begin
  1085.                           ln := lnR;
  1086.                           if ln > lnL then
  1087.                               ln := lnL;
  1088.                           if (foCaseInsensitive in FOptions) then
  1089.                               Result := AnsiStrLIComp(PChar(sL), PChar(sR), ln) = 0
  1090.                           else
  1091.                               Result := AnsiStrLComp(PChar(sL), PChar(sR), ln) = 0;
  1092.                           Exit;
  1093.                       end;
  1094.                   end;
  1095.               end;
  1096.               if (foCaseInsensitive in FOptions) then
  1097.                   Result := AnsiCompareText(sL, sR) = 0
  1098.               else
  1099.                   Result := sL = Sr;
  1100.           end
  1101.           else begin
  1102.               UpperCaseLR;
  1103.               Result := l = r;
  1104.           end;
  1105.       end;
  1106.  
  1107.     begin
  1108.       Result := Unassigned;
  1109.       case ANode^.FKind of
  1110.       enField:
  1111.         begin
  1112.           if not FKeyFromValues then
  1113.             Result := (ANode^.FField).Value
  1114.           else begin
  1115.             ff := false;
  1116.             for i:=0 to FFields.Count - 1 do
  1117.               if TField(FFields[i]).FieldName = (ANode^.FField).FieldName then begin
  1118.                 if VarIsArray(FKeyValues) then begin
  1119.                   if (VarArrayLowBound(FKeyValues, 1) <= i) and (i <= VarArrayHighBound(FKeyValues, 1)) then
  1120.                     Result := FKeyValues[i]
  1121.                   else
  1122.                     Result := Null;
  1123.                 end else
  1124.                   Result := FKeyValues;
  1125.                 if (not VarIsNull(Result)) then
  1126.                   case TField(FFields[i]).DataType of
  1127.                     ftString, ftFixedChar               : Result := VarAsType(Result, varString);
  1128.                     ftWideString                        : Result := VarAsType(Result, varOleStr);
  1129.                     ftSmallint                          : Result := VarAsType(Result, varSmallint);
  1130.                     ftInteger, ftWord, ftAutoInc        : Result := VarAsType(Result, varInteger);
  1131.                     ftLargeint                          :
  1132.                       begin
  1133.                         Val(Result, kk, code);
  1134.                         if code <> 0 then
  1135.                           Result := Null
  1136.                         else begin
  1137.                                                     {$IFDEF VER130}
  1138.                           TVarData(Vr).VType := VT_DECIMAL;
  1139.                           Decimal(Vr).lo64 := kk;
  1140.                                                     {$ENDIF}
  1141.                                                     {$IFDEF VER140}
  1142.                                                     Vr := kk;
  1143.                                                     {$ENDIF}
  1144.                           Result := Vr;
  1145.                         end;
  1146.                       end;
  1147.                     ftBoolean                           : Result := VarAsType(Result, varBoolean);
  1148.                     ftFloat                             : Result := VarAsType(Result, varDouble);
  1149.                     ftCurrency, ftBCD                   : Result := VarAsType(Result, varCurrency);
  1150.                     ftDate, ftTime, ftDateTime          : Result := VarAsType(Result, varDate);
  1151.                   end;
  1152.                 ff := true;
  1153.                 if (not VarIsNull(Result)) and (ANode^.FDataType in [ftString, ftFixedChar, ftWideString]) and (Length(Result) < ANode^.FDataLen) then
  1154.                   Result := Result + StringOfChar(' ', ANode^.FDataLen - Length(Result));
  1155.                 break;
  1156.               end;
  1157.             if not ff then Result := Null;
  1158.           end;
  1159.           if FIndexKeyValue then begin
  1160.             if ANode^.FDataType in [ftFloat, ftCurrency] then begin
  1161.               ANode^.FDataLen := TVKSmartDBF((ANode^.FField).DataSet).GetLen(ANode^.FField);
  1162.               ANode^.FDataPrec := TVKSmartDBF((ANode^.FField).DataSet).GetPrec(ANode^.FField);
  1163.             end else begin
  1164.               ANode^.FDataLen := TVKSmartDBF((ANode^.FField).DataSet).GetLen(ANode^.FField);
  1165.               ANode^.FDataPrec := 0;
  1166.             end;
  1167.             if VarIsNull(Result) then begin
  1168.               case ANode^.FDataType of
  1169.                 ftString, ftWideString: Result := StringOfChar(FFC, ANode^.FDataSize);
  1170.                 ftFloat, ftLargeint, ftInteger, ftWord, ftCurrency, ftBCD, ftSmallint: Result := 0;
  1171.                 ftBoolean: Result := false;
  1172.                 //ftDateTime: Result := StringOfChar(FFC, 8);
  1173.               end;
  1174.             end else
  1175.               if ANode^.FDataType in [ftString, ftWideString] then
  1176.                 if Length(Result) < ANode^.FDataSize then
  1177.                   Result := Result + StringOfChar(FFC, ANode^.FDataSize - Length(Result));
  1178.           end;
  1179.         end;
  1180.       enConst:
  1181.         Result := ANode^.FData;
  1182.       enOperator:
  1183.         case ANode^.FOperator of
  1184.         coNOTDEFINED:;
  1185.         coASSIGN:
  1186.           begin
  1187.             (ANode^.FRight^.FField).Value :=
  1188.                 EvaluteNodeValueComplex(ANode^.FLeft);
  1189.             Result := (ANode^.FRight^.FField).Value;
  1190.           end;
  1191.         coOR:
  1192.             Result := Boolean(EvaluteNodeValueComplex(ANode^.FLeft)) or
  1193.                       Boolean(EvaluteNodeValueComplex(ANode^.FRight));
  1194.         coAND:
  1195.             Result := Boolean(EvaluteNodeValueComplex(ANode^.FLeft)) and
  1196.                       Boolean(EvaluteNodeValueComplex(ANode^.FRight));
  1197.         coNOT:
  1198.             Result := not Boolean(EvaluteNodeValueComplex(ANode^.FLeft));
  1199.         coEQ, coNE, coGE, coLE, coGT, coLT:
  1200.           begin
  1201.             l := EvaluteNodeValueComplex(ANode^.FLeft);
  1202.             r := EvaluteNodeValueComplex(ANode^.FRight);
  1203.             if (foCaseInsensitive in FOptions) and
  1204.                not (foNoPartialCompare in FOptions) then
  1205.                 UpperCaseLR;
  1206.             case ANode^.FOperator of
  1207.                 coEQ:
  1208.                   if foNoPartialCompare in FOptions then
  1209.                     Result := l = r
  1210.                   else
  1211.                     Result := PartialEQ(ANode^.FPartial);
  1212.                 coNE: Result := l <> r;
  1213.                 coGE: Result := l >= r;
  1214.                 coLE: Result := l <= r;
  1215.                 coGT: Result := l > r;
  1216.                 coLT: Result := l < r;
  1217.             end;
  1218.           end;
  1219.         coLIKE:
  1220.             begin
  1221.                 Result := LikeOperator( EvaluteNodeValueComplex(ANode^.FLeft), EvaluteNodeValueComplex(ANode^.FRight),
  1222.                                         foCaseInsensitive in FOptions, '%', '_');
  1223.             end;
  1224.         coISBLANK, coNOTBLANK:
  1225.             begin
  1226.                 if ANode^.FLeft^.FKind = enField then
  1227.                     Result := ANode^.FLeft^.FField.IsNull
  1228.                 else
  1229.                     //Result := StrIsNull(EvaluteNodeValue(ANode^.FLeft));
  1230.                     Result := VarIsNull(EvaluteNodeValueComplex(ANode^.FLeft));
  1231.                 if ANode^.FOperator = coNOTBLANK then
  1232.                     Result := not Result;
  1233.             end;
  1234.         coIN:
  1235.             begin
  1236.                 Result := False;
  1237.                 l := EvaluteNodeValueComplex(ANode^.FLeft);
  1238.                 for i := 0 to ANode^.FArgs.Count - 1 do
  1239.                 begin
  1240.                   r := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[i]));
  1241.                   if foNoPartialCompare in FOptions then
  1242.                     Result := l = r
  1243.                   else
  1244.                     Result := PartialEQ(ANode^.FPartial);
  1245.                   if Result then Break;
  1246.                 end;
  1247.             end;
  1248.         coADD:
  1249.           begin
  1250.             Result := EvaluteNodeValueComplex(ANode^.FLeft) + EvaluteNodeValueComplex(ANode^.FRight);
  1251.             if FIndexKeyValue then begin
  1252.               if ANode^.FLeft.FDataLen > ANode^.FRight.FDataLen then
  1253.                 ANode^.FDataLen := ANode^.FLeft.FDataLen + 1
  1254.               else
  1255.                 ANode^.FDataLen := ANode^.FRight.FDataLen + 1;
  1256.               if ANode^.FLeft.FDataPrec > ANode^.FRight.FDataPrec then
  1257.                 ANode^.FDataPrec := ANode^.FLeft.FDataPrec
  1258.               else
  1259.                 ANode^.FDataPrec := ANode^.FRight.FDataPrec;
  1260.               //if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
  1261.               //if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
  1262.             end;
  1263.           end;
  1264.         coSUB:
  1265.           begin
  1266.             Result := EvaluteNodeValueComplex(ANode^.FLeft) - EvaluteNodeValueComplex(ANode^.FRight);
  1267.             if FIndexKeyValue then begin
  1268.               if ANode^.FLeft.FDataLen > ANode^.FRight.FDataLen then
  1269.                 ANode^.FDataLen := ANode^.FLeft.FDataLen
  1270.               else
  1271.                 ANode^.FDataLen := ANode^.FRight.FDataLen;
  1272.               if ANode^.FLeft.FDataPrec > ANode^.FRight.FDataPrec then
  1273.                 ANode^.FDataPrec := ANode^.FLeft.FDataPrec
  1274.               else
  1275.                 ANode^.FDataPrec := ANode^.FRight.FDataPrec;
  1276.               if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
  1277.               if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
  1278.             end;
  1279.           end;
  1280.         coMUL:
  1281.           begin
  1282.             Result := EvaluteNodeValueComplex(ANode^.FLeft) * EvaluteNodeValueComplex(ANode^.FRight);
  1283.             if FIndexKeyValue then begin
  1284.               ANode^.FDataLen := ANode^.FLeft.FDataLen + ANode^.FRight.FDataLen;
  1285.               ANode^.FDataPrec := ANode^.FLeft.FDataPrec + ANode^.FRight.FDataPrec;
  1286.               if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
  1287.               if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
  1288.             end;
  1289.           end;
  1290.         coDIV:
  1291.           begin
  1292.             Result := EvaluteNodeValueComplex(ANode^.FLeft) / EvaluteNodeValueComplex(ANode^.FRight);
  1293.             if FIndexKeyValue then begin
  1294.               if ANode^.FLeft.FDataLen > ANode^.FRight.FDataLen then
  1295.                 ANode^.FDataLen := ANode^.FLeft.FDataLen
  1296.               else
  1297.                 ANode^.FDataLen := ANode^.FRight.FDataLen;
  1298.               if ANode^.FLeft.FDataPrec > ANode^.FRight.FDataPrec then
  1299.                 ANode^.FDataPrec := ANode^.FLeft.FDataPrec
  1300.               else
  1301.                 ANode^.FDataPrec := ANode^.FRight.FDataPrec;
  1302.               if ANode^.FDataLen > 14 then ANode^.FDataLen := 14;
  1303.               if ANode^.FDataPrec + 1 > ANode^.FDataLen then ANode^.FDataPrec := ANode^.FDataLen - 3;
  1304.             end;
  1305.           end;
  1306.         end;
  1307.       enFunc:
  1308.         begin
  1309.           S := AnsiUpperCase(ANode^.FData);
  1310.           if (CompareText(S, 'UPPER') = 0) then
  1311.             Result := AnsiUpperCase(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
  1312.           else if (CompareText(S, 'LOWER') = 0) then
  1313.             Result := AnsiLowerCase(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
  1314.           else if (CompareText(S, 'DTOS') = 0) then begin
  1315.             Vr := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]));
  1316.             if VarType(Vr) = varDate then begin
  1317.               if not VarIsNull(Vr) then
  1318.                 Result := DtoS(VarToDateTime(Vr))
  1319.               else
  1320.                 Result := StringOfChar(FFC, 8);
  1321.             end else
  1322.               Result := StringOfChar(FFC, 8);
  1323.           end else if (CompareText(S, 'DTTOS') = 0) then begin
  1324.             Vr := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]));
  1325.             if VarType(Vr) = varDate then begin
  1326.               if not VarIsNull(Vr) then
  1327.                 Result := DTtoS(VarToDateTime(Vr))
  1328.               else
  1329.                 Result := StringOfChar(FFC, 14);
  1330.             end else
  1331.               Result := StringOfChar(FFC, 14);
  1332.           end else if (CompareText(S, 'STR') = 0) then begin
  1333.             V := PDBFExprNode(ANode^.FArgs.Items[0]);
  1334.             Vr := EvaluteNodeValueComplex(V);
  1335.             if not VarIsNull(Vr) then begin
  1336.               S1 := '';
  1337.               case ANode^.FArgs.Count of
  1338.                 1: Str(Vr:V.FDataLen:V.FDataPrec, S1);
  1339.                 2:
  1340.                   begin
  1341.                     j := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]));
  1342.                     Str(Vr:j:V.FDataPrec, S1);
  1343.                   end;
  1344.                 3:
  1345.                   begin
  1346.                     j := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]));
  1347.                     k := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[2]));
  1348.                     Str(Vr:j:k, S1);
  1349.                   end;
  1350.               end;
  1351.             end else
  1352.               S1 := StringOfChar(FFC, V.FDataLen);
  1353.             Result := S1;
  1354.           end else if (CompareText(S, 'STRZERO') = 0) then
  1355.           begin
  1356.             j := Integer(Trunc(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))));
  1357.             S1 := '';
  1358.             case ANode^.FArgs.Count of
  1359.               1:
  1360.                 begin
  1361.                   FmtStr(S1, '%d', [j]);
  1362.                   Result := StringOfChar('0', 10 - Length(S1)) + S1;
  1363.                 end;
  1364.               2:
  1365.                 begin
  1366.                   k := Integer(Trunc(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))));
  1367.                   FmtStr(S1, '%d', [j]);
  1368.                   Result := StringOfChar('0', k - Length(S1)) + S1;
  1369.                 end;
  1370.             end;
  1371.           end else if (CompareText(S, 'SPACE') = 0) then
  1372.           begin
  1373.             Result := StringOfChar(FFC, Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))));
  1374.           end else if (CompareText(S, 'RIGHT') = 0) then
  1375.           begin
  1376.             S1 := VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
  1377.             j := Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1])));
  1378.             k := Length(S1) - j + 1;
  1379.             if k <= 0 then k := 1;
  1380.             Result := Copy(S1, k, j);
  1381.           end else if (CompareText(S, 'LEFT') = 0) then
  1382.           begin
  1383.             S1 := VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
  1384.             Result := Copy(S1, 1, Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))));
  1385.           end else if ((CompareText(S, 'IF') = 0) or (CompareText(S, 'IIF') = 0)) then
  1386.           begin
  1387.             if EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])) then
  1388.               Result := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))
  1389.             else
  1390.               Result := EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[2]));
  1391.           end else if ((CompareText(S, 'SUBSTRING') = 0) or (CompareText(S, 'SUBSTR') = 0)) then
  1392.           begin
  1393.             S1 := VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
  1394.             Result := Copy(S1, Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[1]))),
  1395.                                 Integer(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[2]))));
  1396.           end else if ( CompareText(S, 'ALLTRIM') = 0 ) then
  1397.             Result := Trim(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
  1398.           else if ((CompareText(S, 'TRIMLEFT') = 0) or (CompareText(S, 'LTRIM') = 0)) then
  1399.             Result := TrimLeft(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
  1400.           else if ((CompareText(S, 'TRIMRIGHT') = 0) or (CompareText(S, 'RTRIM') = 0) or (CompareText(S, 'TRIM') = 0)) then
  1401.             Result := TrimRight(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
  1402.           else if (CompareText(S, 'YEAR') = 0) then
  1403.           begin
  1404.             DecodeDate(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Year, Month, Day);
  1405.             Result := Year;
  1406.           end else if (CompareText(S, 'MONTH') = 0) then
  1407.           begin
  1408.             DecodeDate(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Year, Month, Day);
  1409.             Result := Month;
  1410.           end else if (CompareText(S, 'DAY') = 0) then
  1411.           begin
  1412.             DecodeDate(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Year, Month, Day);
  1413.             Result := Day;
  1414.           end else if (CompareText(S, 'HOUR') = 0) then
  1415.           begin
  1416.             DecodeTime(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Hour, Min, Sec, MSec);
  1417.             Result := Hour;
  1418.           end else if (CompareText(S, 'MINUTE') = 0) then
  1419.           begin
  1420.             DecodeTime(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Hour, Min, Sec, MSec);
  1421.             Result := Min;
  1422.           end else if (CompareText(S, 'SECOND') = 0) then
  1423.           begin
  1424.             DecodeTime(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))), Hour, Min, Sec, MSec);
  1425.             Result := Sec;
  1426.           end else if (CompareText(S, 'GETDATE') = 0) then
  1427.             Result := StrToDate(VarToStr(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0]))))
  1428.           else if (CompareText(S, 'DATE') = 0) then
  1429.             Result := Integer(Trunc(VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])))))
  1430.           else if (CompareText(S, 'TIME') = 0) then
  1431.           begin
  1432.             dt := VarToDateTime(EvaluteNodeValueComplex(PDBFExprNode(ANode^.FArgs.Items[0])));
  1433.             Result := dt - Trunc(dt);
  1434.           end;
  1435.           {(CompareText(S, 'SUM') = 0)
  1436.           (CompareText(S, 'MIN') = 0)
  1437.           (CompareText(S, 'MAX') = 0)
  1438.           (CompareText(S, 'AVG') = 0)
  1439.           (CompareText(S, 'COUNT') = 0)}
  1440.         end;
  1441.       else
  1442.         Result := Null;
  1443.       end;
  1444.     end;
  1445. begin
  1446.     Result := EvaluteNodeValueComplex(Root);
  1447. end;
  1448.  
  1449. function TVKDBFExprParser.Execute: Variant;
  1450. begin
  1451.   FValue := Null;
  1452.   if FLastRoot <> nil then
  1453.     FValue := Execute(FLastRoot);
  1454.   Result := FValue;
  1455. end;
  1456.  
  1457. function TVKDBFExprParser.EvaluteKey: String;
  1458. var
  1459.   sign: boolean;
  1460.   vType: Integer;
  1461.   i64: Int64;
  1462. begin
  1463.   FValue := Null;
  1464.   if FLastRoot <> nil then
  1465.     FValue := Execute(FLastRoot);
  1466.   vType := VarType(FValue);
  1467.     {$IFDEF VER130}
  1468.   if (vType = 14) then begin
  1469.     i64 := Decimal(FValue).lo64;
  1470.     {$ENDIF}
  1471.     {$IFDEF VER140}
  1472.   if (vType = varInt64) then begin
  1473.     i64 := FValue;
  1474.     {$ENDIF}
  1475.     if i64 >= 0 then
  1476.       sign := false
  1477.     else begin
  1478.       sign := true;
  1479.       i64 := -i64;
  1480.     end;
  1481.     FmtStr(Result, '%d', [i64]);
  1482.     Result := StringOfChar('0', FLastRoot.FDataLen - Length(Result)) + Result;
  1483.     if sign then
  1484.       ReplSign(Result);
  1485.   end else if (vType in [varDouble, varInteger, varSmallint, varSingle, varCurrency] ) then begin
  1486.     if FValue >= 0 then
  1487.       sign := false
  1488.     else begin
  1489.       sign := true;
  1490.       FValue := -FValue;
  1491.     end;
  1492.     // use $U- for escape GPF
  1493.     Str(FValue:FLastRoot.FDataLen:FLastRoot.FDataPrec, Result);
  1494.     //
  1495.     ReplBlanks(Result);
  1496.     if sign then
  1497.       ReplSign(Result);
  1498.   end else if (vType = varBoolean) then begin
  1499.     if FValue then
  1500.       Result := 'T'
  1501.     else
  1502.       Result := 'F';
  1503.   end else if (vType = varDate) then begin
  1504.     case FLastRoot.FDataType of
  1505.       ftDate: Result := DtoS(VarToDateTime(FValue));
  1506.       ftTime: Result := TtoS(VarToDateTime(FValue));
  1507.       ftDateTime: Result := DTtoS(VarToDateTime(FValue));
  1508.     else
  1509.       Result := DtoS(VarToDateTime(FValue))
  1510.     end;
  1511.   end else if ((vType = varEmpty) or (vType = varNull)) then begin
  1512.     Result := StringOfChar(FFC, FLastRoot.FDataLen);
  1513.   end else
  1514.     Result := VarToStr(FValue);
  1515.   FKey := Result;
  1516. end;
  1517.  
  1518. function TVKDBFExprParser.SuiteFieldList(fl: String; out m: Integer): Integer;
  1519. var
  1520.   fs, fn: String;
  1521.   fc: Integer;
  1522.   q: boolean;
  1523.  
  1524.   procedure SuiteFieldListInternal(ANode: PDBFExprNode);
  1525.   var
  1526.     i: Integer;
  1527.   begin
  1528.     case ANode^.FKind of
  1529.     enField:
  1530.       begin
  1531.         Inc(m);
  1532.         if not q then begin
  1533.           fn := UpperCase((ANode^.FField).FieldName);
  1534.           if Pos(fn, fs) <> 0 then
  1535.             Inc(fc)
  1536.           else
  1537.             q := true;
  1538.         end;
  1539.       end;
  1540.     enOperator, enFunc:
  1541.       begin
  1542.         if ANode^.FLeft <> nil then
  1543.           SuiteFieldListInternal(ANode^.FLeft);
  1544.         if ANode^.FRight <> nil then
  1545.           SuiteFieldListInternal(ANode^.FRight);
  1546.         if ANode^.FArgs <> nil then
  1547.           for i := 0 to ANode^.FArgs.Count - 1 do
  1548.             if ANode^.FArgs.Items[i] <> nil then
  1549.               SuiteFieldListInternal(PDBFExprNode(ANode^.FArgs.Items[i]));
  1550.       end;
  1551.     end;
  1552.   end;
  1553.  
  1554. begin
  1555.   fs := UpperCase(fl);
  1556.   fc := 0;
  1557.   m := 0;
  1558.   q := false;
  1559.   if FLastRoot <> nil then SuiteFieldListInternal(FLastRoot);
  1560.   Result := fc;
  1561. end;
  1562.  
  1563. function TVKDBFExprParser.EvaluteKey(const KeyFields: string;
  1564.   const KeyValues: Variant; const CF: Char = #$20): String;
  1565. begin
  1566.   if CF <> #$20 then FFC := CF;
  1567.   FFields := TList.Create;
  1568.   FKeyValues := KeyValues;
  1569.   FKeyFromValues := true;
  1570.   try
  1571.     FDataSet.GetFieldList(FFields, KeyFields);
  1572.     Result := EvaluteKey;
  1573.   finally
  1574.     FKeyFromValues := false;
  1575.     FFC := #$20;
  1576.     FFields.Free;
  1577.     FFields := nil;
  1578.   end;
  1579. end;
  1580.  
  1581. function TVKDBFExprParser.GetDataLen: Integer;
  1582. begin
  1583.   Result := FLastRoot.FDataLen;
  1584. end;
  1585.  
  1586. function TVKDBFExprParser.GetDataPrec: Integer;
  1587. begin
  1588.   Result := FLastRoot.FDataPrec;
  1589. end;
  1590.  
  1591. function TVKDBFExprParser.GetFieldList: String;
  1592. var
  1593.   lResult: String;
  1594.  
  1595.   procedure GetFieldListInternal(ANode: PDBFExprNode);
  1596.   var
  1597.     i: Integer;
  1598.   begin
  1599.     case ANode^.FKind of
  1600.     enField: lResult := lResult + UpperCase((ANode^.FField).FieldName) + ';';
  1601.     enOperator, enFunc:
  1602.       begin
  1603.         if ANode^.FLeft <> nil then
  1604.           GetFieldListInternal(ANode^.FLeft);
  1605.         if ANode^.FRight <> nil then
  1606.           GetFieldListInternal(ANode^.FRight);
  1607.         if ANode^.FArgs <> nil then
  1608.           for i := 0 to ANode^.FArgs.Count - 1 do
  1609.             if ANode^.FArgs.Items[i] <> nil then
  1610.               GetFieldListInternal(PDBFExprNode(ANode^.FArgs.Items[i]));
  1611.       end;
  1612.     end;
  1613.   end;
  1614.  
  1615. begin
  1616.   lResult := '';
  1617.   if FLastRoot <> nil then GetFieldListInternal(FLastRoot);
  1618.   Result := lResult;
  1619. end;
  1620.  
  1621. end.
  1622.