VC语言

本类阅读TOP10
·VC++ 学习笔记(二)
·用Visual C++打造IE浏览器(1)
·每个开发人员现在应该下载的十种必备工具
·教你用VC6做QQ对对碰外挂程序
·Netmsg 局域网聊天程序
·Windows消息大全
·VC++下使用ADO编写数据库程序
·VC++学习笔记(四)
·非法探取密码的原理及其防范
·怎样在VC++中访问、修改注册表

→ 分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
COM设计与实现范例

作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

COM设计与实现范例

原创作者： 小王志东，王健。

创作日期：2002年4月5日星期五

组件对象模型是一种跨平台技术，是现代面向对象分析与设计的技术实现手段之一，就现实系统应用来看，COM技术有着很强的实用价值。

OOA -> OOD -> OOP 用纯面向对象技术分析设计实现系统

现就给出一个简单的范例来展示其魅力。系统描述：本系统是一个多用户登录管理系统。要求用户通过输入用户编号和密码登录系统，如登录成功则显示成功消息，否则显示错误消息。系统分析：类的抽取，根据关键词抽取出用户类，根据用户类衍生出用户管理员类。

COM接口定义 

 

unit UnionComs_TLB;

 

// ************************************************************************ //

// WARNING                                                                   

// -------                                                                    

// The types declared in this file were generated from data read from a      

// Type Library. If this type library is explicitly or indirectly (via       

// another type library referring to this type library) re-imported, or the  

// 'Refresh' command of the Type Library Editor activated while editing the  

// Type Library, the contents of this file will be regenerated and all       

// manual modifications will be lost.                                        

// ************************************************************************ //

 

// PASTLWTR : $Revision:   1.130  $

// File generated on 2002-4-5 11:34:29 from Type Library described below.

 

// ************************************************************************  //

// Type Lib: D:\stevenbob\exmines\UnionComGroup\Coms\UnionComs.tlb (1)

// LIBID: {A5265797-1AE4-4465-B5BA-67CB3E5F615E}

// LCID: 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.

{$WARN SYMBOL_PLATFORM OFF}

{$WRITEABLECONST ON}

 

interface

 

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

 

 

// *********************************************************************//

// 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

  UnionComsMajorVersion = 1;

  UnionComsMinorVersion = 0;

  LIBID_UnionComs: TGUID = '{A5265797-1AE4-4465-B5BA-67CB3E5F615E}';

  IID_IUserGroup: TGUID = '{D168EB08-8C53-41F7-9B4C-B1EA0120C1DA}';

  CLASS_UserGroup: TGUID = '{91648D17-4920-48A1-BC8E-94E6A70AA31B}';

  IID_IUser: TGUID = '{8CC77A6A-0D6B-4646-8DD2-D3E3853C46B7}';

  CLASS_User: TGUID = '{EA6025AF-6F8C-4201-8DF4-BE5DB86D061A}';

type

// *********************************************************************//

// Forward declaration of types defined in TypeLibrary                   

// *********************************************************************//

  IUserGroup = interface;

  IUser = interface;

  IUserDisp = dispinterface;

 

// *********************************************************************//

// Declaration of CoClasses defined in Type Library                      

// (NOTE: Here we map each CoClass to its Default Interface)             

// *********************************************************************//

  UserGroup = IUserGroup;

  User = IUser;

 

 

// *********************************************************************//

// Interface: IUserGroup

// Flags:     (4096) Dispatchable

// GUID:      {D168EB08-8C53-41F7-9B4C-B1EA0120C1DA}

// *********************************************************************//

  IUserGroup = interface(IDispatch)

    ['{D168EB08-8C53-41F7-9B4C-B1EA0120C1DA}']

    function  CreateUser(ID: Integer; const UserName: WideString; const UserPwd: WideString;

                         out ppUser: User): HResult; stdcall;

    function  GetCount(out plCount: Integer): HResult; stdcall;

  end;

// *********************************************************************//

// Interface: IUser

// Flags:     (4416) Dual OleAutomation Dispatchable

// GUID:      {8CC77A6A-0D6B-4646-8DD2-D3E3853C46B7}

// *********************************************************************//

  IUser = interface(IDispatch)

    ['{8CC77A6A-0D6B-4646-8DD2-D3E3853C46B7}']

    function  Get_Name: WideString; safecall;

    procedure Set_Name(const Value: WideString); safecall;

    function  Get_ID: Integer; safecall;

    procedure Set_ID(Value: Integer); safecall;

    function  Get_Password: WideString; safecall;

    function  ChangePassword(const OldPwd: WideString; const NewPwd: WideString;

                             const CfmPwd: WideString): Integer; safecall;

    property Name: WideString read Get_Name write Set_Name;

    property ID: Integer read Get_ID write Set_ID;

    property Password: WideString read Get_Password;

  end;

 

