晕头了：Byte数组与OleVariant类型互转问题

Question

这几天被这个问题搞晕了：Byte数组转换成OleVariant类型后，为什么无法再转换回来呢？function ByteToOleVariant(Strm: Array of byte ): OleVariant;
var
    Data:   PByteArray;
    i   :integer;
begin
    Result   :=   VarArrayCreate([0,   high(Strm)-Low(Strm)],   varByte);
    Data   :=   VarArrayLock(Result);
    try
      for   i:=Low(Strm)   to   high(Strm)   do
              Data^[i]:=Strm[i]   ;
    finally
        VarArrayUnlock(Result);
    end;
end;
Procedure VariantToByte(const Data: OleVariant);
var
  p: Pointer;
  Stream :TMemoryStream;
  MyByte: Array of Byte;
begin
  Stream:=TMemoryStream.Create;
  p := VarArrayLock(Data);
  try
    Stream.Write(p^, VarArrayHighBound(Data,1) + 1);
  finally
    VarArrayUnlock(Data);
  end;  SetLength(MyByte,Stream.Size);
  Stream.read(MyByte[0],Stream.Size);
  //查看MyByte数组发现全为0
end;
procedure TForm1.Button2Click(Sender: TObject);
var
   ams,gms : TMemoryStream;
   FilePath :String;
   MS : OleVariant;
   Buf1,Buf2 :Array of byte;
begin
   FilePath:='E:\M0120.JPG';
   ams :=TMemoryStream.Create;
   ams.LoadFromFile(FilePath);
   setLength(Buf1,ams.Size);
   ams.read(Buf1[0],ams.Size);  //一次性将文件的内容读入BUF1这个数组   MS:=ByteToOleVariant(Buf1);  //将Byte数组转换为OleVariant;
   VariantToByte(MS);           //将OleVariant转换为Byte数组;

Answer 1

unit VBVariants;interface
uses
        Variants,Classes,ActiveX,ComObj;
const  EasyArrayTypes = [varSmallInt, varInteger, varSingle, varDouble, varCurrency,
                    varDate, varBoolean, varByte];  VariantSize: array[0..varByte] of Word  = (0, 0, SizeOf(SmallInt), SizeOf(Integer),
    SizeOf(Single), SizeOf(Double), SizeOf(Currency), SizeOf(TDateTime), 0, 0,
    SizeOf(Integer), SizeOf(WordBool), 0, 0, 0, 0, 0, SizeOf(Byte));type  PIntArray = ^TIntArray;
  TIntArray = array[0..0] of Integer;  PVariantArray = ^TVariantArray;
  TVariantArray = array[0..0] of OleVariant;  TVarFlag = (vfByRef, vfVariant);
  TVarFlags = set of TVarFlag;
  function GetVariantPointer(const Value: OleVariant): Pointer;
  function ReadArray(VType: Integer;const Data: TStream): OleVariant;
  procedure WriteArray(const Value: OleVariant; const Data: TStream);
  function ReadVariant(out Flags: TVarFlags;const Data: TStream): OleVariant;
  procedure WriteVariant(const Value: OleVariant;const Data: TStream);
implementationfunction GetVariantPointer(const Value: OleVariant): Pointer;
begin
  case VarType(Value) of
    varEmpty, varNull: Result := nil;
    varDispatch: Result := TVarData(Value).VDispatch;
    varVariant: Result := @Value;
    varUnknown: Result := TVarData(Value).VUnknown;
  else
    Result := @TVarData(Value).VPointer;
  end;
end;function ReadArray(VType: Integer;
  const Data: TStream): OleVariant;
var
  Flags: TVarFlags;
  LoDim, HiDim, Indices, Bounds: PIntArray;
  DimCount, VSize, i: Integer;
  {P: Pointer;}
  V: OleVariant;
  LSafeArray: PSafeArray;
  P: Pointer;
