varutils.pas

这是不可多得的源代码

            Result := VAR_BADVARTYPE;
          end;
      end;

      // if all is swell then copy over the VType
      if Result = VAR_OK then
        Dest.VType := Source.VType;
    end;
  end;
end;

function VariantCopyInd(var Dest: TVarData; const Source: TVarData): HRESULT;
begin
  if (Source.VType and varByRef) = 0 then // var is NOT byref, so just copy
    Result := VariantCopy(Dest, Source)
  else if (Source.VType and varArray) <> 0 then // var is an array, bad!
    Result := VAR_INVALIDARG
  else
  begin
    Result := VAR_OK;
    case (Source.VType and varTypeMask) of // strip off modifier flags
      varEmpty, varNull:;
        // do nothing
      varSmallint:
        Dest.VSmallInt := PSmallInt(Source.VPointer)^;
      varInteger:
        Dest.VInteger := PInteger(Source.VPointer)^;
      varSingle:
        Dest.VSingle := PSingle(Source.VPointer)^;
      varDouble:
        Dest.VDouble := PDouble(Source.VPointer)^;
      varCurrency:
        Dest.VCurrency := PCurrency(Source.VPointer)^;
      varDate:
        Dest.VDate := PDate(Source.VPointer)^;
      varOleStr:
        WideString(Pointer(Dest.VOleStr)) := Copy(PPWideChar(Source.VPointer)^, 1, MaxInt);
      varDispatch:
        IUnknown(Dest.VDispatch) := IUnknown(PDispatch(Source.VPointer)^);
      varError:
        Dest.VError := System.PError(Source.VPointer)^;
      varBoolean:
        Dest.VBoolean := PWordBool(Source.VPointer)^;
      varVariant:
        Variant(Dest) := PVariant(Source.VPointer)^; { this in turn will cause a VarCopy[Ind] }
      varUnknown:
        IUnknown(Dest.VUnknown) := IUnknown(PUnknown(Source.VPointer)^);
      varShortInt:
        Dest.VShortInt := PShortInt(Source.VPointer)^;
      varByte:
        Dest.VByte := PByte(Source.VPointer)^;
      varWord:
        Dest.VWord := PWord(Source.VPointer)^;
      varLongWord:
        Dest.VLongWord := PLongWord(Source.VPointer)^;
    else
      Result := VAR_BADVARTYPE;
    end;
    if Result = VAR_OK then
      Dest.VType := Source.VType and VarTypeMask; // strip off modifier flags
  end;
end;

function VariantChangeOleStrIntoByteArray(var Dest: TVarData;
  const Source: TVarData): HRESULT;
var
  LArray: PVarArray;
  LData: Pointer;
  LCount: Integer;
  LVarBounds: array[0..0] of TVarArrayBound;
begin
  Result := VAR_OK;

  // how big are we talking?
  LCount := Length(Source.VOleStr) * SizeOf(WideChar);
  LVarBounds[0].LowBound := 0;
  LVarBounds[0].ElementCount := LCount;

  // array please
  LArray := SafeArrayCreate(varByte, 1, PVarArrayBoundArray(@LVarBounds)^);
  try

    // now aquire the target
    Result := SafeArrayLock(LArray);
    if Result = VAR_OK then
    try

      // take aim
      Result := SafeArrayAccessData(LArray, LData);
      if Result = VAR_OK then
      try
      
        // move the data
        Move(Source.VOleStr^, LData^, LCount);
      finally
        Result := SafeArrayUnaccessData(LArray);
      end;

    // clean up
    finally
      if Result = VAR_OK then
        Result := SafeArrayUnlock(LArray)
      else
        SafeArrayUnlock(LArray);
    end;

  // if all is swell then finish up the destination
  finally
    if Result <> VAR_OK then
      SafeArrayDestroy(LArray)
    else
    begin
      Dest.VType := varArray + varByte;
      Dest.VArray := LArray;
    end;
  end;
end;

function VariantChangeByteArrayIntoOleStr(var Dest: TVarData;
  const Source: TVarData): HRESULT;
