COM design and implementation example
Original author: Small Wang Zhidong, Wang Jian.
Creative Date: Friday, April 5, 2002
The component object model is a cross-platform technology, one of the technical implementation methods of modern object-oriented analysis and design, and the COM technology has a strong practical value on the application of real system applications.
OOA -> OOD -> OOP with pure object-oriented technology analysis design implementation system
A simple example is given to showcase its charm. System Description: This system is a multi-user login management system. The user is required to log in to the system by entering the user number and password. If the login is successful, the success message is displayed, otherwise the error message is displayed. System Analysis: The extraction of the class is extracted from the keyword, and the user administrator class is derived according to the user class.
COM interface definition
Unit unionComs_TLB;
// ******************************************************** *********************** //
// Warning
// -------
// the Types Declared in this File WERE generated from Data Read from A
// Type library. If this type library is expectly (VIA)
// Another Type library referring to this type library) Re-import, 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 model. 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)
// ******************************************************** *********************** //
{$ TYPEDDRESS 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 type defined in TypeLibrary
// ******************************************************** ******************** //
Iusergroup = interface;
Iuse = interface;
Iuserdisp = dispinterface;
// ******************************************************** ******************** //
// Declaration of Coclasses Defined in Type Library
// (NOTE: Here We Map Each Coclass To Its Default Interface)
// ******************************************************** ******************** //
Usergroup = iusergroup;
User = iuse;
// ******************************************************** ******************** //
// Interface: iusergroup
// Flags: (4096) Dispatchable
// Guid: {D168EB08-8C53-41F7-9B4C-B1EA0120C1DA}
// ******************************************************** ******************** //
Iusergroup = interface (idispatch) ['{D168EB08-8C53-41F7-9B4C-B1EA0120C1DA}']
Function Creger; const username: wideString; connection;
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; WideString;
Const cfmpwd: widestring): Integer; SaFECALL;
Property Name: WideString Read_name Write set_name;
Property ID: Integer Read_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; WideString;
Const cfmpwd: widestring): Integer; DISPID 5;
// ******************************************************** ******************** //
// the class packageergroup provides a create and createremote Method to
// Create Instances of the default interface iusergroup exposed by
// The coclass usergroup. The functions area intended to be buy by
// clients wishing to automate the coclass objects exposed by The CoClass Objects
// Server of this Typelibrary.
// ******************************************************** ******************** //
COMsergroup = Class
Class Function Create: iusergroup;
Class Function CreateRemote (const machinename: string): iusergroup;
END;
// ******************************************************** ******************** //
// the class packager provides a create and createremote Method To
// Create Instances of the default interface iuser eXPOSED BY
// The coclass user. The functions area intended to be used by
// clients wishing to automate the coclass objects exposed by The CoClass Objects
// Server of this Typelibrary.
// ******************************************************** ******************** //
COMser = Class
Class Function Create: iuse;
Class Function CreateRemote (const machinename: string): iuse;
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: iuse;
Begin
Result: = CreateComobject (Class_user) AS iUser;
END;
Class Function Couser.createremote (const Machinename: String): iuse;
Begin
Result: = CreateRemoteComobject (Machinename, Class_user) AS iuse;
End.
COM interface implementation
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 Creger (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: = COMser.create as iuse;
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.
Realization of client programs
Create User Button code implementation
Procedure TFORM1.BUTTON1CLICK (Sender: TOBJECT); VAR
Ausergroup: iusergroup;
Auser: iuse;
Begin
Auser: = nil;
Ausergroup: = dousergroup.create;
Ausergroup.createuser (10, 'WZD', '912', AUSER);
ShowMessage (auser.name);
Auser.changePassword ('', '912', '912');
ShowMessage (AUSER.PASSWORD);
END;
Example Download: http://www.megspace.com/computers/coreware/
