Mega Code Archive
A COM Object Collection (IEnumVARIANT)
<![CDATA[
Title: A COM Object Collection (IEnumVARIANT)
Question: How to implements object collection that support Visual Basic's For Each construct ?
Answer:
In order to implements an object collection yout object have to return
IEnumVariant pointer from a special property named _NewEnum.
IEnumVariant is a special COM interface defined as :
IEnumVARIANT = interface (IUnknown)
function Next (celt; var rgvar; pceltFetched): HResult;
function Skip (celt): HResult;
function Reset: HResult;
function Clone(out Enum): HResult;
end;
For Each is a special construct that knows how to call the IEnumVARIANT methods
(particularly Next) to iterate through all elements in the collection.
Say you have a collection interface that looks like this:
//single item
IMyItem = interface (IDispatch);
//collection of MyItem items
IMyItems = interface (IDispatch)
property Count : integer;
property Item [Index : integer] : IMyItem;
end;
1. To be able to implement IEnumVARIANT, your collection interface must support
automation (be IDispatch-based) and your individual collection item data type
must be VARIANT compatible (automation compatible).
In our example, IMyItems must be IDispatch-based and IMyItem must be
VARIANT compatible (that could be byte, BSTR, long, IUnknown, IDispatch, etc.).
2. Add a read-only property named _NewEnum to the collection interface.
_NewEnum must return IUnknown and must have a dispid = -4 (DISPID_NEWENUM).
So our definition of IMyItems change to :
IMyItems = interface (IDispatch)
property Count : integer;
property Item [Index : integer] : IMyItem;
property _NewEnum : IUnknown; dispid -4;
end;
3. _NewEnum must return IEnumVARIANT pointer.
To further illistrate the concept I will give you a more thorough example bellow.
In this example I create dummy asp component that only have one collection object
Recipients which suppose to hold list of email addresses. I didn't include the
*.tlb and *_TLB.pas file, so in order to compile it you have to create it yourself.
( you have to do somekind of reverse engineering, from class implementation to
interface declaration using Delphi TypeLib Editor )
______________________________________________________________________
unit uenumdem;
interface
uses
Windows, Classes, ComObj, ActiveX, AspTlb, enumdem_TLB, StdVcl;
type
IEnumVariant = interface(IUnknown)
['{00020404-0000-0000-C000-000000000046}']
function Next(celt: LongWord; var rgvar : OleVariant;
pceltFetched: PLongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumVariant): HResult; stdcall;
end;
TRecipients = class (TAutoIntfObject, IRecipients, IEnumVariant)
protected
PRecipients : TStringList;
FIndex : Integer;
function Get_Count: Integer; safecall;
function Get_Items(Index: Integer): OleVariant; safecall;
procedure Set_Items(Index: Integer; Value: OleVariant); safecall;
function Get__NewEnum: IUnknown; safecall;
procedure AddRecipient(Recipient: OleVariant); safecall;
function Next(celt: LongWord; var rgvar : OleVariant;
pceltFetched: PLongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset : HResult; stdcall;
function Clone (out Enum: IEnumVariant): HResult; stdcall;
public
constructor Create;
constructor Copy(slRecipients : TStringList);
destructor Destroy; override;
end;
TEnumDemo = class(TASPObject, IEnumDemo)
protected
FRecipients : IRecipients;
procedure OnEndPage; safecall;
procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
function Get_Recipients: IRecipients; safecall;
end;
implementation
uses ComServ,
SysUtils;
constructor TRecipients.Create;
begin
inherited Create (ComServer.TypeLib, IRecipients);
PRecipients := TStringList.Create;
FIndex := 0;
end;
constructor TRecipients.Copy(slRecipients : TStringList);
begin
inherited Create (ComServer.TypeLib, IRecipients);
PRecipients := TStringList.Create;
FIndex := 0;
PRecipients.Assign(slRecipients);
end;
destructor TRecipients.Destroy;
begin
PRecipients.Free;
inherited;
end;
function TRecipients.Get_Count: Integer;
begin
Result := PRecipients.Count;
end;
function TRecipients.Get_Items(Index: Integer): OleVariant;
begin
if (Index = 0) and (Index Result := PRecipients[Index]
else
Result := '';
end;
procedure TRecipients.Set_Items(Index: Integer; Value: OleVariant);
begin
if (Index = 0) and (Index PRecipients[Index] := Value;
end;
function TRecipients.Get__NewEnum: IUnknown;
begin
Result := Self;
end;
procedure TRecipients.AddRecipient(Recipient: OleVariant);
var
sTemp : String;
begin
PRecipients.Add(Recipient);
sTemp := Recipient;
end;
function TRecipients.Next(celt: LongWord; var rgvar : OleVariant;
pceltFetched: PLongWord): HResult;
type
TVariantList = array [0..0] of olevariant;
var
i : longword;
begin
i := 0;
while (i begin
TVariantList (rgvar) [i] := PRecipients[FIndex];
inc (i);
inc (FIndex);
end; { while }
if (pceltFetched nil) then
pceltFetched^ := i;
if (i = celt) then
Result := S_OK
else
Result := S_FALSE;
end;
function TRecipients.Skip(celt: LongWord): HResult;
begin
if ((FIndex + integer (celt)) begin
inc (FIndex, celt);
Result := S_OK;
end
else
begin
FIndex := PRecipients.Count;
Result := S_FALSE;
end; { else }
end;
function TRecipients.Reset : HResult;
begin
FIndex := 0;
Result := S_OK;
end;
function TRecipients.Clone (out Enum: IEnumVariant): HResult;
begin
Enum := TRecipients.Copy(PRecipients);
Result := S_OK;
end;
procedure TEnumDemo.OnEndPage;
begin
inherited OnEndPage;
end;
procedure TEnumDemo.OnStartPage(const AScriptingContext: IUnknown);
begin
inherited OnStartPage(AScriptingContext);
end;
function TEnumDemo.Get_Recipients: IRecipients;
begin
if FRecipients = nil then
FRecipients := TRecipients.Create;
Result := FRecipients;
end;
initialization
TAutoObjectFactory.Create(ComServer, TEnumDemo, Class_EnumDemo,
ciMultiInstance, tmApartment);
end.
______________________________________________________________________
Below I give you the asp script I use to test the component.
For this example I use only asp script. But the code should also
work perfectly in VB or VBA.
______________________________________________________________________
Set DelphiASPObj = Server.CreateObject("enumdem.EnumDemo")
DelphiASPObj.Recipients.AddRecipient "djar@telkom.co.id"
DelphiASPObj.Recipients.AddRecipient "djarkasih@hotmail.com"
DelphiASPObj.Recipients.AddRecipient "imgprov@hotmail.com"
Response.Write "Using For Next Structure"
for i = 0 to DelphiASPObj.Recipients.Count-1
Response.Write "DelphiASPObj.Recipients.Items[" & i & "] = " & _
DelphiASPObj.Recipients.Items(i) & ""
next
Response.Write "Using For Each Structure"
for each sRecipient in DelphiASPObj.Recipients
Response.Write "Recipient : " & sRecipient & ""
next
Set DelphiASPObj = Nothing
______________________________________________________________________
Additional Note : In above example the collection object is use to store
string data. But you could easily change the example so the collection
will hold for example any other COM object that implement IUnknown or IDispatch.
In that case you'll have to use Delphi TInterfaceList to hold all of your COM object
item.
]]>