var
  LArray: PVarArray;
  LData: Pointer;
  LCount: Integer;
begin

  // we know its a byte array so lets make sure it only has one dimension and
  //  it's element size is one and dest is not the source
  LArray := Source.VArray;
  if (LArray.DimCount <> 1) or (LArray.ElementSize <> 1) or (@Dest = @Source) then
    Result := VAR_INVALIDARG
  else
  begin

    // lock things down for a bit
    Result := SafeArrayLock(LArray);
    if Result = VAR_OK then
    try

      // now try and get the data
      Result := SafeArrayAccessData(LArray, LData);
      if Result = VAR_OK then
      try

        // how big is the data
        LCount := LArray.Bounds[0].ElementCount;

        // resize the destination
        SetLength(WideString(Pointer(Dest.VOleStr)),
          (LCount + SizeOf(WideChar) - 1) div SizeOf(WideChar));

        // mark it as being a ole str
        Dest.VType := varOleStr;

        // finally move the data
        Move(LData^, Dest.VOleStr^, LCount);
      finally
        Result := SafeArrayUnaccessData(LArray);
      end;

    // finally release the lock
    finally
      if Result = VAR_OK then
        Result := SafeArrayUnlock(LArray)
      else
        SafeArrayUnlock(LArray);
    end;
  end;
end;

function VariantChangeSimpleIntoSimple(var Dest: TVarData; const Source: TVarData;
  Flags: Word; VarType: Word): HRESULT;
var
  LSource: TVarData;
begin

  // this will take care of both ByRef Source and Dest = Source
  Result := VariantCopyInd(LSource, Source);
  if Result = VAR_OK then
  try
    Result := VariantClear(Dest);

    {$RANGECHECKS ON}
    if Result = VAR_OK then
    try
      case LSource.VType of
        varEmpty:
          case VarType of
            varEmpty, varNull, varSmallInt, varInteger, varSingle, varDouble,
            varCurrency, varDate, varOleStr, varBoolean, varShortInt, varByte,
            varWord, varLongWord:;
              // these are taken care of by the above Dest clear
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varNull:
          case VarType of
            varNull:;
              // this is taken care of by the above Dest clear
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varSmallint:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := LSource.VSmallInt;
            varInteger:
              Dest.VInteger := LSource.VSmallInt;
            varSingle:
              Dest.VSingle := LSource.VSmallInt;
            varDouble:
              Dest.VDouble := LSource.VSmallInt;
            varCurrency:
              Dest.VCurrency := LSource.VSmallInt;
            varDate:
              Dest.VDate := FloatToDateTime(LSource.VSmallInt);
            varOleStr:
              WideString(Pointer(Dest.VOleStr)) := IntToStr(LSource.VSmallInt);
            varBoolean:
              Dest.VBoolean := LSource.VSmallInt <> 0;
            varShortInt:
              Dest.VShortInt := LSource.VSmallInt;
            varByte:
              Dest.VByte := LSource.VSmallInt;
            varWord:
              Dest.VWord := LSource.VSmallInt;
            varLongWord:
              Dest.VLongWord := LSource.VSmallInt;
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varInteger:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := LSource.VInteger;
            varInteger:
              Dest.VInteger := LSource.VInteger;
            varSingle:
              Dest.VSingle := LSource.VInteger;
            varDouble:
              Dest.VDouble := LSource.VInteger;
            varCurrency:
              Dest.VCurrency := LSource.VInteger;
            varDate:
              Dest.VDate := FloatToDateTime(LSource.VInteger);
            varOleStr:
              WideString(Pointer(Dest.VOleStr)) := IntToStr(LSource.VInteger);
            varBoolean:
              Dest.VBoolean := LSource.VInteger <> 0;
            varShortInt:
              Dest.VShortInt := LSource.VInteger;
            varByte:
              Dest.VByte := LSource.VInteger;
            varWord:
              Dest.VWord := LSource.VInteger;
            varLongWord:
              Dest.VLongWord := LSource.VInteger;
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varSingle:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := Round(LSource.VSingle);
            varInteger:
              Dest.VInteger := Round(LSource.VSingle);
            varSingle:
              Dest.VSingle := LSource.VSingle;
            varDouble:
              Dest.VDouble := LSource.VSingle;
            varCurrency:
              Dest.VCurrency := FloatToCurr(LSource.VSingle);
            varDate:
              Dest.VDate := FloatToDateTime(LSource.VSingle);
            varOleStr:
              WideString(Pointer(Dest.VOleStr)) := FloatToStr(LSource.VSingle);
            varBoolean:
              Dest.VBoolean := LSource.VSingle <> 0;
            varShortInt:
              Dest.VShortInt := Round(LSource.VSingle);
            varByte:
              Dest.VByte := Round(LSource.VSingle);
            varWord:
              Dest.VWord := Round(LSource.VSingle);
            varLongWord:
              Dest.VLongWord := Round(LSource.VSingle);
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varDouble:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := Round(LSource.VDouble);
            varInteger:
              Dest.VInteger := Round(LSource.VDouble);
            varSingle:
              Dest.VSingle := LSource.VDouble;
            varDouble:
              Dest.VDouble := LSource.VDouble;
            varCurrency:
              Dest.VCurrency := FloatToCurr(LSource.VDouble);
            varDate:
              Dest.VDate := FloatToDateTime(LSource.VDouble);
            varOleStr:
              WideString(Pointer(Dest.VOleStr)) := FloatToStr(LSource.VDouble);
            varBoolean:
              Dest.VBoolean := LSource.VDouble <> 0;
            varShortInt:
              Dest.VShortInt := Round(LSource.VDouble);
            varByte:
              Dest.VByte := Round(LSource.VDouble);
            varWord:
              Dest.VWord := Round(LSource.VDouble);
            varLongWord:
              Dest.VLongWord := Round(LSource.VDouble);
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varCurrency:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := Round(LSource.VCurrency);
            varInteger:
              Dest.VInteger := Round(LSource.VCurrency);
            varSingle:
              Dest.VSingle := LSource.VCurrency;
            varDouble:
              Dest.VDouble := LSource.VCurrency;
            varCurrency:
              Dest.VCurrency := LSource.VCurrency;
            varDate:
              Dest.VDate := FloatToDateTime(LSource.VCurrency);
            varOleStr:
              WideString(Pointer(Dest.VOleStr)) := CurrToStr(LSource.VCurrency);
            varBoolean:
              Dest.VBoolean := LSource.VCurrency <> 0;
            varShortInt:
              Dest.VShortInt := Round(LSource.VCurrency);
            varByte:
              Dest.VByte := Round(LSource.VCurrency);
            varWord:
              Dest.VWord := Round(LSource.VCurrency);
            varLongWord:
              Dest.VLongWord := Round(LSource.VCurrency);
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varDate:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := Round(LSource.VDate);
            varInteger:
              Dest.VInteger := Round(LSource.VDate);
            varSingle:
              Dest.VSingle := LSource.VDate;
            varDouble:
              Dest.VDouble := LSource.VDate;
            varCurrency:
              Dest.VCurrency := FloatToCurr(LSource.VDate);
            varDate:
              Dest.VDate := LSource.VDate;
            varOleStr:
              begin
                if Trunc(LSource.VDate) = 0 then
                  WideString(Pointer(Dest.VOleStr)) := TimeToStr(LSource.VDate)
                else
                  WideString(Pointer(Dest.VOleStr)) := DateTimeToStr(LSource.VDate);
              end;
            varBoolean:
              Dest.VBoolean := LSource.VDate <> 0;
            varShortInt:
              Dest.VShortInt := Round(LSource.VDate);
            varByte:
              Dest.VByte := Round(LSource.VDate);
            varWord:
              Dest.VWord := Round(LSource.VDate);
            varLongWord:
              Dest.VLongWord := Round(LSource.VDate);
          else
            Result := VAR_TYPEMISMATCH;
          end;
        varOleStr:
          case VarType of
            varEmpty, varNull:;
            varSmallInt:
              Dest.VSmallInt := StrToInt(WideString(LSource.VOleStr));
            varInteger: