看看Delphi是如何处理OleVariant到Socket流的！(0分)

interface
uses
VarUtils, Variants, Windows, Messages, Classes, SysUtils, ComObj;
type
PIntArray = ^TIntArray;
TIntArray = array[0..0] of Integer;
PVariantArray = ^TVariantArray;
TVariantArray = array[0..0] of OleVariant;
TVarFlag = (vfByRef, vfVariant);
TVarFlags = set of TVarFlag;
TDataCell = class(TObject)
private
FStream: TMemoryStream;
FReadPos: Integer;
FWritePos: Integer;
FIgnoreStream: Boolean;
protected
function GetBytesReserved: Integer;
function GetMemory: Pointer;
function GetSize: Integer;
procedure SetSize(Value: Integer);
function GetStream: TStream;
function GetSignature: Integer;
procedure SetSignature(Value: Integer);
procedure Clear;
procedure IgnoreStream;
function InitData(
Data: Pointer;
DataLen: Integer;
CheckLen: Boolean): Integer;
property Stream: TStream read GetStream;
public
constructor Create;
destructor Destroy;
override;
function Write(const Buffer;
Count: Integer): Integer;
function Read(var Buffer;
Count: Integer): Integer;
property BytesReserved: Integer read GetBytesReserved;
property Memory: Pointer read GetMemory;
property Signature: Integer read GetSignature write SetSignature;
property Size: Integer read GetSize write SetSize;
end;

function _ReadVariant(
out Flags: TVarFlags;
const Data: TDataCell): OleVariant;
procedure _WriteVariant(
const Value: OleVariant;
const Data: TDataCell);
const
EasyArrayTypes = [varSmallInt, varInteger, varSingle,
varDouble, varCurrency, varDate, varBoolean, varShortInt,
varByte, varWord, varLongWord];
VariantSize: array[0..varLongWord] 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,
SizeOf(ShortInt),
SizeOf(Byte),
SizeOf(Word),
SizeOf(LongWord));
MINDATAPACKETSIZE = 8;
CallSig = $DA00;
// Call signature
ResultSig = $DB00;
// Result signature
resourcestring
SInvalidDataPacket = 'Invalid data packet';
SBadVariantType = 'Unsupported variant type: %s';
implementation
uses ActiveX;
function StreamToStr(MS: TStream): AnsiString;
var
StrStream: TStringStream;
begin
Result := '';
if MS = nil then
Exit;
StrStream := TStringStream.Create('');
try
MS.Position := 0;
StrStream.CopyFrom(MS, MS.Size);
Result := StrStream.DataString;
finally
StrStream.Free;
end;
end;

procedure CheckSignature(Sig: Integer);
begin
if (Sig and $FF00 <> CallSig) and
(Sig and $FF00 <> ResultSig) then
raise Exception.CreateRes(@SInvalidDataPacket);
end;

function _ReadArray(
VType: Integer;
const Data: TDataCell): 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 - 1do
begin
Bounds[i * 2] := LoDim;
Bounds[i * 2 + 1] := HiDim;
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 - 1do
Indices := LoDim;
while Truedo
begin
V := _ReadVariant(Flags, Data);
if VType and varTypeMask = varVariant then
SafeArrayCheck(SafeArrayPutElement(LSafeArray, Indices^, V))
else
SafeArrayCheck(SafeArrayPutElement(LSafeArray, Indices^,
TVarData(V).VPointer^));
Inc(Indices[DimCount - 1]);
if Indices[DimCount - 1] > HiDim[DimCount - 1] then
for i := DimCount - 1do
wnto 0do
if Indices > HiDim then
begin
if i = 0 then
Exit;
Inc(Indices[i - 1]);
Indices := LoDim;
end;
end;
finally
FreeMem(Indices);
end;
end;
finally
FreeMem(HiDim);
end;
finally
FreeMem(LoDim);
end;
end;

