Link to home
Start Free TrialLog in
Avatar of bertverhees
bertverhees

asked on

Please simple code example of COM Aggregation

I have following situation, simplified

Connection COM object, people connect to this and the object creates a list of objects of type unknown, depends on situation.

For example
People can ask a list of Patients, or a list of hospitals, or one of the other 170 objects the can matter. But for simplicity let us stick to these two or better one.

So the Connection COM-object does not know the kind of objects that are in the list, enven the list does not know.
The calling application does know what objects the Connection-objects has in list, so it knows which properties there are.
That is why I want to use Aggregation, the Connection-object cannot implement stubs for all possible objects, so the object need to publish their properties themselve.

To keep it simple, the calling application request a list of Patients, and wants to pick one of them to ask properties of that Patient, how do I write code like this?

I have a com-object, in-process, called Connection.dll, with interface IConnection
Connection has one property, that is List, for simplicity Items is sufficient.

I have a com-object patient.dll with Interface IPatient, two properties, Name an Address
Address also is a COM-object with one property Street

Please send me some example code, which shows me how to write the
Connection.dll
Patient.dll
Adress.dll
Calling application to make it show Patient.name and Patient.Address.Street

For simplicity the wanted Patient is Item[0] in the list.

Thanks.
Bert Verhees
Avatar of TomBig
TomBig

hello bertverhees

here is some code that worked for me.

library Project1;

uses
  ComServ,
  Project1_TLB in 'Project1_TLB.pas',
  Unit1 in 'Unit1.pas' {Connection: CoClass};

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

unit Unit1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, Project1_TLB, StdVcl, Classes;

type
  TConnection = class(TAutoObject, IConnection)
  private
    fList: TInterfaceList;
  protected
    function Get_Items(idx: Integer): IDispatch; safecall;
    procedure Set_Items(idx: Integer; const Value: IDispatch); safecall;
  public
    procedure Initialize; override;
    destructor Destroy; override;
  end;

  TPatient = class(TAutoObject, IPatient)
  private
    fName: WideString;
    fAdress: IAdress;
  protected
    function Get_Name: WideString; safecall;
    procedure Set_Name(const Value: WideString); safecall;
    function Get_Adress: IAdress; safecall;
    procedure Set_Adress(const Value: IAdress); safecall;
  end;

  TAdress = class(TAutoObject, IAdress)
  private
    fStreet: WideString;
  protected
    function Get_Street: WideString; safecall;
    procedure Set_Street(const Value: WideString); safecall;
  end;

implementation

uses ComServ;

destructor TConnection.Destroy;
begin
  fList.Free;
  inherited;
end;

function TConnection.Get_Items(idx: Integer): IDispatch;
begin
  result:=fList.Items[idx] as IDispatch;
end;

procedure TConnection.Initialize;
var
  NewPatient: IPatient;
  NewAdress: IAdress;
begin
  inherited;
  fList:=TInterfaceList.Create;

  //Add some patients

  NewPatient:=TPatient.Create as IPatient;
  NewAdress:=TAdress.Create as IAdress;
  NewAdress.Street:='Somestreet 11';
  NewPatient.Name := 'Some Name';
  NewPatient.Adress := NewAdress;
  fList.Add(NewPatient);

end;

procedure TConnection.Set_Items(idx: Integer; const Value: IDispatch);
begin
  fList.Items[idx]:=Value;
end;

{ TAdress }

function TAdress.Get_Street: WideString;
begin
  result:=fStreet;
end;

procedure TAdress.Set_Street(const Value: WideString);
begin
   fStreet:=Value;
end;

{ TPatient }

function TPatient.Get_Name: WideString;
begin
  result:=fName;
end;

procedure TPatient.Set_Name(const Value: WideString);
begin
  fName:=Value;
end;

function TPatient.Get_Adress: IAdress;
begin
  result:=fAdress;
end;

procedure TPatient.Set_Adress(const Value: IAdress);
begin
  fAdress:=Value;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TConnection, Class_Connection,
    ciMultiInstance, tmApartment);
  TAutoObjectFactory.Create(ComServer, TPatient, Class_Patient,
    ciMultiInstance, tmApartment);
  TAutoObjectFactory.Create(ComServer, TAdress, Class_Adress,
    ciMultiInstance, tmApartment);
end.

unit Project1_TLB;

// ************************************************************************ //
// WARNUNG                                                                    
// -------                                                                    
// Die in dieser Datei deklarierten Typen wurden aus Daten einer Typbibliothek
// generiert. Wenn diese Typbibliothek explizit oder indirekt (über eine    
// andere Typbibliothek) reimportiert wird oder wenn die Anweisung            
// 'Aktualisieren' im Typbibliotheks-Editor während des Bearbeitens der    
// Typbibliothek aktiviert ist, wird der Inhalt dieser Datei neu generiert und
// alle manuell vorgenommenen Änderungen gehen verloren.                          
// ************************************************************************ //

// PASTLWTR : 1.2
// Datei generiert am 17.09.2004 10:56:39 aus der unten beschriebenen Typbibliothek.

// ************************************************************************  //
// Typbib: C:\Programme\Borland\Delphi7\Projects\Project1.tlb (1)
// LIBID: {3837BBEA-BB11-46B7-BEC5-29DECCFF471A}
// LCID: 0
// Hilfedatei:
// Hilfe-String: Project1 Bibliothek
// DepndLst:
//   (1) v2.0 stdole, (C:\WINNT\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit muß ohne Typüberprüfung für Zeiger compiliert werden.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

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

// *********************************************************************//
// In dieser Typbibliothek deklarierte GUIDS . Es werden folgende        
// Präfixe verwendet:                                                    
//   Typbibliotheken     : LIBID_xxxx                                    
//   CoClasses           : CLASS_xxxx                                    
//   DISPInterfaces      : DIID_xxxx                                      
//   Nicht-DISP-Schnittstellen: IID_xxxx                                      
// *********************************************************************//
const
  // Haupt- und Nebenversionen der Typbibliothek
  Project1MajorVersion = 1;
  Project1MinorVersion = 0;

  LIBID_Project1: TGUID = '{3837BBEA-BB11-46B7-BEC5-29DECCFF471A}';

  IID_IConnection: TGUID = '{C0C693B4-18D9-49BA-9EA6-AFFC5490B132}';
  CLASS_Connection: TGUID = '{17B74A4A-2A90-42F9-88F2-C35532D1D02C}';
  IID_IAdress: TGUID = '{7CFB29E0-13DE-4192-A8DB-10FB89EC435D}';
  CLASS_Adress: TGUID = '{BEC37A7B-68F0-4635-A838-07DAAFB86100}';
  IID_IPatient: TGUID = '{67574B23-5335-4760-8729-A0851C9B75B1}';
  CLASS_Patient: TGUID = '{99CDD789-F564-4D24-8EC5-90A7F83EE437}';
type

// *********************************************************************//
// Forward-Deklaration von in der Typbibliothek definierten Typen        
// *********************************************************************//
  IConnection = interface;
  IConnectionDisp = dispinterface;
  IAdress = interface;
  IAdressDisp = dispinterface;
  IPatient = interface;
  IPatientDisp = dispinterface;

// *********************************************************************//
// Deklaration von in der Typbibliothek definierten CoClasses            
// (HINWEIS: Hier wird jede CoClass zu ihrer Standardschnittstelle        
// zugewiesen)                                                            
// *********************************************************************//
  Connection = IConnection;
  Adress = IAdress;
  Patient = IPatient;


// *********************************************************************//
// Schnittstelle: IConnection
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {C0C693B4-18D9-49BA-9EA6-AFFC5490B132}
// *********************************************************************//
  IConnection = interface(IDispatch)
    ['{C0C693B4-18D9-49BA-9EA6-AFFC5490B132}']
    function Get_Items(idx: Integer): IDispatch; safecall;
    procedure Set_Items(idx: Integer; const Value: IDispatch); safecall;
    property Items[idx: Integer]: IDispatch read Get_Items write Set_Items;
  end;

