dbcommon.pas

这是不可多得的源代码

    FNodes := Node^.FNext;
    if (Node^.FKind = enFunc) and (Node^.FArgs <> nil) then
      Node^.FArgs.Free;
    Dispose(Node);
  end;
end;

function TFilterExpr.FieldFromNode(Node: PExprNode): TField;
begin
  Result := GetFieldByName(Node^.FData);
  if not (Result.FieldKind in [fkData, fkInternalCalc]) then
    DatabaseErrorFmt(SExprBadField, [Result.FieldName]);
end;

function TFilterExpr.GetExprData(Pos, Size: Integer): PChar;
begin
  SetLength(FExprBuffer, FExprBufSize + Size);
  Move(FExprBuffer[Pos], FExprBuffer[Pos + Size], FExprBufSize - Pos);
  Inc(FExprBufSize, Size);
  Result := PChar(FExprBuffer) + Pos;
end;

function TFilterExpr.GetFilterData(Root: PExprNode): TExprData;
begin
  FExprBufSize := CANExprSize;
  SetLength(FExprBuffer, FExprBufSize);
  PutExprNode(Root, coNOTDEFINED);
  PWord(@FExprBuffer[0])^ := CANEXPRVERSION;                { iVer }
  PWord(@FExprBuffer[2])^ := FExprBufSize;                  { iTotalSize }
  PWord(@FExprBuffer[4])^ := $FFFF;                         { iNodes }
  PWord(@FExprBuffer[6])^ := CANEXPRSIZE;                   { iNodeStart }
  PWord(@FExprBuffer[8])^ := FExprNodeSize + CANEXPRSIZE;   { iLiteralStart }
  Result := FExprBuffer;
end;

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

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

function TFilterExpr.PutConstBCD(const Value: Variant;
  Decimals: Integer): Integer;
var
  C: Currency;
  BCD: TBcd;
begin
  if VarType(Value) = varString then
    C := StrToCurr(string(TVarData(Value).VString)) else
    C := Value;
  CurrToBCD(C, BCD, 32, Decimals);
  Result := PutConstNode(ftBCD, @BCD, 18);
end;

function TFilterExpr.PutConstFMTBCD(const Value: Variant;
  Decimals: Integer): Integer;
var
  BCD: TBcd;
begin
  if VarType(Value) = varString then
    BCD := StrToBcd(string(TVarData(Value).VString)) else
    BCD := VarToBcd(Value);
  Result := PutConstNode(ftBCD, @BCD, 18);
end;

function TFilterExpr.PutConstBool(const Value: Variant): Integer;
var
  B: WordBool;
begin
  B := Value;
  Result := PutConstNode(ftBoolean, @B, SizeOf(WordBool));
end;

function TFilterExpr.PutConstDate(const Value: Variant): Integer;
var
  DateTime: TDateTime;
  TimeStamp: TTimeStamp;
begin
  if VarType(Value) = varString then
    DateTime := StrToDate(string(TVarData(Value).VString)) else
    DateTime := VarToDateTime(Value);
  TimeStamp := DateTimeToTimeStamp(DateTime);
  Result := PutConstNode(ftDate, @TimeStamp.Date, 4);
end;

function TFilterExpr.PutConstDateTime(const Value: Variant): Integer;
var
  DateTime: TDateTime;
  DateData: Double;
begin
  if VarType(Value) = varString then
    DateTime := StrToDateTime(string(TVarData(Value).VString)) else
    DateTime := VarToDateTime(Value);
  DateData := TimeStampToMSecs(DateTimeToTimeStamp(DateTime));
  Result := PutConstNode(ftDateTime, @DateData, 8);
end;

function TFilterExpr.PutConstSQLTimeStamp(const Value: Variant): Integer;
var
  TimeStamp: TSQLTimeStamp;
begin
  if VarType(Value) = varString then
    TimeStamp := StrToSQLTimeStamp(string(TVarData(Value).VString)) else
    TimeStamp := VarToSQLTimeStamp(Value);
  Result := PutConstNode(ftTimeStamp, @TimeStamp, 16);
end;

function TFilterExpr.PutConstFloat(const Value: Variant): Integer;
var
  F: Double;
begin
  if VarType(Value) = varString then
    F := StrToFloat(string(TVarData(Value).VString)) else
    F := Value;
  Result := PutConstNode(ftFloat, @F, SizeOf(Double));
end;

function TFilterExpr.PutConstInt(DataType: TFieldType;
  const Value: Variant): Integer;
var
  I, Size: Integer;
