Delphi编程 -- 如何实现一个支持Visual Basic的For Each调用的COM对象
熟悉Visual Basic和ASP开发的人一定会很熟悉用Visual Basic的For Each语法调用COM集合对象。
For Each允许一个VB的客户端很方便地遍历一个集合中的元素：
Dim Items as Server.IItems //声明集合变量
Dim Item as Server.IItem //声明集合元素变量
Set Items = ServerObject.GetItems //获得服务器的集合对象
//用 For Each循环遍历集合元素
For Each Item in Items
Call DoSomething (Item)
Next
那么什么样的COM对象支持For Each语法呢？答案就是实现IEnumVARIANT COM接口，它的定义如下：
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语法知道如何调用IEnumVARIANT 接口的方法（特别是Next方法）来遍历集合中的全部元素。那么如何才能向客户端公开IEnumVARIANT 接口呢，下面是一个集合接口：
//集合元素
IFooItem = interface (IDispatch);
//元素集合
IFooItems = interface (IDispatch)
property Count : integer;
property Item [Index : integer] : IFoo;
end;
要想使用IEnumVARIANT接口，我们的集合接口首先必须支持自动化（也就是基于IDispatch接口），同时集合元素也必须是自动化兼容的（比如byte、BSTR、long、IUnknown、IDispatch等）。
然后，我们利用类型库编辑器添加一个名为_NewEnum的只读属性到集合接口中，_NewEnum 属性必须返回IUnknown 接口，同时dispid = -4 (DISPID_NEWENUM)。修改的IFooItems定义如下：
IFooItems = interface (IDispatch)
property Count : integer;
property Item [Index : integer] : IFoo;
property _NewEnum : IUnknown; dispid -4;
end;
接下来我们要实现_NewEnum属性来返回IEnumVARIANT 接口指针：
下面是一个完整的例子，它创建了一个ASP组件，有一个集合对象用来维护一个email地址列表：
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.
下面是用来测试ASP组件的ASP脚本：
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 "使用For Next 结构"
for i = 0 to DelphiASPObj.Recipients.Count-1
Response.Write "DelphiASPObj.Recipients.Items[" & i & "] = " & _
DelphiASPObj.Recipients.Items(i) & ""
next
Response.Write "使用 For Each 结构"
for each sRecipient in DelphiASPObj.Recipients
Response.Write "收信人 : " & sRecipient & ""
next
Set DelphiASPObj = Nothing
上面这个例子中，集合对象储存的是字符串数据，其实它可以储存任意的COM对象，对于COM对象可以用Delphi定义的TInterfaceList 类来管理集合中的COM对象元素。
下面是一个可重用的类TEnumVariantCollection，它隐藏了IEnumVARIANT接口的实现细节。为了插入TEnumVariantCollection 类到集合对象中去，我们需要实现一个有下列三个方法的接口：
IVariantCollection = interface
//使用枚举器来锁定列表拥有者
function GetController : IUnknown; stdcall;
//使用枚举器来确定元素数
function GetCount : integer; stdcall;
//使用枚举器来返回集合元素
function GetItems (Index : olevariant) : olevariant; stdcall;
end;
修改后的TFooItem的定义如下：
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; //内部集合元素列表;
...
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
//获取IDispatch 接口
Result := FItems.Items [Index] as IDispatch;
end;
最后，我们来实现_NewEnum 属性：
function TFooItems.Get__NewEnum: IUnknown;
begin
Result := TEnumVariantCollection.Create (Self);
end;
