TValueHelper.FromVariant, TFmtBcdVariant return type also needs to handle Floats

A while back we made a suggestion to fix an issue with Delphi XE5 and earlier where Oracle was returning TFmtBcdVariant types, and they were losing precision because of a bug in XE5.

Please see issue ~~#64~~ for the previous fix.

We have now run into an issue where the Bcd Type (which is really a decimal type) is also being used by Firedac to return floating point types and now the above fix fails as it tries to cast a floating point number to an int64

We have come up with a fix for this and wanted to present it to you, so that you might consider integrating it into the latest code.

From the Spring.pas unit see the following changed method.

class function TValueHelper.FromVariant(const value: Variant): TValue;
type
  TCustomVariantTypeInfo = record
    Name: string;
    VType: TVarType;
  end;
const
  CustomVariantTypes: array[0..2] of TCustomVariantTypeInfo = (
    (Name: 'SQLTimeStampVariantType'; VType: varDouble),
    (Name: 'SQLTimeStampOffsetVariantType'; VType: varDouble),
    (Name: 'FMTBcdVariantType'; VType: varUnknown)
  );
var
  typeName: string;
  i: Integer;
begin
  case TVarData(Value).VType of
    varEmpty, varNull: Exit(Empty);
    varBoolean: Result := TVarData(Value).VBoolean;
    varShortInt: Result := TVarData(Value).VShortInt;
    varSmallint: Result := TVarData(Value).VSmallInt;
    varInteger: Result := TVarData(Value).VInteger;
    varSingle: Result := TVarData(Value).VSingle;
    varDouble: Result := TVarData(Value).VDouble;
    varCurrency: Result := TVarData(Value).VCurrency;
    varDate: Result := From<TDateTime>(TVarData(Value).VDate);
    varOleStr: Result := string(TVarData(Value).VOleStr);
    varDispatch: Result := From<IDispatch>(IDispatch(TVarData(Value).VDispatch));
    varError: Result := From<HRESULT>(TVarData(Value).VError);
    varUnknown: Result := From<IInterface>(IInterface(TVarData(Value).VUnknown));
    varByte: Result := TVarData(Value).VByte;
    varWord: Result := TVarData(Value).VWord;
    varLongWord: Result := TVarData(Value).VLongWord;
    varInt64: Result := TVarData(Value).VInt64;
    varUInt64: Result := TVarData(Value).VUInt64;
{$IFNDEF NEXTGEN}
    varString: Result := string(AnsiString(TVarData(Value).VString));
{$ENDIF}
    varUString: Result := UnicodeString(TVarData(Value).VUString);
  else
    case TVarData(Value).VType and not varArray of
      varSmallint: Result := TValue.From<TArray<SmallInt>>(Value);
      varInteger: Result := TValue.From<TArray<Integer>>(Value);
      varSingle: Result := TValue.From<TArray<Single>>(Value);
      varDouble: Result := TValue.From<TArray<Double>>(Value);
      varCurrency: Result := TValue.From<TArray<Currency>>(Value);
      varDate: Result := TValue.From<TArray<TDateTime>>(Value);
      varOleStr: Result := TValue.From<TArray<string>>(Value);
      varDispatch: Result := TValue.From<TArray<IDispatch>>(Value);
      varError: Result := TValue.From<TArray<HRESULT>>(Value);
      varBoolean: Result := TValue.From<TArray<Boolean>>(Value);
      varVariant: Result := TValue.From<TArray<Variant>>(Value);
      varUnknown: Result := TValue.From<TArray<IInterface>>(Value);
      varShortInt: Result := TValue.From<TArray<ShortInt>>(Value);
      varByte: Result := TValue.From<TArray<Byte>>(Value);
      varWord: Result := TValue.From<TArray<Word>>(Value);
      varLongWord: Result := TValue.From<TArray<LongWord>>(Value);
      varInt64: Result := TValue.From<TArray<Int64>>(Value);
      varUInt64: Result := TValue.From<TArray<UInt64>>(Value);
      varUString: Result := TValue.From<TArray<string>>(Value);
    else
      typeName := VarTypeAsText(TVarData(Value).VType);
      for i := 0 to High(CustomVariantTypes) do
        if SameText(typeName, CustomVariantTypes[i].Name) then
        begin
          case CustomVariantTypes[i].VType of
            varDouble: Result := Double(Value);
            varUnknown: {FMTBcdVariantType}
            begin
              if BcdScale(VarToBcd(Value)) > 0 then
                Result := BcdToDouble(VarToBcd(Value))
              else
              begin
                Result := {$IFDEF DELPHIXE6_UP}Int64(Value);
                {$ELSE}StrToInt64(VarToStr(Value));{$ENDIF} // see QC#117696
              end;
            end
          else
            raise EVariantTypeCastError.CreateRes(@SInvalidVarCast);
          end;
          Exit;
        end;
      raise EVariantTypeCastError.CreateRes(@SInvalidVarCast);
    end;
  end;
end;

Also the dbrtl.dcp needs to be added to the Spring.base package, so that the compiler does not complain that Data.FmtBcd exists both in dbrtl.dcp and spring.base when compiling Spring.Persistence.

My apologies for not catching this earlier, and thanks for all your hard work on this project as always. Todd.

Comments (9)