begin
  if VarType(Value) = varString then
    I := StrToInt(string(TVarData(Value).VString)) else
    I := Value;
  Size := 2;
  case DataType of
    ftSmallint:
      if (I < -32768) or (I > 32767) then DatabaseError(SExprRangeError);
    ftWord:
      if (I < 0) or (I > 65535) then DatabaseError(SExprRangeError);
  else
    Size := 4;
  end;
  Result := PutConstNode(DataType, @I, Size);
end;

function TFilterExpr.PutConstNode(DataType: TFieldType; Data: PChar;
  Size: Integer): Integer;
begin
  Result := PutNode(nodeCONST, coCONST2, 3);
  SetNodeOp(Result, 0, FFieldMap[DataType]);
  SetNodeOp(Result, 1, Size);
  SetNodeOp(Result, 2, PutData(Data, Size));
end;

function TFilterExpr.PutConstStr(const Value: string): Integer;
var
  Str: string;
  Buffer: array[0..255] of Char;
begin
  if Length(Value) >= SizeOf(Buffer) then
    Str := Copy(Value, 1, SizeOf(Buffer) - 1) else
    Str := Value;
  FDataSet.Translate(PChar(Str), Buffer, True);
  Result := PutConstNode(ftString, Buffer, Length(Str) + 1);
end;

function TFilterExpr.PutConstTime(const Value: Variant): Integer;
var
  DateTime: TDateTime;
  TimeStamp: TTimeStamp;
begin
  if VarType(Value) = varString then
    DateTime := StrToTime(string(TVarData(Value).VString)) else
    DateTime := VarToDateTime(Value);
  TimeStamp := DateTimeToTimeStamp(DateTime);
  Result := PutConstNode(ftTime, @TimeStamp.Time, 4);
end;

function TFilterExpr.PutData(Data: PChar; Size: Integer): Integer;
begin
  Move(Data^, GetExprData(FExprBufSize, Size)^, Size);
  Result := FExprDataSize;
  Inc(FExprDataSize, Size);
end;

function TFilterExpr.PutConstant(Node: PExprNode): Integer;
begin
  Result := 0;
  case Node^.FDataType of
    ftSmallInt, ftInteger, ftWord, ftAutoInc:
      Result := PutConstInt(Node^.FDataType, Node^.FData);
    ftFloat, ftCurrency:
      Result := PutConstFloat(Node^.FData);
    ftString, ftWideString, ftFixedChar, ftGuid:
      Result := PutConstStr(Node^.FData);
    ftDate:
      Result := PutConstDate(Node^.FData);
    ftTime:
      Result := PutConstTime(Node^.FData);
    ftDateTime:
      Result := PutConstDateTime(Node^.FData);
    ftTimeStamp:
      Result := PutConstSQLTimeStamp(Node^.FData);
    ftBoolean:
      Result := PutConstBool(Node^.FData);
    ftBCD:
      Result := PutConstBCD(Node^.FData, Node^.FDataSize);
    ftFMTBcd:
      Result := PutConstFMTBCD(Node^.FData, Node^.FDataSize);
    else
      DatabaseErrorFmt(SExprBadConst, [Node^.FData]);
  end;
end;

function TFilterExpr.PutExprNode(Node: PExprNode; ParentOp: TCANOperator): Integer;
const
  ReverseOperator: array[coEQ..coLE] of TCANOperator = (coEQ, coNE, coLT,
    coGT, coLE, coGE);
  BoolFalse: WordBool = False;
var
  Field: TField;
  Left, Right, Temp : PExprNode;
  LeftPos, RightPos, ListElem, PrevListElem, I: Integer;
  Operator: TCANOperator;
  CaseInsensitive, PartialLength, L:  Integer;
  S: string;
