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;

转载于:https://www.cnblogs.com/MaxWoods/archive/2007/03/09/669029.html