vg2canexpr.pas

Midas.dll全部源码

    nodeLISTELEM:
      begin
        if not VarIsArray(FOpList) then
          FOpList := VarArrayCreate([0, 9], varVariant);
        I := 0;
        repeat
          if I > VarArrayHighBound(FOpList, 1) then
             VarArrayRedim(FOpList, I + 10);

          with pCanListElem(CanHdr)^ do
          begin
            FOpList[I] := VarArrayOf([GetOperandValue(iOffset, iFldType1, iFldLen1), iFldType1, iFldLen1]);
            if iNextOffset = 0 then
            begin
              VarArrayRedim(FOpList, I);
              Result := FOpList;
              SetResult(fldUNKNOWN, 0);
              Exit;
            end;
            CanHdr := pCanHdr(PChar(FExpr) + SizeOf(CanExpr) + iNextOffset);
            Inc(I);
          end;
        until False;
      end;
    else
      NotSupported;
  end;
end;

function Tvg2ExprEvaluator.GetConstantValue(DataType, Size, Offset: Word; var iFldType, iFldLen: Integer): Variant;

  procedure SetResult(FldType, FldLen: Integer);
  begin
    iFldType := FldType;
    iFldLen  := FldLen;
  end;

type
  PSmallint = ^Smallint;
  PInteger  = ^Integer;
  PWordBool = ^WordBool;
var
  CanHdr: pCanHdr;
  S: string;
    TS:TTimeStamp;
begin
  CanHdr := pCanHdr(PChar(FExpr) + FExpr.iLiteralStart + Offset);

  case DataType of
    fldINT16, fldUINT16:
      begin
        Result := VarAsType(PSmallint(CanHdr)^, varSmallint);
        SetResult(DataType, SizeOf(SmallInt));
      end;
    fldINT32:
      begin
        Result := VarAsType(PInteger(CanHdr)^, varInteger);
        SetResult(DataType, SizeOf(Integer));
      end;
    fldFLOAT:
      begin
        Result := Double(CanHdr^);
        SetResult(DataType, SizeOf(Double));
      end;
    fldZSTRING:
      begin
        Result := StrPas(PChar(CanHdr));
        SetResult(DataType, Length(Result) + 1);
      end;
    fldDATE:
      begin
        TS.Date :=CanHdr^.nodeClass;
        TS.Time:=0;
        Result :=TimeStampToDateTime(ts);
        SetResult(fldTIMESTAMP, SizeOf(TDateTime));
      end;
    fldTIME:
      begin
        TS.Date :=$000A955A;
        TS.Time:=CanHdr^.nodeClass;
        Result :=TimeStampToDateTime(ts);
        SetResult(fldTIMESTAMP, SizeOf(TDateTime));
      end;
    fldTIMESTAMP://fldDATE, fldTIME, fldTIMESTAMP:
      begin
        Result := VarAsType(TDateTime(CanHdr^), varDate);
         SetResult(fldTIMESTAMP, SizeOf(TDateTime));
      end;
    fldBOOL:
      begin
        Result := VarAsType(PWordBool(CanHdr)^, varBoolean);
        SetResult(fldBOOL, SizeOf(WordBool));
      end;
    fldBCD:
      begin
        SetString(S, PChar(CanHdr), SizeOf(FMTBCD));
        Result := S;
        SetResult(fldBCD, SizeOf(FMTBCD));
      end;
    else
      NotSupported;
  end;
end;

function Tvg2ExprEvaluator.GetFieldValue(FieldNo, Offset: Word; var iFldType, iFldLen: Integer): Variant;
var
  FieldName:PChar;
begin
  FieldName := PChar(FExpr) + FExpr.iLiteralStart + Offset;
  Result := DoGetFieldValue(FieldNo, StrPas(FieldName), iFldType, iFldLen);
end;

