中文字幕理论片,69视频免费在线观看,亚洲成人app,国产1级毛片,刘涛最大尺度戏视频,欧美亚洲美女视频,2021韩国美女仙女屋vip视频

常見COM問題解答

如何初始化同COM交互的線程？

    通常如果沒有初始化線程會顯示如下的錯誤信號："CoInitialize has not been called" (800401F0 ) 。

    問題在于每個同COM交互的線程必須使自身初始化并進入一個Apartment?？梢酝ㄟ^加入一個單線程的 Apartment (STA)獲得，也可以進入一個多線程的Apartment (MTA)。

STA是基于Windows的消息隊列實現(xiàn)系統(tǒng)同步的。當COM對象或線程是依賴于線程相關的對象時，比如界面元素，就應該使用STA，下面演示如何初始化一個線程進入STA：

    procedure FooThreadFunc; 

    Begin

      CoInitializeEx (NIL, COINIT_APARTMENTTHREADED);

      ...  ...

      CoUninitialize;

    end;

    處于MTA的對象則可以隨時隨地收到用戶的調用，對象同界面元素無關時應該使用MTA模式，但一定要小心地控制同步，下面是演示如何初始化一個進入MTA的線程：

    procedure FooThreadFunc;

    begin

      CoInitializeEx (NIL, COINIT_MULTITHREADED);

      ...  ...

      CoUninitialize;

    end;

實現(xiàn)、跨越Apartment列集接口指針

    在運行COM Server時經常會遇到"The application called an interface that was marshaled for a different thread" (8001010E)這類錯誤，它是如何產生的呢?

    在Apartment之間傳遞接口指針的時候,如果沒有執(zhí)行Marshal(列集)，就會破壞COM的線程規(guī)則，引起這個錯誤。列集接口指針需要使用CoMarshalInterface 和CoUnmarshalInterface函數(shù)。但實際使用時，我們更多的是用更簡單的CoMarshalInterThreadInterfaceInStream 和 CoGetInterfaceAndReleaseStream API。

    下面的代碼演示了如何在基于不同Aparment的Foo1和Foo2線程之間列集一個接口指針：

    var MarshalStream : pointer;

    //源線程

    procedure Foo1ThreadFunc;  //或者TFoo1.Execute

    var Foo : IFoo;

    begin

      //假設Foo2Thread正處于暫停狀態(tài)

      CoInitializeEx (...);

      Foo := CoFoo.Create;

      //列集

      CoMarshalInterThreadInterfaceInStream (IFoo, Foo, IStream (MarshalStream));

      //告訴Foo2Thread 列集完畢

      Foo2Thread.Resume;

      CoUninitialize;

    end;

    //用戶線程

    procedure Foo2ThreadFunc;  //或TFoo2.Execute

    var Foo : IFoo;

    begin

      CoInitializeEx (...);

      //逆列集

      CoGetInterfaceAndReleaseStream (IStream (MarshalStream), IFoo, Foo);

      MarshalStream := NIL;

      //使用Foo

      Foo.Bar;

      CoUninitialize;

    end;

    上面的列集技術是列集一次然后逆列集一次。如果我們想列集一次然后多次逆列集的話，可以使用(NT 4 SP3) COM提供的全局接口表（Global Interface Table，GIT）。GIT允許列集一個接口指針到一個cookie，然后使用這個Cookie來多次逆列集。使用GIT的話，上面的例子要修改為：

    const

      CLSID_StdGlobalInterfaceTable : TGUID =

      '{00000323-0000-0000-C000-000000000046}';

    type

      IGlobalInterfaceTable = interface(IUnknown)

      ['{00000146-0000-0000-C000-000000000046}']

      function RegisterInterfaceInGlobal (pUnk : IUnknown; const riid: TIID;

      out dwCookie : DWORD): HResult; stdcall;

      function RevokeInterfaceFromGlobal (dwCookie: DWORD): HResult; stdcall;

      function GetInterfaceFromGlobal (dwCookie: DWORD; const riid: TIID; out ppv): HResult; stdcall;

   end;

    function GIT : IGlobalInterfaceTable;

    const

      cGIT : IGlobalInterfaceTable = NIL;

    begin

      if (cGIT = NIL) then

        OleCheck (CoCreateInstance (CLSID_StdGlobalInterfaceTable, NIL, CLSCTX_ALL,

        IGlobalInterfaceTable, cGIT));

        Result := cGIT;

    end;

    var MarshalCookie : dword;

      //源線程

    procedure Foo1ThreadFunc; 

    var Foo : IFoo;

    begin

      CoInitializeEx (...);

      Foo := CoFoo.Create;

      //列集

      GIT.RegisterInterfaceInGlobal (Foo, IFoo, MarshalCookie)

      //告訴Foo2Thread MarshalCookie已經準備好了

      Foo2Thread.Resume;

      CoUninitialize;

    end;

    //用戶線程

    procedure Foo2ThreadFunc;

    var Foo : IFoo;

    begin

      CoInitializeEx (...);

      //逆列集

      GIT.GetInterfaceFromGlobal (MarshalCookie, IFoo, Foo)

      //調用Foo

      Foo.Bar;

      CoUninitialize;

    end;

    另外當不需要列集的時候，不要忘了從GIT中刪除指針：

    GIT.RevokeInterfaceFromGlobal (MarshalCookie);

    MarshalCookie := 0;

    下面實現(xiàn)了一個TGIP類可以簡化調用：

    { TGlobalInterfacePointer

    用法：假定有一個接口指針pObject1,想使接口Iobject1全局化可以使用下面的代碼

    var

      GIP1: TGIP;

    begin

      GIP1 := TGIP.Create (pObject1, IObject1);

    end;

    如果想使pObject1本地化，需要直接存取GIP1 對象變量：

    var

      pObject1: IObject1;

    begin

      GIP1.GetIntf (pObject1);

      pObject1.DoSomething;

    end;

    }

    下面是TGIP類的實現(xiàn)：

    TGIP = class

    protected

    FCookie: DWORD;

    FIID: TIID;

    function IsValid: boolean;

    public

      constructor Create (const pUnk: IUnknown; const riid: TIID);

      destructor Destroy; override;

      procedure GetIntf (out pIntf);

      procedure RevokeIntf;

      procedure SetIntf (const pUnk: IUnknown; const riid: TIID);

      property Cookie: dword read FCookie;

      property IID: TGUID read FIID;

    end;

    { TGIP }

    function TGIP.IsValid: boolean;

    begin

      Result := (FCookie <> 0);

    end;

    constructor TGIP.Create (const pUnk: IUnknown; const riid: TIID);

    begin

      inherited Create;

      SetIntf (pUnk, riid);

    end;

    destructor TGIP.Destroy;

    begin

      RevokeIntf;

      inherited;

    end;

    procedure TGIP.GetIntf (out pIntf);

    begin

      Assert (IsValid);

      OleCheck (GIT.GetInterfaceFromGlobal (FCookie, FIID, pIntf));

    end;

    procedure TGIP.RevokeIntf;

    begin

      if not (IsValid) then Exit;

        OleCheck (GIT.RevokeInterfaceFromGlobal (FCookie));

        FCookie := 0;

        FIID := GUID_NULL;

    end;

    procedure TGIP.SetIntf (const pUnk: IUnknown; const riid: TIID);

    begin

      Assert ((pUnk <> NIL) and not (IsEqualGuid (riid, GUID_NULL)));

      RevokeIntf;

      OleCheck (GIT.RegisterInterfaceInGlobal (pUnk, riid, FCookie));

      FIID := riid;

    end;