begin
  Result := 0;
  case Node^.FKind of
    enField:
      begin
        Field := FieldFromNode(Node);
        if (ParentOp in [coOR, coNOT, coAND, coNOTDEFINED]) and
           (Field.DataType = ftBoolean) then
        begin
          Result := PutNode(nodeBINARY, coNE, 2);
          SetNodeOp(Result, 0, PutFieldNode(Field, Node));
          SetNodeOp(Result, 1, PutConstNode(ftBoolean, @BoolFalse, SizeOf(WordBool)));
        end
        else
          Result := PutFieldNode(Field, Node);
      end;
    enConst:
      Result := PutConstant(Node);
    enOperator:
      case Node^.FOperator of
        coIN:
          begin
            Result := PutNode(nodeBINARY, coIN, 2);
            SetNodeOp(Result, 0, PutExprNode(Node^.FLeft,Node^.FOperator));
            ListElem := PutNode(nodeLISTELEM, coLISTELEM2, 2);
            SetNodeOp(Result, 1, ListElem);
            PrevListElem := ListElem;
            for I := 0 to Node^.FArgs.Count - 1 do 
            begin
              LeftPos := PutExprNode(Node^.FArgs.Items[I],Node^.FOperator);
              if I = 0 then 
                begin
                  SetNodeOp(PrevListElem, 0, LeftPos);
                  SetNodeOp(PrevListElem, 1, 0);
                end
              else
                begin
                  ListElem := PutNode(nodeLISTELEM, coLISTELEM2, 2);
                  SetNodeOp(ListElem, 0, LeftPos);
                  SetNodeOp(ListElem, 1, 0);
                  SetNodeOp(PrevListElem, 1, ListElem);
                  PrevListElem := ListElem;
                end;
              end;
          end;
        coNOT,
        coISBLANK,
        coNOTBLANK:
          begin
            Result := PutNode(nodeUNARY, Node^.FOperator, 1);
            SetNodeOp(Result, 0, PutExprNode(Node^.FLeft,Node^.FOperator));
          end;
        coEQ..coLE,
        coAND,coOR,
        coADD..coDIV,
        coLIKE,
        coASSIGN:
          begin
            Operator := Node^.FOperator;
            Left := Node^.FLeft;
            Right := Node^.FRight;
            if (Operator in [coEQ..coLE]) and (Right^.FKind = enField) and
               (Left^.FKind <> enField) then
            begin
              Temp := Left;
              Left := Right;
              Right := Temp;
              Operator := ReverseOperator[Operator];
            end;

            Result := 0;
            if (Left^.FKind = enField) and (Right^.FKind = enConst)
               and ((Node^.FOperator = coEQ)  or (Node^.FOperator = coNE)
               or (Node^.FOperator = coLIKE)) then
            begin
              if VarIsNull(Right^.FData) then
              begin
                case Node^.FOperator of
                  coEQ: Operator := coISBLANK;
                  coNE: Operator := coNOTBLANK;
                else
                  DatabaseError(SExprBadNullTest);
                end;
                Result := PutNode(nodeUNARY, Operator, 1);
                SetNodeOp(Result, 0, PutExprNode(Left,Node^.FOperator));
              end
              else if (Right^.FDataType in StringFieldTypes) then
              begin
                S := Right^.FData;
                L := Length(S);
                if L <> 0 then
                begin
                  CaseInsensitive := 0;
                  PartialLength := 0;
                  if foCaseInsensitive in FOptions then CaseInsensitive := 1;
                  if Node^.FPartial then PartialLength := L else
                    if not (foNoPartialCompare in FOptions) and (L > 1) and
                      (S[L] = '*') then
                    begin
                      Delete(S, L, 1);
                      PartialLength := L - 1;
                    end;
                  if (CaseInsensitive <> 0) or (PartialLength <> 0) then
                  begin
                    Result := PutNode(nodeCOMPARE, Operator, 4);
                    SetNodeOp(Result, 0, CaseInsensitive);
                    SetNodeOp(Result, 1, PartialLength);
                    SetNodeOp(Result, 2, PutExprNode(Left,Node^.FOperator));
                    SetNodeOp(Result, 3, PutConstStr(S));
                  end;
                end;
              end;
            end;

            if Result = 0 then
            begin
              if (Operator = coISBLANK) or (Operator = coNOTBLANK) then
              begin
                Result := PutNode(nodeUNARY, Operator, 1);
                LeftPos := PutExprNode(Left,Node^.FOperator);
                SetNodeOp(Result, 0, LeftPos);
              end else
              begin
                Result := PutNode(nodeBINARY, Operator, 2);
                LeftPos := PutExprNode(Left,Node^.FOperator);
                RightPos := PutExprNode(Right,Node^.FOperator);
                SetNodeOp(Result, 0, LeftPos);
                SetNodeOp(Result, 1, RightPos);
              end;
            end;
          end;
      end;
    enFunc:
      begin
        Result := PutNode(nodeFUNC, coFUNC2, 2);
        SetNodeOp(Result, 0,  PutData(PChar(string(Node^.FData)),
          Length(string(Node^.FData)) + 1));
        if Node^.FArgs <> nil then
        begin
          ListElem := PutNode(nodeLISTELEM, coLISTELEM2, 2);
          SetNodeOp(Result, 1, ListElem);
          PrevListElem := ListElem;
          for I := 0 to Node^.FArgs.Count - 1 do
          begin
            LeftPos := PutExprNode(Node^.FArgs.Items[I],Node^.FOperator);
            if I = 0 then
            begin
              SetNodeOp(PrevListElem, 0, LeftPos);
              SetNodeOp(PrevListElem, 1, 0);
            end