dbparsers.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

            coAND:
              Result := WordBool(ParseNode(pfdStart, pArg1)) and WordBool(ParseNode(pfdStart, pArg2));
            coADD:
              Result := ParseNode(pfdStart, pArg1) + ParseNode(pfdStart, pArg2);
            coSUB:
              Result := ParseNode(pfdStart, pArg1) - ParseNode(pfdStart, pArg2);
            coMUL:
              Result := ParseNode(pfdStart, pArg1) * ParseNode(pfdStart,pArg2);
            coDIV:
              Result := ParseNode(pfdStart,pArg1) / ParseNode(pfdStart,pArg2);
            coMOD,coREM:
              Result := ParseNode(pfdStart,pArg1) mod ParseNode(pfdStart,pArg2);
            coIN:
              begin
                Arg1 := ParseNode(PfdStart, pArg1);
                Arg2 := ParseNode(PfdStart, pArg2);
                if VarIsArray(Arg2) then
                begin
                  Result := False;
                  AD:=VarArrayHighBound(Arg2, 1);
                  for I:=0 to AD do
                  begin
                    if VarIsEmpty(Arg2[I]) then break;
                    Result := (Arg1 = Arg2[I]);
                    if Result then break;
                  end;
                end
                else
                  Result := (Arg1 = Arg2);
              end;
            coLike:
              if Assigned(FMatchesMask) then
               Result :=
                FMatchesMask(
                  VarToStr(ParseNode(pfdStart, pArg1)),
                  VarToStr(ParseNode(pfdStart, pArg2))
                )
              else
               DatabaseError(SExprIncorrect);
          else
              DatabaseError(SExprIncorrect);
          end;
        end;
      nodeCOMPARE:
        begin
          IgnoreCase := PWord(@pfd[0])^;
          PartLength := PWord(@pfd[2])^;
          pArg1 := pfdStart + CANEXPRSIZE + PWord(@pfd[4])^;
          pArg2 := pfdStart + CANEXPRSIZE + PWord(@pfd[6])^;

          S1 := ParseNode(pfdStart, pArg1);
          S2 := ParseNode(pfdStart, pArg2);
          null1:=VarIsNull(S1);
          null2:=VarIsNull(S2);
          if (null1 <> null2) then
          begin
           Result :=iOperator=coNE;
           Exit;
          end
          else
          if null1 then
          begin
           Result :=iOperator<>coNE;
           Exit;
          end ;
          if IgnoreCase <> 0 then
          begin
            S1 := AnsiUpperCase(S1);
            S2 := AnsiUpperCase(S2);
          end;
          if (PartLength > 0) and (iOperator<>coLIKE) then
          begin
            S1 := FastCopy(S1, 1, PartLength);
            S2 := FastCopy(S2, 1, PartLength);
          end;
          case iOperator of
            coEQ:
              Result := S1 = S2;
            coNE:
              Result := S1 <> S2;
            coLIKE:
             if Assigned(FMatchesMask) then
              Result := FMatchesMask(S1, S2)
             else
              DatabaseError(SExprIncorrect)
          else
              DatabaseError(SExprIncorrect);
          end;
        end;
      nodeFUNC:
        case iOperator of
          coFUNC2:
            begin
              pArg1 := pfdStart;
              Inc(pArg1, iLiteralStart + PWord(@pfd[0])^);
              S :=AnsiUpperCase(pArg1);
              if Length(S) = 0 then
                DatabaseErrorFmt(SExprExpected, [S]);

              pArg2 := pfdStart;
              Inc(pArg2, CANEXPRSIZE + PWord(@pfd[2])^);
             case S[1] of    //
                'D':if S = 'DAY' then
                    begin
                      DecodeDate(VarToDateTime(ParseNode(pfdStart, pArg2)), Year, Mon, Day);
                      Result := Day;
                    end
                    else
                    if S = 'DATE' then
                    begin
                      Result := ParseNode(pfdStart, pArg2);
                      if VarIsArray(Result) then
                       if Assigned(FStrToDateFmt) then
                        Result := FStrToDateFmt(VarToStr(Result[1]), VarToStr(Result[0]))
                       else
                        DatabaseError(SExprIncorrect)
                      else
                        Result := Integer(Trunc(VarToDateTime(Result)));
                    end
                    else
                      DatabaseErrorFmt(SExprExpected, [S]);
                'G': if S = 'GETDATE' then  Result := Now
                     else
                      DatabaseErrorFmt(SExprExpected, [S]);
                'H':if S = 'HOUR' then
                    begin
                     DecodeTime(VarToDateTime(ParseNode(pfdStart, pArg2)), Hour, Min, Sec, MSec);
                     Result := Hour;
                    end
                    else
                     DatabaseErrorFmt(SExprExpected, [S]);
                'M':if S = 'MONTH' then
                    begin
                      DecodeDate(VarToDateTime(ParseNode(pfdStart, pArg2)), Year, Mon, Day);
                      Result := Mon;
                    end
                    else
                    if S = 'MINUTE' then
                    begin
                      DecodeTime(VarToDateTime(ParseNode(pfdStart, pArg2)), Hour, Min, Sec, MSec);
                      Result := Min;
                    end
                    else
                     DatabaseErrorFmt(SExprExpected, [S]);
                'U': if S = 'UPPER' then
                      Result := AnsiUpperCase(VarToStr(ParseNode(pfdStart, pArg2)))
                     else
                      DatabaseErrorFmt(SExprExpected, [S]);
                'L': if S = 'LOWER' then
                      Result := AnsiLowerCase(VarToStr(ParseNode(pfdStart, pArg2)))
                     else
                      DatabaseErrorFmt(SExprExpected, [S]);
                'Y': if S = 'YEAR' then
                     begin
                      DecodeDate(VarToDateTime(ParseNode(pfdStart, pArg2)), Year, Mon, Day);
                      Result := Year;
                     end
                     else
                      DatabaseErrorFmt(SExprExpected, [S]);
                'S': if S = 'SUBSTRING' then
                     begin
                      Result := ParseNode(pfdStart, pArg2);
                      if VarType(Result[1]) in [varSmallint,varInteger,varDouble,varSingle] then
                      begin
                       p :=Integer(Result[1]);
                       p1:=Integer(Result[2]);
                      end
                      else
                      begin
                       S:=VarToStr(Result[1]);
                       p:=PosCh(',',S);
                       p1:=0;
                       if p>0 then
                       begin
                         p1:=StrToInt(FastCopy(S,p+1,1000));
                         p :=StrToInt(FastCopy(S,1,p-1));
                       end
                       else
                        DatabaseErrorFmt(SExprExpected, [S]);
                      end;
                      Result := FastCopy(VarToStr(Result[0]), p, p1);
                     end
                     else
                     if S = 'SECOND' then
                     begin
                        DecodeTime(VarToDateTime(ParseNode(pfdStart, pArg2)), Hour, Min, Sec, MSec);
                        Result := Sec;
                     end
                     else
                      DatabaseErrorFmt(SExprExpected, [S]);
                'T':
                     case Length(S) of
                      4: if S = 'TRIM' then
                          Result := FastTrim(VarToStr(ParseNode(pfdStart, pArg2)))
                         else
                         DatabaseErrorFmt(SExprExpected, [S]);
                      8: if S = 'TRIMLEFT' then
                          Result := TrimLeft(VarToStr(ParseNode(pfdStart, pArg2)))
                         else
                          DatabaseErrorFmt(SExprExpected, [S]);
                      9: if S = 'TRIMRIGHT' then
                          Result := TrimRight(VarToStr(ParseNode(pfdStart, pArg2)))
                         else
                          DatabaseErrorFmt(SExprExpected, [S]);
                     end;

             else
                DatabaseErrorFmt(SExprExpected, [S]);
             end
            end
        else
            DatabaseError(SExprIncorrect);
        end;
      nodeLISTELEM:
        case iOperator of
          coLISTELEM2:
            begin
              Result := VarArrayCreate ([0, 50], VarVariant); // Create VarArray for ListElements Values
              pArg1 := pfdStart;
              Inc(pArg1, CANEXPRSIZE + PWord(@pfd[0])^);

              I := 0;
              repeat
                Arg1 := ParseNode(PfdStart, pArg1);
                if VarIsArray(Arg1) then
                begin
                  Z:=0;
                  while not VarIsEmpty(Arg1[Z]) do
                  begin
                    Result[I] := Arg1[Z];
                    Inc(I); Inc(Z);
                  end;
                end
                else
                begin
                  Result[I] := Arg1;
                  Inc(I);
                end;

                pArg1 := pfdStart;
                Inc(pArg1, CANEXPRSIZE + PWord(@pfd[I*2])^);
              until NODEClass(PInteger(@pArg1[0])^) <> NodeListElem;

              if I<2 then
                Result := VarAsType(Result[0], varString);
            end;
        else
            DatabaseError(SExprIncorrect);
        end;
    end;
  end;
var
  pfdStart, pfd: PAnsiChar;
begin
  pfdStart := @FilterData[0];
  pfd := pfdStart;
  iLiteralStart := PWord(@pfd[8])^;
  Inc(pfd, 10);
  Result := ParseNode(pfdStart, pfd);
end;
{$WARNINGS ON}
function TExpressionParser.BooleanResult: Boolean;
var
   V:Variant;
begin
  V:=VarResult;
  Result :=WordBool(V)
end;

procedure TExpressionParser.ResetFields;
begin
 FFilteredFields.Clear
end;

end.