實現(xiàn)正確的錯誤處理

    在COM中,每個接口方法必須返回一個錯誤代碼給客戶端，錯誤代碼是標準的32位數(shù)值，也就是我們所熟悉的HRESULT。HRESULT數(shù)值可以分為幾部分：一位用于表示成功或失敗，幾位用于表示錯誤分類，剩下幾位用于表示錯誤代號（COM推薦錯誤代碼應該在0200到FFFF 范圍內。

    雖然HRESULT可以用來指示錯誤，但是它也有很大的局限性，因為除了錯誤代碼，我們可能還想讓COM服務器告訴客戶端錯誤的詳細描述、發(fā)生位置以及客戶在哪兒可以得到更多的相關幫助（通過指定幫助上下文來調用幫助文件）。因此，COM引入了IErrorInfo接口，客戶端可以通過這個接口來獲得額外的錯誤信息。同時如果COM服務器支持IErrorInfo，COM同時建議服務器實現(xiàn)ISupportErrorInfo接口，雖然這個接口不是必須實現(xiàn)的，但一些客戶端，比如Visual Basic將會向服務器請求這個接口。

    Delphi本身已經為我們提供了安全調用處理。當在對象內部產生一個異常時，Delphi會自動俘獲異常并把它轉化為一個COM HRESULT，同時提供一個IErrorInfo 接口用于傳遞給客戶端。這些是通過ComObj單元中的HandleSafeCallException函數(shù)實現(xiàn)的。此外，VCL 類也為我們實現(xiàn)了ISupportErrorInfo 接口。

    下面舉例來說，當在服務器內部產生一個Ewhatever的異常時，它總會被客戶端認為是EOleException異常，EOleException異常包括HRESULT 和IErrorInfo 所包含的所有信息，比如錯誤代號、描述、發(fā)生位置以及上下文相關幫助。而為了提供客戶端所需要信息，服務器必須把EWhatever轉化為EoleSysError異常，同時要確保錯誤代碼為格式化好的HRESULT。比如，假設有一個TFoo對象，它有一個Bar方法。在Bar方法中我們想產生一個異常，異常的錯誤代號為5，描述="錯誤消息"，幫助文件="HelpFile.hlp"，幫助上下文= 1，代碼示意如下：

    uses ComServ;

    const

      CODE_BASE = $200; //推薦代碼在0200 – FFFF之間

    procedure TFoo.Bar;

    begin

      //幫助文件

      ComServer.HelpFileName := 'HelpFile.hlp'; 

      //引發(fā)異常

      raise EOleSysError.Create (

        '錯誤消息', ErrorNumberToHResult (5 + CODE_BASE), //格式化HRESULT

        1 //幫助上下文

      );

    end;

    //格式化Hresult

    function ErrorNumberToHResult (ErrorNumber : integer) : HResult;

    const

      SEVERITY_ERROR = 1;

      FACILITY_ITF = 4;

    Begin

      Result := (SEVERITY_ERROR shl 31) or (FACILITY_ITF shl 16) or word (ErrorNumber);

    end;

    上面的ErrorNumberToHResult函數(shù)就是簡單的把錯誤代號轉化為標準的HRESULT。同時給錯誤代號加上了CODE_BASE (0x200)，以便遵循COM的建議，就是使錯誤代碼位于0200到 FFFF之間。

    下面是客戶端利用EOleException俘獲錯誤的代碼：

    const

     CODE_BASE = $200; 

    procedure CallFooBar;

    var

      Foo : IFoo;

    Begin

      Foo := CoFoo.Create;

      Try

      Foo.Bar;

      Except

      on E : EOleException do

      ShowMessage ('錯誤信息: ' + E.Message + #13 +

        '錯誤代號: ' + IntToStr (HResultToErrorNumber (E.ErrorCode) - CODE_BASE) + #13 +

        '發(fā)生位置: ' + E.Source + #13 +

        '幫助文件: ' + E.HelpFile + #13 +

        '幫助上下文: ' + IntToStr (E.HelpContext)

      );

    end;

    end;

    function HResultToErrorNumber (hr : HResult) : integer;

    begin

      Result := (hr and $FFFF);

    end;

    上述過程其實就是服務器的逆過程，就是從HRESULT中提取錯誤代碼，并顯示額外錯誤信息的過程。