// *********************************************************************//
// DispIntf:  IConnectionDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {C0C693B4-18D9-49BA-9EA6-AFFC5490B132}
// *********************************************************************//
  IConnectionDisp = dispinterface
    ['{C0C693B4-18D9-49BA-9EA6-AFFC5490B132}']
    property Items[idx: Integer]: IDispatch dispid 201;
  end;

// *********************************************************************//
// Schnittstelle: IAdress
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {7CFB29E0-13DE-4192-A8DB-10FB89EC435D}
// *********************************************************************//
  IAdress = interface(IDispatch)
    ['{7CFB29E0-13DE-4192-A8DB-10FB89EC435D}']
    function Get_Street: WideString; safecall;
    procedure Set_Street(const Value: WideString); safecall;
    property Street: WideString read Get_Street write Set_Street;
  end;

// *********************************************************************//
// DispIntf:  IAdressDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {7CFB29E0-13DE-4192-A8DB-10FB89EC435D}
// *********************************************************************//
  IAdressDisp = dispinterface
    ['{7CFB29E0-13DE-4192-A8DB-10FB89EC435D}']
    property Street: WideString dispid 201;
  end;

// *********************************************************************//
// Schnittstelle: IPatient
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {67574B23-5335-4760-8729-A0851C9B75B1}
// *********************************************************************//
  IPatient = interface(IDispatch)
    ['{67574B23-5335-4760-8729-A0851C9B75B1}']
    function Get_Name: WideString; safecall;
    procedure Set_Name(const Value: WideString); safecall;
    function Get_Adress: IAdress; safecall;
    procedure Set_Adress(const Value: IAdress); safecall;
    property Name: WideString read Get_Name write Set_Name;
    property Adress: IAdress read Get_Adress write Set_Adress;
  end;

// *********************************************************************//
// DispIntf:  IPatientDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {67574B23-5335-4760-8729-A0851C9B75B1}
// *********************************************************************//
  IPatientDisp = dispinterface
    ['{67574B23-5335-4760-8729-A0851C9B75B1}']
    property Name: WideString dispid 201;
    property Adress: IAdress dispid 202;
  end;

// *********************************************************************//
// Die Klasse CoConnection stellt die Methoden Create und CreateRemote zur      
// Verfügung, um Instanzen der Standardschnittstelle IConnection, dargestellt von
// CoClass Connection, zu erzeugen. Diese Funktionen können                    
// von einem Client verwendet werden, der die CoClasses automatisieren    
// möchte, die von dieser Typbibliothek dargestellt werden.              
// *********************************************************************//
  CoConnection = class
    class function Create: IConnection;
    class function CreateRemote(const MachineName: string): IConnection;
  end;

// *********************************************************************//
// Die Klasse CoAdress stellt die Methoden Create und CreateRemote zur      
// Verfügung, um Instanzen der Standardschnittstelle IAdress, dargestellt von
// CoClass Adress, zu erzeugen. Diese Funktionen können                    
// von einem Client verwendet werden, der die CoClasses automatisieren    
// möchte, die von dieser Typbibliothek dargestellt werden.              
// *********************************************************************//
  CoAdress = class
    class function Create: IAdress;
    class function CreateRemote(const MachineName: string): IAdress;
  end;

// *********************************************************************//
// Die Klasse CoPatient stellt die Methoden Create und CreateRemote zur      
// Verfügung, um Instanzen der Standardschnittstelle IPatient, dargestellt von
// CoClass Patient, zu erzeugen. Diese Funktionen können                    
// von einem Client verwendet werden, der die CoClasses automatisieren    
// möchte, die von dieser Typbibliothek dargestellt werden.              
// *********************************************************************//
  CoPatient = class
    class function Create: IPatient;
    class function CreateRemote(const MachineName: string): IPatient;
  end;

implementation

uses ComObj;

class function CoConnection.Create: IConnection;
begin
  Result := CreateComObject(CLASS_Connection) as IConnection;
end;

class function CoConnection.CreateRemote(const MachineName: string): IConnection;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Connection) as IConnection;
end;

class function CoAdress.Create: IAdress;
begin
  Result := CreateComObject(CLASS_Adress) as IAdress;
end;

class function CoAdress.CreateRemote(const MachineName: string): IAdress;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Adress) as IAdress;
end;

class function CoPatient.Create: IPatient;
begin
  Result := CreateComObject(CLASS_Patient) as IPatient;
end;

class function CoPatient.CreateRemote(const MachineName: string): IPatient;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Patient) as IPatient;
end;

end.

These are the project (Project1) and the 2 Units Unit1.pas and Project1_TLB (generated with the TypeLibrary Editor) for the COM server implementing the 3 classes Connection,Patient,Adress.
The imoprtant thing is, that you declare the Items to be of type IDispatch, the base interface for all interfaces implemented by automation classes. (alternatively you could declare them as OLEVariant). Then the list can contain com objects of any type.
Then for the client:

unit Unit2;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    fConnection: IConnection;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Patient: IPatient;
begin
   fConnection:=CreateOLEObject('Project1.Connection') as IConnection;
   Patient:=fConnection.Items[0] as IPatient;
   Edit1.Text:=Patient.Name;
   Edit2.Text:=Patient.Adress.Street;
end;

end.

just an ordinary exe - application.

hope this helps.

cheers

TomBig.
Avatar of bertverhees

ASKER

Thanks TomBig,

But what you have done is one COM-dll with three interfaces in it.

I am looking for (external) COM-aggregation

That option you describe, i know abouts, I have done that before with maybe 10 interfaces in one COM-dll, but it means, when I have to implement 170 different interfaces/objects, the interface will be very big, and hardly maintainable.

What I want is different COM-dll's which are published over one COM-dll. COM-aggregation