function Tvg2ExprEvaluator.GetFuncValueInternal(Func: TEvalFunction; Args: Variant; var iFldType, iFldLen: Integer): Variant;

  procedure SetResult(FldType, FldLen: Integer);
  begin
    iFldType := FldType;
    iFldLen  := FldLen;
  end;

  procedure SetResultStr(Arg: Variant);
  var
    iFieldType: Integer;
  begin
    iFieldType := Arg[1];
    if iFieldType = fldZSTRING then
      SetResult(fldZSTRING, Arg[2]) else
      SetResult(fldZSTRING, NumericLen);
  end;

var
  Tmp: Variant;
  S: string;
  Year, Month, Day: Word;
  Hour, Min, Sec, MSec: Word;
  Start, Count: Integer;
  TimeStamp: TDateTime;
begin
  case Func of
    efUpper, efLower:
      begin
        Tmp := Args[0][0];
        SetResultStr(Args[0]);
        if VarIsNull(Tmp) then
          Result := Null
        else begin
          S := Tmp;
          if Func = efUpper then
            Result := AnsiUpperCase(S) else
            Result := AnsiLowerCase(S);
        end;
      end;
    efSubString:
      begin
        Tmp := Args[0][0];
        SetResultStr(Args[0]);
        if VarIsNull(Tmp) then
          Result := Null
        else begin
          Start  := Args[1][0];
          Count  := Args[2][0];
          Result := Copy(S, Start, Count);
        end;
      end;
    efTrim, efTrimLeft, efTrimRight:
      begin
        Tmp := Args[0][0];
        SetResultStr(Args[0]);
        if VarIsNull(Tmp) then
          Result := Null
        else begin
          S := Tmp;
          if Func = efTrim then
            Result := Trim(S)
          else if Func = efTrimLeft then
            Result := TrimLeft(S)
          else
            Result := TrimRight(S);
        end;
      end;
    efYear, efMonth, efDay:
      begin
        if VarIsNull(Args) then
          TimeStamp := Date else
          TimeStamp := Args[0][0];
        DecodeDate(TimeStamp, Year, Month, Day);
        SetResult(fldUINT16, SizeOf(Word));
        if Func = efYear then
          Result := Year
        else if Func = efMonth then
          Result := Month
        else
          Result := Day;
      end;
    efHour, efMinute, efSecond:
      begin
        if VarIsNull(Args) then
          TimeStamp := Time else
          TimeStamp := Args[0][0];
        DecodeTime(TimeStamp, Hour, Min, Sec, MSec);
        SetResult(fldUINT16, SizeOf(Word));
        if Func = efHour then
          Result := Hour
        else if Func = efMinute then
          Result := Min
        else
          Result := Sec;
      end;
    efGetDate:
      begin
        Result := Now;
        SetResult(fldTIMESTAMP, SizeOf(TDateTime));
      end;
    efDate,efTime:
         begin
           SetResult(fldTIMESTAMP, SizeOf(TDateTime));
          Tmp := Args[0][0];
           if VarIsNull(Tmp) then
              Result := Null
           else
               begin
                    if Func=efDate then
                        TimeStamp :=int(tmp)
                    else
                        TimeStamp := Frac(tmp);
                    Result := TDateTime(TimeStamp);
               end;
         end;
    efIIF:
      begin
           SetResult(fldBOOL, SizeOf(WordBool));
           tmp:=Args[0][0];
           if VarIsNull(Tmp) then
              Result := Null
           else
              begin
                   if Boolean(Tmp) then
                      Result :=Args[1][0]
                   else
                       Result :=Args[2][0];
              end;
      end;
  end;
end;

function Tvg2ExprEvaluator.GetFuncValue(Func: TEvalFunction; Offset: Word;
  var iFldType, iFldLen: Integer): Variant;

  procedure SetResult(FldType, FldLen: Integer);
  begin
    iFldType := FldType;
    iFldLen  := FldLen;
  end;

  function GetOperand: Variant;
  var
    iFldType1, iFldLen1: Integer;
  begin
    if Offset > 0 then
      Result := GetOperandValue(Offset, iFldType1, iFldLen1) else
      Result := VarArrayOf([Null, fldUNKNOWN, 0]);
  end;