// *********************************************************************//

// DispIntf:  IUserDisp

// Flags:     (4416) Dual OleAutomation Dispatchable

// GUID:      {8CC77A6A-0D6B-4646-8DD2-D3E3853C46B7}

// *********************************************************************//

  IUserDisp = dispinterface

    ['{8CC77A6A-0D6B-4646-8DD2-D3E3853C46B7}']

    property Name: WideString dispid 2;

    property ID: Integer dispid 3;

    property Password: WideString readonly dispid 4;

    function  ChangePassword(const OldPwd: WideString; const NewPwd: WideString;

                             const CfmPwd: WideString): Integer; dispid 5;

  end;

 

// *********************************************************************//

// The Class CoUserGroup provides a Create and CreateRemote method to         

// create instances of the default interface IUserGroup exposed by             

// the CoClass UserGroup. The functions are intended to be used by            

// clients wishing to automate the CoClass objects exposed by the        

// server of this typelibrary.                                           

// *********************************************************************//

  CoUserGroup = class

    class function Create: IUserGroup;

    class function CreateRemote(const MachineName: string): IUserGroup;

  end;

 

// *********************************************************************//

// The Class CoUser provides a Create and CreateRemote method to         

// create instances of the default interface IUser exposed by             

// the CoClass User. The functions are intended to be used by            

// clients wishing to automate the CoClass objects exposed by the        

// server of this typelibrary.                                           

// *********************************************************************//

  CoUser = class

    class function Create: IUser;

    class function CreateRemote(const MachineName: string): IUser;

  end;

 

implementation

 

uses ComObj;

 

class function CoUserGroup.Create: IUserGroup;

begin

  Result := CreateComObject(CLASS_UserGroup) as IUserGroup;

end;

 

class function CoUserGroup.CreateRemote(const MachineName: string): IUserGroup;

begin

  Result := CreateRemoteComObject(MachineName, CLASS_UserGroup) as IUserGroup;

end;

 

class function CoUser.Create: IUser;

begin

  Result := CreateComObject(CLASS_User) as IUser;

end;

 

class function CoUser.CreateRemote(const MachineName: string): IUser;

begin

  Result := CreateRemoteComObject(MachineName, CLASS_User) as IUser;

end;

 

end.

COM接口的实现

unit uUnionComsImpl;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

//  ActiveX, Mtsobj, Mtx, ComObj, UnionComs_TLB, StdVcl;

    Windows, ActiveX, Classes, ComObj, UnionComs_TLB, StdVcl;

type

  TUserRec = record

    Intf: IUser;

    bUsed: Boolean;

  end;

   TUserGroup = class(TAutoObject, IUserGroup)

  private

    FUserArray: array of TUserRec;

  protected

    function CreateUser(ID: Integer; const UserName, UserPwd: WideString;

      out ppUser: User): HResult; stdcall;

    function GetCount(out plCount: Integer): HResult; stdcall;

  public

    destructor Destroy; override;

    procedure Initialize; override;

  end;

 implementation

 uses ComServ;

 function TUserGroup.CreateUser(ID: Integer; const UserName,

  UserPwd: WideString; out ppUser: User): HResult;

var

  AIntf: IUser;

begin

  SetLength(FUserArray, Length(FUserArray) + 1);

  AIntf := CoUser.Create as IUser;

  FUserArray[Length(FUserArray) - 1].Intf := AIntf;

  FUserArray[Length(FUserArray) - 1].bUsed := True;

  AIntf.Name := UserName;

  AIntf.ID := ID;

  ppUser := FUserArray[Length(FUserArray) - 1].Intf;

end;

 destructor TUserGroup.Destroy;

var

  i: Integer;

begin

  for i := Low(FUserArray) to High(FUserArray) do

  begin

    FUserArray[i].Intf := nil;

    FUserArray[i].bUsed := False;

  end;

  SetLength(FUserArray, 0);

  inherited Destroy;

end;

 function TUserGroup.GetCount(out plCount: Integer): HResult;

begin

  plCount := Length(FUserArray);

end;

 procedure TUserGroup.Initialize;

begin

  inherited;

 end;

 initialization

  TAutoObjectFactory.Create(ComServer, TUserGroup, Class_UserGroup,

    ciMultiInstance, tmApartment);

end.

 客户端程序的实现

 Create User Button 的代码实现

procedure TForm1.Button1Click(Sender: TObject);

var

  AUserGroup: IUserGroup;

  AUser: IUser;

begin

  AUser := nil;

  AUserGroup := CoUserGroup.Create;

  AUserGroup.CreateUser(10, 'WZD', '912', AUser);

  ShowMessage(AUser.Name);

  Auser.ChangePassword('', '912', '912');

  ShowMessage(AUser.Password);

end;

 实例下载: http://www.megspace.com/computers/coreware/

相关文章：

相关软件：