如何實現(xiàn)多重接口

    其實非常非常簡單，比如想建立一個COM對象，它已經支持IFooBar接口了，我們還想實現(xiàn)兩個外部接口IFoo和IBar。IFoo和IBar 接口定義如下：

    IFoo = interface

      procedure Foo;  //隱含返回HRESULT

    end;

    IBar = interface

      procedure Bar; 

    end;

    實現(xiàn)部分：

    type

      TFooBar = class (TAutoObject, IFooBar, IFoo, IBar)

      Protected

      //IfooBar

      ... IFooBar methods here ...

      //IFoo methods

      procedure Foo;

      //IBar methods

      procedure Bar;

      ...

    end;

    procedure TFooBar.Foo;

    begin

    end;

    procedure TFooBar.Bar;

    begin

    end;

    是不是很簡單啊，要注意的是如果IfooBar、IFoo和IBar都是基于IDispatch接口的，TAutoObject 將只會為IFooBar實現(xiàn)IDispatch，基于腳本的客戶端只能看到IFooBar接口方法。

Delphi中定義的COM基類的用途

    Delphi提供了很多基類用于COM開發(fā)：TInterfacedObject、TComObject、TTypedComObject、TAutoObject、TAutoIntfObject、TComObjectFactory、TTypedComObjectFactory、TAutoObjectFactory等。那么這些類適用于哪些條件下呢？

    （1）TInterfacedObject

    TInterfacedObject 只提供對IUnknown接口的實現(xiàn)，如果想創(chuàng)建一個內部對象來實現(xiàn)內部接口的話，TInterfacedObject 就是一個最好的基類。

    （2）TComObject

    TComObject實現(xiàn)了IUnknown、ISupportErrorInfo、標準的COM聚集支持和一個對應的類工廠支持。如果我們想創(chuàng)建一個輕量級的可連接客戶端的基于IUnknown接口的COM對象的話，COM對象就應該從TComObject 類繼承。

    （3）TComObjectFactory

    TComObjectFactory 是同TComObject對象配合工作的。它把對應的TComObject 公開為coclass。TComObjectFactory 提供了coclass 的注冊功能(根據(jù)CLSIDs、ThreadingModel、ProgID等)。還實現(xiàn)了IClassFactory 和 IClassFactory2 接口以及標準的COM 對象許可證支持。簡單地說如果要想創(chuàng)建TComObject對象，就會同時需要TComObjectFactory對象。

    （4）TTypedComObject

    TTypedComObject等于TComObject + 對IProvideClassInfo接口的支持。IProvideClassInfo 是自動化的標準接口用來公開一個對象的類型信息的（比如可獲得的名字、方法、支持的接口等，類型信息儲存在相關的類型庫中）。TTypedComObject 可以用來支持那些在運行時能夠瀏覽類型信息的客戶端，比如Visual Basic的TypeName 函數(shù)期望一個對象能夠實現(xiàn)IProvideClassInfo 接口，以便通過類型信息確定對象的文檔名稱（documented name）。

    （5）TTypedComObjectFactory

    TTypedComObjectFactory 是和TTypedComObject配合工作的。就等于TComObjectFactory + 提供緩存了的TTypedComObject類型信息（ITypeInfo）引用。一句話，創(chuàng)建TTypedComObject必然會同時創(chuàng)建TypedComObjectFactory 類工廠。

    （6）TAutoObject

    TAutoObject 等于TTypedComObject + 實現(xiàn)IDispatch接口。TAutoObject適用于實現(xiàn)支持自動化控制的COM對象。

    （7）TAutoObjectFactory

    TAutoObjectFactory顯然是同TAutoObject密不可分的。它等于TTypedComObjectFactory + 提供了TAutoObject的接口和連接點事件接口的緩存類型信息 (ITypeInfo)。

    （8）TAutoIntfObject

    TAutoIntfObject等于TInterfacedObject +實現(xiàn)了IDispatch接口。同TAutoObject相比， TAutoIntfObject 沒有對應的類工廠支持，這意味著外部客戶端無法直接實例化一個TAutoIntfObject的衍生類。然而，TAutoIntfObject 非常適合作為基于IDispatch接口的下層對象或屬性對象，客戶端可以通過最上層的自動化對象得到對它們的引用。

理解列集的概念

    在進行COM調用的時候，最經常碰到的錯誤恐怕就是"Interface not supported/registered" (80004002)錯誤了。這通常是由于沒有在客戶端機器上注冊類型庫導致的。

    COM的位置透明性是通過代理和存根對象來實現(xiàn)的。當一個客戶端調用一個遠程機器上的COM對象（或是另一個Apartment中的COM對象）時，客戶端的請求首先通過代理，然后代理再通過COM，然后再通過存根才到達真正的對象，其關系如圖1.115所示。

    每當客戶端調用COM對象的方法時，代理都會把方法參數(shù)整理為一個平直數(shù)組然后再傳遞給COM，而COM再把數(shù)組傳遞給存根，由存根負責解包數(shù)組還原參數(shù)，最后服務器對象才會按參數(shù)調用方法，整個過程就成為列集。

    注意代理和存根同樣是COM對象，系統(tǒng)提供了一個缺省的存根和代理，它們實現(xiàn)在 oleaut32.dll 中，對于大多數(shù)的列集處理來說，缺省的存根和代理已經足夠用了，但它只能列集那些自動化兼容的數(shù)據(jù)類型的參數(shù)。

    在類型庫中，必須注釋接口定義的[oleautomation]標識，表明我們希望使用類型庫列集器來列集我們的接口。[oleautomation]標識適用于任意接口（只要方法參數(shù)全是自動化兼容的），認為它只使用于IDispatch類型接口的想法是不正確的。

    由于不能像Visual C++那樣簡單地創(chuàng)建用戶定制的代理-存根DLL，所以Delphi嚴重依賴于類型庫列集器實現(xiàn)列集。同時由于類型庫列集器的列集依賴于類型庫中的信息，所以必須在服務器和客戶端的機器上同時注冊類型庫，否則調用時就會碰到"Interface not supported/registered" 錯誤。

    另外，要注意只有當我們使用前期綁定時才需要注冊類型庫。如果使用后期綁定（比如variant或雙接口綁定），COM會調用IDispatch 接口早已注冊在系統(tǒng)中的代理-存根DLL，因此后期綁定時不需要注冊類型庫文件。

如何實現(xiàn)一個支持Visual Basic的For Each調用的COM對象

    熟悉Visual Basic和ASP開發(fā)的人一定會很熟悉用Visual Basic的For Each語法調用COM集合對象。

    For Each允許一個VB的客戶端很方便地遍歷一個集合中的元素：

    Dim Items as Server.IItems //聲明集合變量

    Dim Item as Server.IItem //聲明集合元素變量

    Set Items = ServerObject.GetItems  //獲得服務器的集合對象

    //用 For Each循環(huán)遍歷集合元素

    For Each Item in Items

      Call DoSomething (Item) 

    Next

    那么什么樣的COM對象支持For Each語法呢？答案就是實現(xiàn)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;

    接下來我們要實現(xiàn)_NewEnum屬性來返回IEnumVARIANT 接口指針：

    下面是一個完整的例子，它創(chuàng)建了一個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

    上面這個例子中，集合對象儲存的是字符串數(shù)據(jù)，其實它可以儲存任意的COM對象，對于COM對象可以用Delphi定義的TInterfaceList 類來管理集合中的COM對象元素。

    下面是一個可重用的類TEnumVariantCollection，它隱藏了IEnumVARIANT接口的實現(xiàn)細節(jié)。為了插入TEnumVariantCollection 類到集合對象中去，我們需要實現(xiàn)一個有下列三個方法的接口：

    IVariantCollection = interface

      //使用枚舉器來鎖定列表擁有者

      function GetController : IUnknown; stdcall;

      //使用枚舉器來確定元素數(shù)

      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;

    最后，我們來實現(xiàn)_NewEnum 屬性：

    function TFooItems.Get__NewEnum: IUnknown;

    begin

      Result := TEnumVariantCollection.Create (Self);

    end;

    這就是全部要做的工作。

    客戶端如何實現(xiàn)對基于IEnumVARIANT-接口的集合對象的枚舉？

    前面提到了在Visual Basic中，我們可以用For Each結構很簡單地實現(xiàn)對基于IEnumVARIANT-接口的集合對象的枚舉。那么在Delphi中有沒有辦法實現(xiàn)類似的操作呢？

    答案是有兩種方法可以做到，第一種比較困難，它需要我們非常熟悉IEnumVARIANT接口方法的調用，特別是reset和next方法。第二種簡單的則是使用TEnumVariant類，它使用起來非常簡單，代碼示意如下：

    uses ComLib;

    var 

      Foo : IFoo;

      Item : olevariant;

      Enum : TEnumVariant;

    Begin

      Foo := CreateOleObject ('FooServer.Foo') as IFoo;  //or CoFoo.Create

      Enum := TEnumVariant.Create (Foo.Items);

      while (Enum.ForEach (Item)) do

        DoSomething (Item);

        Enum.Free;

    end;

    看起來確實和For Each區(qū)別不大了。

如何使用聚集和包含

    COM聚集和包含是兩種重用COM對象的技術。為了弄清為什么需要使用聚集或包含技術，考慮一下下面的情況：假設現(xiàn)在有兩個COM對象Foo (IFoo)和Bar (IBar)。我們想創(chuàng)建一個新的對象FooBar，它提供Foo和Bar兩者的功能。那么我們可以這樣定義新類：

    IFoo = interface

      procedure Foo;

    end;

    IBar = interface

      procedure Bar;

    end;

    type 

      FooBar = class (BaseClass, IFoo, IBar)

      end;

    然后就是當實現(xiàn)IFoo接口的方法時重用Foo，當實現(xiàn)Ibar接口的時候重用Ibar。這時就需要聚集和包含了。

1. 包含

    包含實際上就是初始化一個內部對象，然后把對接口方法的調用請求都傳遞給內部對象，如下為實現(xiàn)對IFoo的包含：

    type

      TFooBar = class (TComObject, IFoo)

      Protected

      //IFoo methods

      procedure Foo;

      protected

      FInnerFoo : IFoo;

      function GetInnerFoo : IFoo;

    end;

    procedure TFooBar.Foo;

    var

      Foo : IFoo;

    Begin

      //獲得內部Foo對象

      Foo := GetInnerFoo;

      //傳遞方法請求給內部的Foo對象

      Foo.Foo;

    end;

    function TFooBar.GetInnerFoo : IFoo;

    begin

      //創(chuàng)建內部的Foo對象

      if (FInnerFoo = NIL) then

        FInnerFoo := CreateComObject (Class_Foo) as IFoo;

        Result := FInnerFoo;

    end;

    如果我們按下面定義實現(xiàn)類的話，由于沒有代理接口請求，所以不能認為是包含：

    type

      TFooBar = class (TComObject, IFoo)

      Protected

      function GetInnerFoo : IFoo;

      property InnerFoo : IFoo read GetInnerFoo implements IFoo;

    end;

    先前的實現(xiàn)和現(xiàn)在的不同在于代理的問題，前者必須公開了IFoo接口，然后通過Foo方法代理對接口的請求給內部對象，而后者是客戶端直接請求InnerFoo提供的IFoo接口方法，沒有代理請求的發(fā)生，所以不是包含。

2. 聚集

    實現(xiàn)包含有時會變得非常煩瑣，因為如果內部對象的接口支持大量的方法時，我們必須重復大量的編碼工作來實現(xiàn)代理請求。還有很多其他原因使得我們需要聚集，簡單地說聚集就是一種直接公開內部對象的機制。

    聚集的首要規(guī)則是只能聚集那些支持聚集的內部對象，也就是說內部對象知道如何實現(xiàn)代理和非代理的接口請求。

    要想了解更多關于代理和非代理的接口請求，參見Dale Rogerson寫的《COM奧秘》一書。

    第二條規(guī)則是當外部對象構建內部對象時，我們需要：

    （1）把外部對象的IUnknown 接口作為CoCreateInstance調用的參數(shù)傳遞給內部對象。

    （2）請求內部對象的IUnknown接口，而且是要IUnknown接口。

    假設Foo對象是支持聚集的，下面讓我們把Foo集成到TFooBar對象中。對IFoo的接口請求是通過Delphi的 implements 關鍵字實現(xiàn)的。代碼示意如下：

    Type

      TFooBar = class (TComObject, IFoo)

      Protected

      function GetControllingUnknown : IUnknown;

      function GetInnerFoo : IFoo;

      property InnerFoo : IFoo read GetInnerFoo implements IFoo;  //exposes IFoo directly from InnerFoo

    protected

      FInnerFoo : IUnknown;

    end;

    function TFoo.GetControllingUnknown : IUnknown;

    begin

      //返回正確的IUnknown接口

      Result := Controller

      Else

        Result := Self as IUnknown;

    end;

    function TFooBar.GetInnerFoo : IFoo;

    begin

      //創(chuàng)建內部Foo對象 object if not yet initialized

      if (FInnerFoo = NIL) then

        CoCreateInstance (

          CLASS_Foo, //Foo的CLSID

          GetControllingUnknown,  //傳遞Iunknown接口給內部對象

          CLSCTX_INPROC,  //假設Foo是進程內的

          IUnknown, //請求Foo的Iunknown接口

          FInnerFoo //輸出內部Foo對象

        );

       //返回內部Foo對象

       Result := FInnerFoo as IFoo;

    end;

    Delphi的TComObject 已經實現(xiàn)了內建的聚集特性，同時任何從TComObject繼承的COM對象也支持聚集。同時不要忘記如果內部對象不支持聚集，那么這時我們只能使用包含。

理解類工廠的實例屬性(SingleInstance, MultiInstance)

    （1）類工廠的實例屬性只對EXE類型的Server有作用。

    （2）實例屬性并不是EXE Server的屬性也不是COM對象的屬性而是類工廠的屬性。它決定的是類工廠如何響應客戶端的請求來創(chuàng)建對象的方式。所以所謂“一個Server生成一個對象和一個Server創(chuàng)建多個對象”的說法是完全錯誤的。

    實例屬性的真正意義其實是：

    每一個COM服務器中的對象都會有一個相應的類工廠，每當客戶端請求創(chuàng)建服務器中的對象時，COM將會要求對象的類工廠來創(chuàng)建這個對象。當EXE型的Server運行時會注冊類工廠（當Server結束時又會被注銷），類工廠的注冊有三種實例模式：SingleUse、MultiUse和MultiSeparateUse。這里我們只討論SingleUse和MultiUse這兩種最常用的模式。

    SingleUse意味著類工廠只創(chuàng)建最多一個相應對象的實例。在一個SingleUse的類工廠創(chuàng)建完它的一個實例后，COM將會注銷它。因此，當下一個客戶端請求創(chuàng)立一個對象時，COM 無法找到已注冊的類工廠，它就會啟動另一個EXE Server來獲得新的類工廠，這就意味著如果前一個EXE Server運行沒有結束，這時系統(tǒng)中會有兩個EXE Server在同時運行。

    MultiUse則意味著可以創(chuàng)建任意多個類工廠的實例。這意味著只要EXE Server不終止運行，則COM就不會注銷類工廠，也就是說同時只可能有一個EXE Server運行并響應客戶端創(chuàng)建相應對象的請求。

    對于Delphi來說，實例模式相當于：

    ciSingleInstance = SingleUse

    ciMultiInstance = MultiUse

如何實現(xiàn)支持GetActiveObject函數(shù)的COM服務器

    對于Microsoft Office來說，可以通過GetActiveObject函數(shù)獲得系統(tǒng)中激活的Office程序：

    var

      Word : variant;

    Begin

      //連接到正在運行的Word實例，

      //如果沒有運行的實例，會產生異常

      Word := GetActiveOleObject ('Word.Application');

    end;

    那么GetActiveOleObject函數(shù)是如何知道word是否正在運行的呢？又該如何實現(xiàn)支持GetActiveOleObject函數(shù)的COM Server呢？

    需要把我們的COM Server注冊到COM的運行對象表中去（Running Object Table，ROT），這可以通過調用RegisterActiveObject API實現(xiàn)：

    function RegisterActiveObject (

      unk: IUnknown; //要注冊的對象

      const clsid: TCLSID; //對象的CLSID

      dwFlags: Longint; //注冊標志通常使用ACTIVEOBJECT_STRONG

      out dwRegister: Longint  //成功注冊后返回的句柄

    ): HResult; stdcall;

    有注冊自然就應該有撤消注冊，撤消注冊可以使用RevokeActiveObject API：

    function RevokeActiveObject (

      dwRegister: Longint;   //先前調用RegisterActiveObject時返回的句柄

      pvReserved: Pointer    //保留參數(shù)，須設為nil

    ): HResult; stdcall;

    要注意的是把一個COM對象注冊到ROT中去，意味著只有當服務器從ROT撤消注冊后，服務器才能終止運行，顯然當不需要Server時，應該從ROT中把COM對象撤消，那么誰以及什么時候應該從ROT中撤消COM對象呢？

    比較合適的辦法是當客戶端發(fā)出Quit或Exit命令時由服務器自己進行撤銷。

    詳細的解決方案可參見Microsoft的自動化程序員參考。

    另外下面要談到的ROT的內容主要針對EXE類型的Server，對于進程內的DLL型Server來說，決定何時注冊/撤消ROT比較復雜，因為DLL Server的生命期是依賴于客戶端的。

    假設我們想讓一個全局的Foo對象注冊到ROT中，代碼如下：（在DPR文件中）

    begin

      Application.Initialize;

      RegisterGlobalFoo;

      Application.CreateForm(TForm1, Form1);

      Application.Run;

    end.

    Var

      GlobalFooHandle : longint = 0;

    procedure RegisterGlobalFoo;

    var

      GlobalFoo : IFoo;

    Begin

      //創(chuàng)建Foo的實例

      GlobalFoo := CoFoo.Create;

      //注冊到ROT

      OleCheck (RegisterActiveObject (

        GlobalFoo, //Foo的實例

        Class_Foo, //Foo的CLSID

        ACTIVEOBJECT_STRONG,

        GlobalFooHandle //注冊后返回句柄

      ));

    end;

    然后我們?yōu)?/span>Foo (IFoo) 添加一個Quit方法:

    procedure TFoo.Quit;

    begin

      RevokeGlobalFoo;

    end;

    procedure RevokeGlobalFoo;

    begin

      if (GlobalFooHandle <> 0) then

      begin

        //撤銷

        OleCheck (RevokeActiveObject (

          GlobalFooHandle, NIL

        ));

        GlobalFooHandle := 0;

      end;

    end;

    下面是一個客戶端使用GetActiveOleObject API調用服務器的例子：

    var

      FooUnk : IUnknown;

      Foo : IFoo;

    Begin

      if (Succeeded (GetActiveObject (

        Class_Foo, //Foo的CLSID

        NIL, //保留參數(shù)，這里用NIL

        FooUnk //從ROT返回Foo )))

      then begin

        //請求IFoo接口

        Foo := FooUnk as IFoo;

        //......

        //終止全局的Foo,從ROT撤銷

        Foo.Quit;

      end;

    end;

    Delphi本身還有一個GetActiveOleObject函數(shù)使用對象的PROGID作為參數(shù)而不是對象的CLSID。GetActiveOleObject內部叫GetActiveObject，只工作于自動化對象。

如何實現(xiàn)支持自動化缺省屬性語法的屬性

    假設我們要創(chuàng)建下面這樣一個自動化接口：

    ICollection = interface (IDispatch)

      property Item [Index : variant] : variant;

    end;

    那么客戶端則可以通過ICollection 接口指針像下面這樣獲得集合中的項目：

    Collection.Item [Index]

    但我們有時會很懶，希望能按下面的方式調用：

    Collection [Index]

    允許客戶端使用這種簡化的語法會帶來很大的方便，特別是要調用很深層次的子對象的方法時，比較一下下面兩種調用方法的方便程度：

    Collection.Item [Index].SubCollection.Item [Index].SubsubCollection.Item [Index]

    Collection [Index].SubCollection [Index].SubsubCollection [Index]

    顯然是后者要方便得多，實現(xiàn)缺省的屬性語法支持同樣非常方便，在類型庫編輯器中，只要簡單地標記Item [] 屬性的dispid值為0 (DISPID_VALUE)就可以了。

    因為缺省屬性支持是基于dispids的，它只能在自動化接口中有作用。對于純的虛方法表接口，不提供這方面的支持。

COM 組件分類

    很多時候我們需要枚舉一些功能類似的COM對象,例如假設想利用COM來提供插件的功能,那么宿主程序如何才能知道哪個COM對象可以作為插件呢?有沒有什么標準的方法來實現(xiàn)COM識別呢?

    在Windows 98/2000下可以通過組件分類來解決這個問題。簡單地說，組件分類就是把實現(xiàn)一些通用功能的COM對象分為一組?？蛻舳顺绦蚩梢苑奖愕卮_定要使用的COM對象。同其他COM對象類似，每個分類也要用一個唯一的標識符GUID來表示,這就是CATID (類別ID)。

    Windows定義了ICatRegister和ICatInformation這兩個接口來提供組件分類服務。實現(xiàn)了ICatRegister和ICatInformation接口組件的類GUID是CLSID_StdComponentCategoryMgr。我們可以使用ICatRegister接口的RegisterCategories方法來注冊一個或多個類別。RegisterCategories方法需要兩個參數(shù)，第一個參數(shù)確定有多少個類別將被注冊，第二個參數(shù)是一個TCategoryInfo 類型的指針數(shù)組。TCategoryInfo聲明如下：

    TCATEGORYINFO = record

      catid: TGUID; //類別 ID

      lcid: UINT;   //本地化 ID, 用于多語言支持

      szDescription: array[0..127] of WideChar; //類別描述

    end;

    要想注冊一個COM對象的類別，可以使用ICatRegister接口的RegisterClassImplCategories方法。RegisterClassImplCategories方法使用兩個參數(shù)，一個是要注冊的COM對象的CLSID，一個是要注冊的類別數(shù)及類別記錄(TcategoryInfo)的數(shù)組。對于客戶端來說，為了掃描所有某一類別的COM對象，可以使用ICatInformation 接口的EnumClassesOfCategories方法。EnumClassesOfCategories方法需要五個參數(shù)，但通常只需要提供其中的三個參數(shù)就可以了，一個參數(shù)用來表明我們感興趣的類別數(shù)，第二個參數(shù)是類別數(shù)組，最后一個參數(shù)是用來匹配COM對象的CLSID/GUID的枚舉器。示意代碼如下：

    unit uhdshake;

    interface

    uses

      Windows,

      ActiveX,

      ComObj;

    type

      TImplementedClasses = array [0..255] of TCLSID;

      function GetImplementedClasses (var ImplementedClasses : TImplementedClasses) : integer;

      procedure RegisterClassImplementation (const CATID, CLSID : TCLSID; const sDescription : String; bRegister : boolean);

    implementation

      function GetImplementedClasses (CategoryInfo : TCategoryInfo; var ImplementedClasses : TImplementedClasses) : integer;

    var

      CatInfo : ICatInformation;

      Enum  : IEnumGuid;

      Fetched : UINT;

    begin

      Result := 0;

      CatInfo := CreateComObject (CLSID_StdComponentCategoryMgr) as ICatInformation;

      OleCheck (CatInfo.EnumClassesOfCategories (1, @CategoryInfo,0,nil,Enum));

      if (Enum <> nil) then

      begin

        OleCheck (Enum.Reset);

        OleCheck (Enum.Next (High (ImplementedClasses), ImplementedClasses [1], Fetched));

        Result := Fetched;

      end;

    end;

    procedure RegisterClassImplementation (const CATID, CLSID : TCLSID; const sDescription : String; bRegister : boolean);

    var

      CatReg : ICatRegister;

      CategoryInfo : TCategoryInfo;

    begin

      CoInitialize (nil);

      CategoryInfo.CATID := CATID;

      CategoryInfo.LCID  := LOCALE_SYSTEM_DEFAULT;  //dummy

      StringToWideChar(sDescription, CategoryInfo.szDescription, Length(sDescription) + 1);

      CatReg := CreateComObject (CLSID_StdComponentCategoryMgr) as ICatRegister;

      if (bRegister) then

      begin

        OleCheck (CatReg.RegisterCategories (1, @CategoryInfo));

        OleCheck (CatReg.RegisterClassImplCategories (CLSID, 1, @CategoryInfo));

      end

      else

      begin

       OleCheck(CatReg.UnregisterClassImplCategories(CLSID,1,@CategoryInfo));

       DeleteRegKey ('CLSID\' + GuidToString (CLSID) + '\' + 'Implemented Categories');

      end;

      CatReg := nil;

      CoUninitialize;

    end;

    end.

    客戶端可以使用GetImplementedClasses方法來獲得所有符合某一類別的COM對象的CLSID。注意這里使用TImplementedClasses 類型作為所有獲得的CLSID的容器。TImplementedClasses 類型簡單的定義為256個CLSID的數(shù)組，對于大多數(shù)情況來說已經足夠了。封裝的RegisterClassImplementation方法是用來按類別注冊或撤消COM對象的。