• 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;

  • 相关阅读:
    [LeetCode] Search in Rotated Sorted Array II
    [LeetCode] Search in Rotated Sorted Array
    [LeetCode] Rotate List
    [LeetCode] Rotate Array
    [LeetCode] Product of Array Except Self
    [LeetCode] Recover Binary Search Tree
    [LeetCode] Jump Game II
    [LeetCode] Jump Game
    [LeetCode] Delete Node in a Linked List
    [LeetCode] Climbing Stairs
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/669029.html
Copyright © 2020-2023  润新知