COM深入编程学习笔记3

类型库，它是一种与编程语言无关的方法，用于定义接口和说明COM服务器。
 
  1.定义类型库
   
   类型库提供了完全说明COM服务器的无确定编程语言的方法。类型库包含很多信息，例如哪个接口是由一个对象实现的、
   
哪个属性和方法是由接口定义的，以及每种方法的参数的数目和类型。

   通常，类型库可作为一种资源集成到COM服务器中，或可作为一个.tlb文件被分发。Delphi把类型库作为一种资源自动添加
   
到COM服务器中，并生成一个tlb文件。

   Delphi(以及大多数其它现代编译器)可以读取存储在类型库中的信息并自动创建一个用来编写一个客户应用程序的输入文件。
   
因此，通常只需要重新分发COM服务器给程序员来编写客户应用程序。如果遇到某人不能从COM服务器中提取类型库，那么也可以

重新分发.tlb文件。

   在delphi出现之前，很多语言被迫使用IDL语言手工编写类型库。进入Delphi编辑器后，可以用类型库编辑器。
   
   具体范例：
   FIle-->New-->Activx-->ActivX library
   FIle-->New-->Activx-->COM Object (选中Include Type Library)
   
    //下面范例是创建基于类型库支持的COM对象，具有跨多语言的通用性
    //注意是TTypedComObjectFactory作为类厂来创建COM对象的。
    //注意COM对象派生自TTypedComObject
    //另外对于COM接口和类的定义都是在类型库编辑器下完成，编辑器会自动创建接口和类的定义框架
    //注意：对于接口下的输入参数可以使用标准的COM数据类型[in]，对于输出参数一律在函数[out] 定义下，要么使用指针，
    //要么使用Olevaraint类型，例如Delphi的字符串那是非标准类型就必须用OleVarant类型来输出。
    ///////////////////////////////////ActivX Library/////////////////////////////////////////
    library TIServer;

    uses
      ComServ,
      DCPTypeServer_TLB in 'DCPTypeServer_TLB.pas',
      AreaIntf in 'AreaIntf.pas' {UnitAuto: CoClass};
    
    exports
      DllGetClassObject,
      DllCanUnloadNow,
      DllRegisterServer,
      DllUnregisterServer;
    
    {$R *.TLB}
    
    {$R *.RES}
    
    begin
    end.
    
    /////////////////////////COM对象接口实现////////////////     
    unit AreaIntf;
    
    interface
    
    uses
      Windows, ActiveX, Classes, ComObj, DCPTypeServer_TLB, StdVcl;
    
    type
      TUnitAuto = class(TTypedComObject, IUnitAuto) //从类型库COM对象继承
      protected
        function Convert(Quantity: Double; InUnit, OutUnit: SYSINT): Double;stdcall; //标准API定义方式
        function Get_Name: WideString; stdcall;              //标准API定义方式
        procedure Set_Name(const Value: WideString); stdcall;//标准API定义方式
        {Declare IUnitAuto methods here}
      end;
    
    implementation
    
    uses ComServ;
    
    function TUnitAuto.Convert(Quantity: Double; InUnit,
      OutUnit: SYSINT): Double;
    begin
      { Stubbed out because we're only interested in the type library }
    end;
    
    function TUnitAuto.Get_Name: WideString;
    begin
      { Stubbed out because we're only interested in the type library }
    end;
    
    procedure TUnitAuto.Set_Name(const Value: WideString);
    begin
      { Stubbed out because we're only interested in the type library }
    end;
    
    initialization
         TTypedComObjectFactory.Create(ComServer, TUnitAuto, Class_UnitAuto,
          ciMultiInstance, tmApartment); //由类型库COM类工厂创建COM对象实例
    end.
      
///////////////////COM对象类型库申明（在定义COM对象时由向导自动生成）///////////////////
//类型库包含COM Server信息
//同时包含COM Object接口定义信息
//由类型库编辑器创建     
unit DCPTypeServer_TLB;


// Type Lib: D:\Book\Chap04\TIServer.tlb (1)
// IID\LCID: {91ADB6E6-4F4D-11D3-B84B-0040F67455FE}\0
// Helpfile:
// DepndLst:
//   (1) v2.0 stdole, (C:\WINNT\System32\STDOLE2.TLB)
//   (2) v4.0 StdVCL, (C:\WINNT\System32\STDVCL40.DLL)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
interface

uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL;

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Non-DISP interfaces: IID_xxxx                                        
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  DCPTypeServerMajorVersion = 1;
  DCPTypeServerMinorVersion = 0;

  LIBID_DCPTypeServer: TGUID = '{91ADB6E6-4F4D-11D3-B84B-0040F67455FE}';

  IID_IUnitAuto: TGUID = '{91ADB6E7-4F4D-11D3-B84B-0040F67455FE}';
  CLASS_UnitAuto: TGUID = '{91ADB6E9-4F4D-11D3-B84B-0040F67455FE}';

// *********************************************************************//
// Declaration of Enumerations defined in Type Library                    
// *********************************************************************//
// Constants for enum AreaUnit
type
  AreaUnit = TOleEnum;
const
  auSquareMeters = $00000000;
  auSquareCentimeters = $00000001;
  auSquareYards = $00000002;
  auSquareFeet = $00000003;
  auSquareInches = $00000004;
  auSquareKilometers = $00000005;
  auSquareMiles = $00000006;
  auAcres = $00000007;

type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  IUnitAuto = interface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  UnitAuto = IUnitAuto;


// *********************************************************************//
// Interface: IUnitAuto
// Flags:     (256) OleAutomation
// GUID:      {91ADB6E7-4F4D-11D3-B84B-0040F67455FE}
// *********************************************************************//
  IUnitAuto = interface(IUnknown)
    ['{91ADB6E7-4F4D-11D3-B84B-0040F67455FE}']
    function  Convert(Quantity: Double; InUnit: SYSINT; OutUnit: SYSINT): Double; stdcall;
    function  Get_Name: WideString; stdcall;
    procedure Set_Name(const Param1: WideString); stdcall;
  end;

// *********************************************************************//
// The Class CoUnitAuto provides a Create and CreateRemote method to          
// create instances of the default interface IUnitAuto exposed by              
// the CoClass UnitAuto. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoUnitAuto = class
    class function Create: IUnitAuto;
    class function CreateRemote(const MachineName: string): IUnitAuto;
  end;


// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object    : TUnitAuto
// Help String      : UnitAuto Object
// Default Interface: IUnitAuto
// Def. Intf. DISP? : No
// Event   Interface:
// TypeFlags        : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  TUnitAutoProperties= class;
{$ENDIF}
  TUnitAuto = class(TOleServer)
  private
    FIntf:        IUnitAuto;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    FProps:       TUnitAutoProperties;
    function      GetServerProperties: TUnitAutoProperties;
{$ENDIF}
    function      GetDefaultInterface: IUnitAuto;
  protected
    procedure InitServerData; override;
    function  Get_Name: WideString;
    procedure Set_Name(const Param1: WideString);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: IUnitAuto);
    procedure Disconnect; override;
    function  Convert(Quantity: Double; InUnit: SYSINT; OutUnit: SYSINT): Double;
    property  DefaultInterface: IUnitAuto read GetDefaultInterface;
  published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
    property Server: TUnitAutoProperties read GetServerProperties;
{$ENDIF}
  end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object    : TUnitAuto
// (This object is used by the IDE's Property Inspector to allow editing
//  of the properties of this server)
// *********************************************************************//
 TUnitAutoProperties = class(TPersistent)
  private
    FServer:    TUnitAuto;
    function    GetDefaultInterface: IUnitAuto;
    constructor Create(AServer: TUnitAuto);
  protected
    function  Get_Name: WideString;
    procedure Set_Name(const Param1: WideString);
  public
    property DefaultInterface: IUnitAuto read GetDefaultInterface;
  published
  end;
{$ENDIF}


procedure Register;

implementation

uses ComObj;

class function CoUnitAuto.Create: IUnitAuto;
begin
  Result := CreateComObject(CLASS_UnitAuto) as IUnitAuto;  //创建本地COM对象，并授权接口引用
end;

class function CoUnitAuto.CreateRemote(const MachineName: string): IUnitAuto;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_UnitAuto) as IUnitAuto; //创建远程COM对象，并授权接口引用
end;

procedure TUnitAuto.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{91ADB6E9-4F4D-11D3-B84B-0040F67455FE}';
    IntfIID:   '{91ADB6E7-4F4D-11D3-B84B-0040F67455FE}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TUnitAuto.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as IUnitAuto;
  end;
end;

procedure TUnitAuto.ConnectTo(svrIntf: IUnitAuto);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TUnitAuto.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TUnitAuto.GetDefaultInterface: IUnitAuto;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TUnitAuto.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TUnitAutoProperties.Create(Self);
{$ENDIF}
end;

destructor TUnitAuto.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TUnitAuto.GetServerProperties: TUnitAutoProperties;
begin
  Result := FProps;
end;
{$ENDIF}

function  TUnitAuto.Get_Name: WideString;
begin
  Result := DefaultInterface.Get_Name;
end;

procedure TUnitAuto.Set_Name(const Param1: WideString);
begin
  DefaultInterface.Set_Name(Param1);
end;

function  TUnitAuto.Convert(Quantity: Double; InUnit: SYSINT; OutUnit: SYSINT): Double;
begin
  Result := DefaultInterface.Convert(Quantity, InUnit, OutUnit);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TUnitAutoProperties.Create(AServer: TUnitAuto);
begin
  inherited Create;
  FServer := AServer;
end;

function TUnitAutoProperties.GetDefaultInterface: IUnitAuto;
begin
  Result := FServer.DefaultInterface;
end;

function  TUnitAutoProperties.Get_Name: WideString;
begin
  Result := DefaultInterface.Get_Name;
end;

procedure TUnitAutoProperties.Set_Name(const Param1: WideString);
begin
  DefaultInterface.Set_Name(Param1);
end;

{$ENDIF}

procedure Register;
begin
  RegisterComponents('Servers',[TUnitAuto]);
end;

end.


    //下面范例是创建基于类型库支持的COM对象，具有跨多语言的通用性
    //注意是TTypedComObjectFactory作为类厂来创建COM对象的。
    //注意COM对象派生自TTypedComObject
    //另外对于COM接口和类的定义都是在类型库编辑器下完成，编辑器会自动创建接口和类的定义框架
    //注意：对于接口下的输入参数可以使用标准的COM数据类型[in]，对于输出参数一律在函数[out] 定义下，要么使用指针，
    //要么使用Olevaraint类型，例如Delphi的字符串那是非标准类型就必须用OleVarant类型来输出。
    ///////////////////////////////////ActivX Library/////////////////////////////////////////
library meterCovert;

uses
  ComServ,
  meterCovert_TLB in 'meterCovert_TLB.pas',
  meterInf in 'meterInf.pas' {TMeteCovert: CoClass};

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

/////////////////////////COM对象接口实现和meterCovert_TLB同步////////////////
//完全由类型库编辑器编辑于meterCovert_TLB文件同步
unit meterInf;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, meterCovert_TLB, StdVcl;

type
  TTMeteCovert = class(TTypedComObject, ITMeteCovert)
  private
    FName : OleVariant;
    procedure Initialize; override; //覆盖初始化虚拟方法
  public
    function Conver(Aparam: Double; nStyle: CovertEnum;
      out AOut: OleVariant): HResult; stdcall;
    function Get_MeteName: OleVariant; stdcall;
    procedure Set_MeteName(Value: OleVariant); stdcall;

    {Declare ITMeteCovert methods here}
  end;

implementation

uses ComServ;

function TTMeteCovert.Conver(Aparam: Double; nStyle: CovertEnum;
  out AOut: OleVariant): HResult;
begin
   case nStyle of
      COV_CHINA:
       begin
         AOut := Aparam;
       end;
      COV_ENGLISH:
       begin
         AOut := Aparam * 0.8;
       end;
      else
       begin
         Result := S_FALSE;
       end;
   end;
   Result := S_OK;
end;

function TTMeteCovert.Get_MeteName: OleVariant;
begin
  Result := FName;
end;

procedure TTMeteCovert.Initialize;
begin
  inherited;
  FName := '我的表测试';
end;

procedure TTMeteCovert.Set_MeteName(Value: OleVariant);
begin
  FName := Value;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TTMeteCovert, Class_TMeteCovert,
    ciMultiInstance, tmApartment);
end.

///////////////////COM对象类型库申明（在定义COM对象时由向导自动生成）///////////////////
//类型库包含COM Server信息
//同时包含COM Object接口定义信息
//由类型库编辑器创建,客户端直接包含该类型库即可调用接口功能
unit meterCovert_TLB;

{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
 

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:       
//   Type Libraries     : LIBID_xxxx                                     
//   CoClasses          : CLASS_xxxx                                     
//   DISPInterfaces     : DIID_xxxx                                      
//   Non-DISP interfaces: IID_xxxx                                       
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  meterCovertMajorVersion = 1;
  meterCovertMinorVersion = 0;

  LIBID_meterCovert: TGUID = '{A5251101-97D1-49D1-886D-5EAB0773D4BA}';

  IID_ITMeteCovert: TGUID = '{41AF9106-9D39-4C43-9A93-3D1F174A337D}';
  CLASS_TMeteCovert: TGUID = '{4EE10370-5ED4-43B4-8681-17F7A05490B0}';

// *********************************************************************//
// Declaration of Enumerations defined in Type Library                   
// *********************************************************************//
// Constants for enum CovertEnum
type
  CovertEnum = TOleEnum;
const
  COV_CHINA = $00000000;
  COV_ENGLISH = $00000001;

type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                   
// *********************************************************************//
  ITMeteCovert = interface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                      
// (NOTE: Here we map each CoClass to its Default Interface)             
// *********************************************************************//
  TMeteCovert = ITMeteCovert;


// *********************************************************************//
// Interface: ITMeteCovert
// Flags:     (256) OleAutomation
// GUID:      {41AF9106-9D39-4C43-9A93-3D1F174A337D}
// *********************************************************************//
  ITMeteCovert = interface(IUnknown)
    ['{41AF9106-9D39-4C43-9A93-3D1F174A337D}']
    function Conver(Aparam: Double; nStyle: CovertEnum; out AOut: OleVariant): HResult; stdcall;
    function Get_MeteName: OleVariant; stdcall;
    procedure Set_MeteName(Value: OleVariant); stdcall;
  end;

// *********************************************************************//
// The Class CoTMeteCovert provides a Create and CreateRemote method to         
// create instances of the default interface ITMeteCovert exposed by             
// the CoClass TMeteCovert. The functions are intended to be used by            
// clients wishing to automate the CoClass objects exposed by the        
// server of this typelibrary.                                           
// *********************************************************************//
  CoTMeteCovert = class
    class function Create: ITMeteCovert;
    class function CreateRemote(const MachineName: string): ITMeteCovert;
  end;

implementation

uses ComObj;

class function CoTMeteCovert.Create: ITMeteCovert;
begin
  Result := CreateComObject(CLASS_TMeteCovert) as ITMeteCovert;
end;

class function CoTMeteCovert.CreateRemote(const MachineName: string): ITMeteCovert;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_TMeteCovert) as ITMeteCovert;
end;

end.

//////////////////////////////////////////////////////////////////////////////
//客户端调用基于类型库的COM对象，原理上和非类型库COM对象调用一样都是基于接口授权引用
//但是基于类型库的COM对象更为标准，可以跨越语言界限
//其他语言可以直接在系统中找到类型注册对象，并生成相应的类型库
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,meterCovert_TLB;

type
  TForm1 = class(TForm)
    btn1: TButton;
    mmo1: TMemo;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
  MeteCovert:ITMeteCovert;
  Rt:OleVariant;
begin
  MeteCovert := CoTMeteCovert.Create;
  mmo1.Lines.Add(  MeteCovert.Get_MeteName );
  MeteCovert.Set_MeteName('改名啦');
  mmo1.Lines.Add(  MeteCovert.Get_MeteName );
  MeteCovert.Conver(899.9,COV_ENGLISH,Rt);
  mmo1.Lines.Add('Cov=' + FloatToStr(Rt));
end;

end.