The standard function VarType() returns a variant's type code. The varTypeMask constant is a bit mask used to extract the code from VarType()'s return value, so that, for example,

(VarType(V) and varTypeMask) = varDouble

returns True if V contains a Double or an array of Double. (The mask simply hides the first bit, which indicates whether the variant holds an array.) The TVarData record type defined in the System unit can be used to typecast variants and gain access to their internal representation.

This example shows how to use the TVarData type in typecasts of Variant variables to access the internals of a variable. Example:

var
  V: Variant;
begin
  ...
  if TVarData(V).VType = varEmpty then ...;
 
  ...
  VarClear(V);
 
  TVarData(V).VType := varInteger;
  TVarData(V).VInteger := 1234567;
  ...
 
end;

Source: Chapter 15: COM DEVELOPMENT, Borland Delphi 6 Developer's Guide, p. 725.

LISTING 15.13 The Server Unit

unit ServObj;
 
interface
 uses
   ComObj,ActiveX,Server_TLB;
type
  TBinaryData =class(TAutoObject,IBinaryData)
    protected
      function Get_Data:OleVariant;safecall;
      procedure Set_Data(Value:OleVariant);safecall;
  end;
 
implementation
  uses ComServ,ServMain;
 
//-------------------------------------------------------------
// description: get data from a Memo and copy to Variant
//-------------------------------------------------------------
function TBinaryData.Get_Data:OleVariant;
var
  P:Pointer;
  L:Integer;
begin
  //Move data from memo into array
  L :=Length(MainForm.Memo.Text);
  Result :=VarArrayCreate([0,L -1],varByte);
  P :=VarArrayLock(Result);
  try
    Move(MainForm.Memo.Text[1],P^,L);
  finally
    VarArrayUnlock(Result);
  end;
end;
 
//-------------------------------------------------------------
// description: get data from a Variant and copy to Memo
//-------------------------------------------------------------
procedure TBinaryData.Set_Data(Value:OleVariant);
var
  P:Pointer;
  L:Integer;
  S:string;
begin
  //Move data from array into memo
  L :=VarArrayHighBound(Value,1)-VarArrayLowBound(Value,1)+1;
  SetLength(S,L);
  P :=VarArrayLock(Value);
  try
    Move(P^,S[1],L);
  finally
    VarArrayUnlock(Value);
  end;
  MainForm.Memo.Text :=S;
end;
 
initialization
 
  TAutoObjectFactory.Create(ComServer,TBinaryData,Class_BinaryData,
  ciSingleInstance,tmApartment);
end.

LISTING 15.14 The Client Unit

unit CliMain;
 
interface
 
uses
  Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
  StdCtrls,ExtCtrls,Server_TLB;
 
type
  TMainForm =class(TForm)
    Memo:TMemo;
    Panel1:TPanel;
    SetButton:TButton;
    GetButton:TButton;
    OpenButton:TButton;
    OpenDialog:TOpenDialog;
    procedure OpenButtonClick(Sender:TObject);
    procedure FormCreate(Sender:TObject);
    procedure SetButtonClick(Sender:TObject);
    procedure GetButtonClick(Sender:TObject);
  private
    FServer:IBinaryData;
  end;
 
var
  MainForm:TMainForm;
 
implementation
 
{$R *.DFM}
 
procedure TMainForm.FormCreate(Sender:TObject);
begin
  FServer :=CoBinaryData.Create;
end;
 
procedure TMainForm.OpenButtonClick(Sender:TObject);
begin
  if OpenDialog.Execute then
    Memo.Lines.LoadFromFile(OpenDialog.FileName);
end;
 
procedure TMainForm.SetButtonClick(Sender:TObject);
var
  P:Pointer;
  L:Integer;
  V:OleVariant;
begin
  //Send memo data to server
  L :=Length(Memo.Text);
  V :=VarArrayCreate([0,L -1],varByte);
  P :=VarArrayLock(V);
  try
    Move(Memo.Text[1],P^,L);
  finally
    VarArrayUnlock(V);
  end;
  FServer.Data :=V;
end;
 
procedure TMainForm.GetButtonClick(Sender:TObject);
var
  P:Pointer;
  L:Integer;
  S:string;
  V:OleVariant;
begin
  //Get server’s memo data
  V :=FServer.Data;
  L :=VarArrayHighBound(V,1)-VarArrayLowBound(V,1)+1;
  SetLength(S,L);
  P :=VarArrayLock(V);
  try
    Move(P^,S[1],L);
  finally
    VarArrayUnlock(V);
  end;
  Memo.Text :=S;
end;
 
end.

Other Examples

procedure VariantToData(Value: Variant; Var Data; MaxLen: integer);
var
   p:   pByte;
   len: integer;
begin
  assert(maxlen > 0);
  Try
    p   := VarArrayLock(Value);
    Len := VarArrayHighBound(Value, 1) + 1;
    assert(Len <= MaxLen);
    move(p^, Data, Len);
  finally
    VarArrayUnLock(Value);
  end;
end;
 
function DataToVariant(const Data;Len:integer):Variant;
var
   p: pByte;
begin
  Result := VarArrayCreate([0, len-1], varByte);
  p      := VarArrayLock(Result);
  try
    move(Data, p^, Len);
  finally
    VarArrayUnLock(Result);
  end;
end;
 
function ComponentToString(Component: TComponent): string;
var
  BinStream: TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result := StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free;
  end;
end;
 
function StringToComponent(Value: string): TComponent;
var
  StrStream: TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result := BinStream.ReadComponent(nil);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end;
 
function ComponentToVariant(Component: TComponent): Variant;
var
  BinStream: TMemoryStream;
  Data: Pointer;
begin
  BinStream := TMemoryStream.Create;
  try
    BinStream.WriteComponent(Component);
    Result := VarArrayCreate([0, BinStream.Size - 1], varByte);
    Data   := VarArrayLock(Result);
    try
      Move(BinStream.Memory^, Data^, BinStream.Size);
    finally
      VarArrayUnlock(Result);
    end;
  finally
    BinStream.Free;
  end;
end;
 
function VariantToComponent(Value: Variant): TComponent;
var
  BinStream: TMemoryStream;
  Data: Pointer;
begin
  BinStream := TMemoryStream.Create;
  try
    Data := VarArrayLock(Value);
    try
      BinStream.WriteBuffer(Data^, VarArrayHighBound(Value, 1) + 1);
    finally
      VarArrayUnlock(Value);
    end;
    BinStream.Seek(0, soFromBeginning);
    Result := BinStream.ReadComponent(nil);
  finally
    BinStream.Free;
  end;
end;