begin
  VarClear(Result);
  Data.Read(DimCount, SizeOf(DimCount));
  VSize := DimCount * SizeOf(Integer);
  GetMem(LoDim, VSize);
  try
    GetMem(HiDim, VSize);
    try
      Data.Read(LoDim^, VSize);
      Data.Read(HiDim^, VSize);
      GetMem(Bounds, VSize * 2);
      try
        for i := 0 to DimCount - 1 do
        begin
          Bounds[i * 2] := LoDim[i];
          Bounds[i * 2 + 1] := HiDim[i];
        end;
        Result := VarArrayCreate(Slice(Bounds^,DimCount * 2), VType and varTypeMask);
      finally
        FreeMem(Bounds);
      end;
      if VType and varTypeMask in EasyArrayTypes then
      begin
        Data.Read(VSize, SizeOf(VSize));
        P := VarArrayLock(Result);
        try
          Data.Read(P^, VSize);
        finally
          VarArrayUnlock(Result);
        end;
      end else
      begin
        LSafeArray := PSafeArray(TVarData(Result).VArray);
        GetMem(Indices, VSize);
        try
          FillChar(Indices^, VSize, 0);
          for I := 0 to DimCount - 1 do
            Indices[I] := LoDim[I];
          while True do
          begin
            V := ReadVariant(Flags, Data);
            if VType and varTypeMask = varVariant then
              OleCheck(SafeArrayPutElement(LSafeArray, Indices^, V)) else
              OleCheck(SafeArrayPutElement(LSafeArray, Indices^, TVarData(V).VPointer^));
            Inc(Indices[DimCount - 1]);
            if Indices[DimCount - 1] > HiDim[DimCount - 1] then
              for i := DimCount - 1 downto 0 do
                if Indices[i] > HiDim[i] then
                begin
                  if i = 0 then Exit;
                  Inc(Indices[i - 1]);
                  Indices[i] := LoDim[i];
                end;
          end;
        finally
          FreeMem(Indices);
        end;
      end;
    finally
      FreeMem(HiDim);
    end;
  finally
    FreeMem(LoDim);
  end;
end;procedure WriteArray(const Value: OleVariant;
  const Data: TStream);
var
  VType, VSize, i, DimCount, ElemSize: Integer;
  LSafeArray: PSafeArray;
  LoDim, HiDim, Indices: PIntArray;
  V: OleVariant;
  P: Pointer;
begin
  VType := VarType(Value);
  LSafeArray := PSafeArray(TVarData(Value).VPointer);
  Data.Write(VType, SizeOf(Integer));
  DimCount := VarArrayDimCount(Value);
  Data.Write(DimCount, SizeOf(DimCount));
  VSize := SizeOf(Integer) * DimCount;
  GetMem(LoDim, VSize);
  try
    GetMem(HiDim, VSize);
    try
      for i := 1 to DimCount do
      begin
        LoDim[i - 1] := VarArrayLowBound(Value, i);
        HiDim[i - 1] := VarArrayHighBound(Value, i);
      end;
      Data.Write(LoDim^,VSize);
      Data.Write(HiDim^,VSize);
      if VType and varTypeMask in EasyArrayTypes then
      begin
        ElemSize := SafeArrayGetElemSize(LSafeArray);
        VSize := 1;
        for i := 0 to DimCount - 1 do
          VSize := (HiDim[i] - LoDim[i] + 1) * VSize;
        VSize := VSize * ElemSize;
        P := VarArrayLock(Value);
        try
          Data.Write(VSize, SizeOf(VSize));
          Data.Write(P^,VSize);
        finally
          VarArrayUnlock(Value);
        end;
      end else
      begin
        GetMem(Indices, VSize);
        try
          for I := 0 to DimCount - 1 do
            Indices[I] := LoDim[I];
          while True do
          begin
            if VType and varTypeMask <> varVariant then
            begin
              OleCheck(SafeArrayGetElement(LSafeArray, Indices^, TVarData(V).VPointer));
              TVarData(V).VType := VType and varTypeMask;
            end else
              OleCheck(SafeArrayGetElement(LSafeArray, Indices^, V));
            WriteVariant(V, Data);
            Inc(Indices[DimCount - 1]);
            if Indices[DimCount - 1] > HiDim[DimCount - 1] then
              for i := DimCount - 1 downto 0 do
                if Indices[i] > HiDim[i] then
                begin
                  if i = 0 then Exit;
                  Inc(Indices[i - 1]);
                  Indices[i] := LoDim[i];
                end;
          end;
        finally
          FreeMem(Indices);
        end;
      end;
    finally
      FreeMem(HiDim);
    end;
  finally
    FreeMem(LoDim);
  end;
end;

Answer 2

function ReadVariant(out Flags: TVarFlags;
  const Data: TStream): OleVariant;
var
  I, VType: Integer;
  W: WideString;
  TmpFlags: TVarFlags;
begin
  VarClear(Result);
  Flags := [];
  Data.Read(VType, SizeOf(VType));
  if VType and varByRef = varByRef then Include(Flags, vfByRef);
  if VType = varByRef then
  begin
    Include(Flags, vfVariant);
    Result := ReadVariant(TmpFlags, Data);
    Exit;
  end;
  if vfByRef in Flags then VType := VType xor varByRef;
  if (VType and varArray) = varArray then
    Result := ReadArray(VType, Data) else
  case VType and varTypeMask of
    varEmpty: VarClear(Result);
    varNull: Result := NULL;
    varOleStr:
    begin
      Data.Read(I, SizeOf(Integer));
      SetLength(W, I);
      Data.Read(W[1], I * 2);
      Result := W;
    end;
    {varDispatch:
    begin
      Data.Read(I, SizeOf(Integer));
      Result := TDataDispatch.Create(Self, I) as IDispatch;
    end;}
    //varUnknown:
    //  raise EInterpreterError.CreateResFmt(@SBadVariantType,[IntToHex(VType,4)]);
  else
    TVarData(Result).VType := VType;
    Data.Read(TVarData(Result).VPointer, VariantSize[VType and varTypeMask]);
  end;
