• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

Delphi编程--如何实现一个支持VisualBasic的ForEach调用的COM对象

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

熟悉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 "[email protected]"

      DelphiASPObj.Recipients.AddRecipient "[email protected]"

      DelphiASPObj.Recipients.AddRecipient "[email protected]"

      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;


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
C#调用Delphi的dll之详解-完整版_附有可下载Demo发布时间:2022-07-18
下一篇:
让Delphi的DataSnap发挥最大效率发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap