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;