end;
procedure WriteVariant(const Value: OleVariant;
  const Data: TStream);
var
  I, VType: Integer;
  W: WideString;
begin
  VType := VarType(Value);
  if VarIsArray(Value) then
    WriteArray(Value, Data) else
  case (VType and varTypeMask) of
    varEmpty, varNull: Data.Write(VType, SizeOf(Integer));
    varOleStr:
    begin
      W := WideString(Value);
      I := Length(W);
      Data.Write(VType, SizeOf(Integer));
      Data.Write(I,SizeOf(Integer));
      Data.Write(W[1], I * 2);
    end;
    {varDispatch:
    begin
      //if VType and varByRef = varByRef then
      //  raise EInterpreterError.CreateResFmt(@SBadVariantType,[IntToHex(VType,4)]);
      I := StoreObject(Value);
      Data.Write(VType, SizeOf(Integer));
      Data.Write(I, SizeOf(Integer));
    end;}
    varVariant:
    begin
      //if VType and varByRef <> varByRef then
      //  raise EInterpreterError.CreateResFmt(@SBadVariantType,[IntToHex(VType,4)]);
      I := varByRef;
      Data.Write(I, SizeOf(Integer));
      WriteVariant(Variant(TVarData(Value).VPointer^), Data);
    end;
    //varUnknown:
    //  raise EInterpreterError.CreateResFmt(@SBadVariantType,[IntToHex(VType,4)]);
  else
    Data.Write(VType, SizeOf(Integer));
    if VType and varByRef = varByRef then
      Data.Write(TVarData(Value).VPointer^, VariantSize[VType and varTypeMask]) else
      Data.Write(TVarData(Value).VPointer, VariantSize[VType and varTypeMask]);
  end;
end;
end.

Answer 3

 请问函数如何使用?   function GetVariantPointer(const Value: OleVariant): Pointer;
  function ReadArray(VType: Integer;const Data: TStream): OleVariant;
  procedure WriteArray(const Value: OleVariant; const Data: TStream);
  function ReadVariant(out Flags: TVarFlags;const Data: TStream): OleVariant;
  procedure WriteVariant(const Value: OleVariant;const Data: TStream);

Answer 4

procedure TForm1.Button1Click(Sender: TObject);
var
 ams,gms   :   TMemoryStream;
 FilePath   :String;
 Myvariant  : OleVariant;
begin
   ams   :=TMemoryStream.Create;   
   gms   :=TMemoryStream.Create;
   FilePath:='c:\Tmp.jpg';
   ams.LoadFromFile(FilePath);   Myvariant:=ReadArray(varByte,ams);  //执行到函数时报错: Error Creating Variant or Saft array ???
   WriteArray(Myvariant,gms);   gms.SaveToFile('c:\tmp1.jpg');
end;

Answer 5

uses activex;
function Stream2OleVariantBytes(const Stream:TStream):OleVariant;
var
  Data:Pointer;
begin
  Result := VarArrayCreate([0,Stream.Size-1],varByte);
  Data := VarArrayLock(Result);
  try
    Stream.Position := 0;
    Stream.Read(Data^,Stream.Size);
  finally
    VarArrayUnlock(Result);
  end;
end;procedure OleVariantBytes2Stream(const VValue:OleVariant; Stream:TStream);
var
  Data:Pointer;
  V:OleVariant;
begin
  Data := VarArrayLock(VValue);
  try
    Stream.Seek(0,soFromEnd);
    Stream.Write(Data^,(VarArrayHighBound(VValue,1)-VarArrayLowBound(VValue,1)+1) * SafeArrayGetElemSize(PSafeArray(TVarData(VValue).VPointer)))
  finally
    VarArrayUnlock(VValue);
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  V:OleVariant;
  m:TMemoryStream;
begin
  m:= TMemoryStream.Create;
  try
    Memo1.Lines.SaveToStream(m);
    V:=Stream2OleVariantBytes(m);
    m.Clear;
    Memo2.Lines.SaveToStream(m);
    OleVariantBytes2Stream(V,M);
    m.Position := 0;
    Caption := IntToStr(m.Size);
    Memo2.Lines.LoadFromStream(m);
  finally
    m.Free;
  end;
end;