procedure _WriteArray(
const Value: OleVariant;
const Data: TDataCell);
var
LVarData: TVarData;
VType: Integer;
VSize, i, DimCount, ElemSize: Integer;
LSafeArray: PSafeArray;
LoDim, HiDim, Indices: PIntArray;
V: OleVariant;
P: Pointer;
begin
LVarData := FindVarData(Value)^;
VType := LVarData.VType;
LSafeArray := PSafeArray(LVarData.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 DimCountdo
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 - 1do
VSize := (HiDim - LoDim + 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 - 1do
Indices := LoDim;
while Truedo
begin
if VType and varTypeMask <> varVariant then
begin
SafeArrayCheck(SafeArrayGetElement(LSafeArray, Indices^,
TVarData(V).VPointer));
TVarData(V).VType := VType and varTypeMask;
end
else
SafeArrayCheck(SafeArrayGetElement(LSafeArray, Indices^, V));
_WriteVariant(V, Data);
Inc(Indices[DimCount - 1]);
if Indices[DimCount - 1] > HiDim[DimCount - 1] then
for i := DimCount - 1do
wnto 0do
if Indices > HiDim then
begin
if i = 0 then
Exit;
Inc(Indices[i - 1]);
Indices := LoDim;
end;
end;
finally
FreeMem(Indices);
end;
end;
finally
FreeMem(HiDim);
end;
finally
FreeMem(LoDim);
end;
end;

function _ReadVariant(
out Flags: TVarFlags;
const Data: TDataCell): 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;
varUnknown:
raise Exception.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: TDataCell);
var
I, VType: Integer;
W: WideString;
begin
VType := VarType(Value);
if VType and varArray <> 0 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;
varVariant:
begin
if VType and varByRef <> varByRef then
raise Exception.CreateResFmt(@SBadVariantType,
[IntToHex(VType, 4)]);
I := varByRef;
Data.Write(I, SizeOf(Integer));
_WriteVariant(Variant(TVarData(Value).VPointer^), Data);
end;
varUnknown:
raise Exception.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;

{ TDataCell }
constructor TDataCell.Create;
begin
inherited Create;
FIgnoreStream := False;
FStream := TMemoryStream.Create;
Clear;
end;

destructor TDataCell.Destroy;
begin
if not FIgnoreStream then
FStream.Free;
inherited Destroy;
end;

{ TDataCell.IDataBlock }
function TDataCell.GetBytesReserved: Integer;
begin
Result := SizeOf(Integer) * 2;
end;

function TDataCell.GetMemory: Pointer;
var
DataSize: Integer;
begin
FStream.Position := 4;
DataSize := FStream.Size - BytesReserved;
FStream.Write(DataSize, SizeOf(DataSize));
Result := FStream.Memory;
end;

function TDataCell.GetSize: Integer;
begin
Result := FStream.Size - BytesReserved;
end;

procedure TDataCell.SetSize(Value: Integer);
begin
FStream.Size := Value + BytesReserved;
end;

function TDataCell.GetStream: TStream;
var
DataSize: Integer;
begin
FStream.Position := 4;
DataSize := FStream.Size - BytesReserved;
FStream.Write(DataSize, SizeOf(DataSize));
FStream.Position := 0;
Result := FStream;
end;

function TDataCell.GetSignature: Integer;
begin
FStream.Position := 0;
FStream.Read(Result, SizeOf(Result));
end;

procedure TDataCell.SetSignature(Value: Integer);
begin
FStream.Position := 0;
FStream.Write(Value, SizeOf(Value));
end;

procedure TDataCell.Clear;
begin
FStream.Size := BytesReserved;
FReadPos := BytesReserved;
FWritePos := BytesReserved;
end;

function TDataCell.Write(const Buffer;
Count: Integer): Integer;
begin
FStream.Position := FWritePos;
Result := FStream.Write(Buffer, Count);
FWritePos := FStream.Position;
end;

function TDataCell.Read(var Buffer;
Count: Integer): Integer;
begin
FStream.Position := FReadPos;
Result := FStream.Read(Buffer, Count);
FReadPos := FStream.Position;
end;

procedure TDataCell.IgnoreStream;
begin
FIgnoreStream := True;
end;

function TDataCell.InitData(
Data: Pointer;
DataLen: Integer;
CheckLen: Boolean): Integer;
var
Sig: Integer;
P: Pointer;
begin
P := Data;
if DataLen < MINDATAPACKETSIZE then
raise Exception.CreateRes(@SInvalidDataPacket);
Sig := Integer(P^);
P := Pointer(Integer(Data) + SizeOf(Sig));
CheckSignature(Sig);
Signature := Sig;
Result := Integer(P^);
P := Pointer(Integer(P) + SizeOf(Result));
if CheckLen then
begin
if (Result <> DataLen - MINDATAPACKETSIZE) then
raise Exception.CreateRes(@SInvalidDataPacket);
Size := Result;
if Result > 0 then
Write(P^, Result);
end
else
begin
Size := DataLen - MINDATAPACKETSIZE;
if Size > 0 then
Write(P^, Size);
end;
end;

//=============如果分析过Midas的哥们，应该对上面代码不陌生！
我们可以看到，Midas在网络传输这块，实际也逃脱不了Socket传输，
那么假如我们不想使用什么TRemoteDateMoudle，呵呵，就可以偷这
段代码来用了！