So a calling application loads the Connection-COM-object (which is in fact, as the name says, a connection to a database, and it is a COM-object because it is to be determined on runtime which database, and which kind of database it is, and it is to used by applications which are not build by now. The COM-object (or rather, the collection of COM-object-dll's are the product).

The Connection COM-object loads a list of Patients on request, but it can also load a list of Hospitals, or a list of Medications.
It can not do this at the same time, the Connection-COM-object has only one list. I could extend it to have it have a List of Lists, but that is not necessary for now, people can instantiate more objects (and thus connections) if they want more lists at the same time.
This is also determined at runtime. The calling application knows what it has called, so it knows which kind of objects are loaded, how the interface looks like, and which properties it can use.

I want to have Patient as a seperate COM-dll, so Patient.dll, Hospital.dll, etc.
This makes the whole maintainable on binary-level. If there is an error in one of the dll's I can exchange that.
Also, the dll's will not be very big, they are only data-holding and SQL-generating objects, so there is no memory-spilled with code that is not used at a certain moment.
A single COM-object-dll with 170 interfaces in it, some complex, some simple does not seem as good programming practise to me.

The objects Patient.dll, Hospital.dll, etc know the Connection.dll. After the connection-object has instantiated one or more patient-objects, the patient-object needs the connection-object to fill its properties. The connection-object holds the connection to the database.
It is the patient-object which queries the Connection for information about the datamodel of the connected database, and the Patient knows, that on datamodel this or datamodel that or SQL dialect this or that, what it has to do to fill its properties.

If the calling application wants a property of a patient, which can also be an object (one of the 170, a Patient, f.e. has a list of Medications, which is filled as some application ask for Medications belonging to that Patient), it looks if it is already retrieved, and if not, it will call the connection-object to get the data (it gives an SQL-statement to the connection-object), the connection object then creates an Resultset in which the data are.
But the Medication-objects which fill the patient medication-list can also be used for, stupid example, to get a list of Medications an other Patient has, or which is described by a MedicalCareTaker.
So their has to be code re-use also at binary level, without the overhead of code that is not used.

This way I can stick COM-dll's together according an UML-schema which describes a generic object-model, and the data are retrieved from all kind of databases.
I found a part of the solution myself, thanks to the excellent website by Binh Ly, especially this page:
http://www.techvanguards.com/com/tutorials/tips.asp

It is not a complete solution, but it I can find my way now.

I have an object Walker, and the Walker has Shoes, I want to know from object Walker what the Brand of his Shoes is.

I have two dll's walkers.dll and shoes.dll and I have an application.

--------------------------
Walker Implemetation
--------------------------
{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, Walkers_TLB, StdVcl, Shoes_TLB;

type
  TWalker = class(TAutoObject, IWalker, IShoe)
    function GetShoe : IShoe;
  private
    FShoe : IUnknown;
  protected
    function GetControllingUnknown:IUnknown;
    function Get_Name: WideString; safecall;
    procedure Set_Name(const Value: WideString); safecall;
    function Get_Shoe: IDispatch; safecall;
    property Shoe : IShoe read GetShoe  implements IShoe;
  end;

implementation

uses ComServ;

function TWalker.GetControllingUnknown:IUnknown;
begin
  if (Controller<>nil) then Result := Controller
  else Result := Self as IUnknown;
end;

function TWalker.Get_Name: WideString;
begin
  Result := 'Walker-Name';
end;

procedure TWalker.Set_Name(const Value: WideString);
begin

end;

function TWalker.Get_Shoe: IDispatch;
begin
   Result := GetShoe;
end;

function TWalker.GetShoe: IShoe;
begin
  if (FShoe=nil) then
    CoCreateInstance(CLASS_Shoe,
      GetControllingUnknown,
      CLSCTX_INPROC,
      IUnknown,
      FShoe);
  Result := FShoe as IShoe;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TWalker, Class_Walker,
    ciMultiInstance, tmApartment);
end.

--------------------------
Shoe-implementation
--------------------------
unit ShoeImp;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, ActiveX, Shoes_TLB, StdVcl;

type
  TShoe = class(TAutoObject, IShoe)
  protected
    function Get_Size: Integer; safecall;
    procedure Set_Size(Value: Integer); safecall;
    function Get_Brand: WideString; safecall;
    procedure Set_Brand(const Value: WideString); safecall;

  end;

implementation

uses ComServ;

function TShoe.Get_Size: Integer;
begin

end;

procedure TShoe.Set_Size(Value: Integer);
begin

end;

function TShoe.Get_Brand: WideString;
begin
   Result := 'Nike';
end;

procedure TShoe.Set_Brand(const Value: WideString);
begin

end;

initialization
  TAutoObjectFactory.Create(ComServer, TShoe, Class_Shoe,
    ciMultiInstance, tmApartment);
end.

--------------------------
Calling Application
--------------------------
var
  walker : Variant;
begin
  walker := CreateOleObject('Walkers.Walker');
  Label1.Caption := walker.Name;
  Label3.Caption := Walker.Shoe.Brand;
end;
--------------------------
and it says 'Nike'  as it should
--------------------------

Not al my problems are solved now, still there is chance to earn the 500 points.

The object Shoe which knows the brand, also needs to know who the Walker is, in this example a bit stupid, but in the previous Connection, Patient example, the Patient needs to fill up its properties and can only do that by using the Connection, so I need a safeway to get a Pointer to Connection, in a way I can use its functionality.
Important is that it will not disturb the reference-counting, the only Reference Connection may have is to the calling application

And I need a way to start with a List, but I guess, that is the easy part, I guess I make a Patients interface in a seperate COM-object which contains the Patient-Interfaces, Need to look this up at

So, please, if some knows to go one, thnaks in advance
Bert Verhees


 
ASKER CERTIFIED SOLUTION
Avatar of modulo
modulo

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial