Delphi programming-how to implement a COM object that supports Visual Basic For Each calls

Anyone familiar with Visual Basic and ASP development will be familiar with calling COM set objects using Visual Basic's For Each syntax.

For Each allows a VB client to easily traverse elements in a set:

Dim Items as Server. IItems // declare collection variables

Dim Item as Server. IItem // declare the element variable of the Set

Set Items = ServerObject. GetItems // obtain the server's collection object

// Use For Each to traverse the set Elements

For Each Item in Items

Call DoSomething (Item)

Next

So what types of COM objects support the For Each syntax? The answer is to implement the IEnumVARIANT COM interface, which is defined as follows:

IEnumVARIANT = interface (IUnknown)

Function Next (celt; var rgvar; pceltFetched): HResult;

Function Skip (celt): HResult;

Function Reset: HResult;

Function Clone (out Enum): HResult;

End;

The For Each syntax knows how to call the IEnumVARIANT interface (especially the Next method) to traverse all elements in the set. How can I publish the IEnumVARIANT interface to the client? The following is a set interface:

// Set Element

IFooItem = interface (IDispatch );

// Element Set

IFooItems = interface (IDispatch)

Property Count: integer;

Property Item [Index: integer]: IFoo;

End;

To use the IEnumVARIANT interface, our set interface must support automation (that is, based on the IDispatch Interface) first ), at the same time, the set elements must be automatically compatible (such as byte, BSTR, long, IUnknown, and IDispatch ).

Then, we use the Type Library editor to add a read-only attribute named _ NewEnum to the set interface. The _ NewEnum attribute must return the IUnknown interface and dispid =-4 (DISPID_NEWENUM ). The modified IFooItems is defined as follows:

IFooItems = interface (IDispatch)

Property Count: integer;

Property Item [Index: integer]: IFoo;

Property _ NewEnum: IUnknown; dispid-4;

End;

Next we will implement the _ NewEnum attribute to return the IEnumVARIANT interface pointer:

The following is a complete example. It creates an ASP Component and has a collection object to maintain an email address list:

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 <PRecipients. Count) then

Result: = PRecipients [Index]

Else

Result: = '';

End;

Procedure TRecipients. Set_Items (Index: Integer; Value: OleVariant );

Begin

If (Index> = 0) and (Index <PRecipients. Count) then

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 <celt) and (FIndex <PRecipients. Count) do

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) <= PRecipients. Count) then

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.

The following is an ASP script used to test ASP components:

Set DelphiASPObj = Server. CreateObject ("enumdem. EnumDemo ")

DelphiASPObj. Recipients. AddRecipient "windows@ms.ccom"

DelphiASPObj. Recipients. AddRecipient "borland@hotmail.com"

DelphiASPObj. Recipients. AddRecipient "delphi@hotmail.com"

Response. Write "using the 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 the For Each structure"

For each sRecipient in DelphiASPObj. Recipients

Response. Write "Recipient:" & sRecipient &""

Next

Set DelphiASPObj = Nothing

In the preceding example, a collection object stores string data. In fact, it can store any COM Object. For a COM object, you can use the TInterfaceList class defined by Delphi to manage COM Object elements in the set.

The following is a reusable class TEnumVariantCollection, which hides the implementation details of the IEnumVARIANT interface. To insert the TEnumVariantCollection class to the Collection object, we need to implement an interface with the following three methods:

IVariantCollection = interface

// Use the enumerator to lock the list owner

Function GetController: IUnknown; stdcall;

// Use the enumerator to determine the number of elements

Function GetCount: integer; stdcall;

// Use the enumerator to return the set Elements

Function GetItems (Index: olevariant): olevariant; stdcall;

End;

The modified TFooItem is defined as follows:

Type

// Foo items collection

TFooItems = class (TSomeBaseClass, IFooItems, IVariantCollection)

Protected

{IVariantCollection}

Function GetController: IUnknown; stdcall;

Function GetCount: integer; stdcall;

Function GetItems (Index: olevariant): olevariant; stdcall;

Protected

FItems: TInterfaceList; // list of internal set elements;

...

End;

Function TFooItems. GetController: IUnknown;

Begin

// Always return Self/collection owner here

Result: = Self;

End;

Function TFooItems. GetCount: integer;

Begin

// Always return collection count here

Result: = FItems. Count;

End;

Function TFooItems. GetItems (Index: olevariant): olevariant;

Begin

// Obtain the IDispatch Interface

Result: = FItems. Items [Index] as IDispatch;

End;

Finally, we will implement the _ NewEnum attribute:

Function TFooItems. Get _ NewEnum: IUnknown;

Begin

Result: = TEnumVariantCollection. Create (Self );

End;