var
  Sum: Double;
  Count, Cmp: Integer;
  Tmp, Tmp2: Variant;
  BCD: FMTBCD;
  S: string;
begin
  if Func in efAggregates then DoBeginAgg;
  try
    case Func of
      efUnknown:
        NotSupported;

      efSum:
        begin
          Sum    := 0;
          DoFirst;
          Tmp    := GetOperand[0];
          SetResult(Tmp[1], Tmp[2]);
          Tmp2 := Tmp[0];
          if iFldType = fldBCD then
          begin
            if VarIsNull(Tmp2) then
            begin
              SetZeroBcd(BCD);
              SetString(S, PChar(@BCD), SizeOf(FMTBCD));
              Result := S;
            end else
              Result := Tmp2
          end else begin
            if not VarIsNull(Tmp2) then
              Result := Tmp2 else
              Result := Sum;
          end;
          DoNext;
          while not DoGetEOF do
          begin
            Tmp := GetOperand[0][0];
            if not VarIsNull(Tmp) then
            begin
              if iFldType = fldBCD then
              begin
                BCD := AddFMTBCD(pFMTBCD(TVarData(Result).VString)^, pFMTBCD(TVarData(Tmp).VString)^);
                SetString(S, PChar(@BCD), SizeOf(FMTBCD));
                Result := S;
              end else
                Result := Result + Tmp;
            end;
            DoNext;
          end;
        end;

      efMin, efMax:
        begin
          DoFirst;
          Tmp    := GetOperand[0];
          Result := Tmp[0];
          SetResult(Tmp[1], Tmp[2]);
          DoNext;
          while not DoGetEOF do
          begin
            Tmp := GetOperand[0][0];
            Cmp := CompareOperandsEx2(Result, Tmp, iFldType, iFldLen, iFldType, iFldLen);
            if (Func = efMin) and (Cmp > 0) or (Func = efMax) and (Cmp < 0) then
              Result := Tmp;
            DoNext;
          end;
        end;

      efAvg:
        begin
          Sum   := 0;
          Count := 0;
          DoFirst;
          while not DoGetEOF do
          begin
            Tmp := GetOperand[0][0];
            CheckNotBCD(Tmp, iFldType, iFldLen);
            Sum := Sum + Tmp;
            Inc(Count);
            DoNext;
          end;
          if Count > 0 then
            Result := Sum / Count;
          SetResult(fldFLOAT, SizeOf(Double));
        end;

      efCount:
        begin
          Count := 0;
          DoFirst;
          while not DoGetEOF do
          begin
            Inc(Count);
            DoNext;
          end;
          Result := Count;
          SetResult(fldINT32, SizeOf(Integer));
        end;

      Succ(efCount)..High(TEvalFunction):
        Result := GetFuncValueInternal(Func, GetOperand, iFldType, iFldLen);
    end;
  finally
    if Func in efAggregates then DoEndAgg;
  end;
end;

function Tvg2ExprEvaluator.DoGetFieldValue(FieldNo: Word; const FieldName: string;
  var iFldType, iFldLen: Integer): Variant;
begin
  Result   := Null;
  iFldType := fldUNKNOWN;
  iFldLen  := 0;
end;

procedure Tvg2ExprEvaluator.DoFirst;
begin
end;

procedure Tvg2ExprEvaluator.DoNext;
begin
end;

function Tvg2ExprEvaluator.DoGetEOF: Boolean;
begin
  Result := True;
end;

procedure Tvg2ExprEvaluator.DoBeginEvaluate;
begin
end;

procedure Tvg2ExprEvaluator.DoEndEvaluate;
begin
end;

procedure Tvg2ExprEvaluator.DoBeginAgg;
begin
end;

procedure Tvg2ExprEvaluator.DoEndAgg;
begin
end;

end.