Marco Cantù 1998, Mastering Delphi 4
Project: MDSERVER.DPR
Project Structure
MDSERVER.DPR
program MdServer;
uses
Forms,
MdsForm in 'MdsForm.pas' {Form1},
MdServer_TLB in 'MdServer_TLB.pas',
MdsDm in 'MdsDm.pas' {MdDataModule: TDataModule} {MdDataModule: CoClass};
{$R *.RES}
{$R *.TLB}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
MDSFORM.PAS
unit MdsForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
end.
MDSERVER_TLB.PAS
unit MdServer_TLB;
{ This file contains pascal declarations imported from a type library.
This file will be written during each import or refresh of the type
library editor. Changes to this file will be discarded during the
refresh process. }
{ MdServer Library }
{ Version 1.0 }
interface
uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;
const
LIBID_MdServer: TGUID = '{C5DDE904-2214-11D1-98D0-444553540000}';
const
{ Component class GUIDs }
Class_MdDataModule: TGUID = '{C5DDE906-2214-11D1-98D0-444553540000}';
type
{ Forward declarations: Interfaces }
IMdDataModule = interface;
IMdDataModuleDisp = dispinterface;
{ Forward declarations: CoClasses }
MdDataModule = IMdDataModule;
{ Dispatch interface for MdDataModule Object }
IMdDataModule = interface(IDataBroker)
['{C5DDE905-2214-11D1-98D0-444553540000}']
function Get_TableCustomers: IProvider; safecall;
function Get_TableOrders: IProvider; safecall;
procedure GetBoth(out Customer, Order: OleVariant); safecall;
property TableCustomers: IProvider read Get_TableCustomers;
property TableOrders: IProvider read Get_TableOrders;
end;
{ DispInterface declaration for Dual Interface IMdDataModule }
IMdDataModuleDisp = dispinterface
['{C5DDE905-2214-11D1-98D0-444553540000}']
function GetProviderNames: OleVariant; dispid 22929905;
property TableCustomers: IProvider readonly dispid 1;
property TableOrders: IProvider readonly dispid 2;
procedure GetBoth(out Customer, Order: OleVariant); dispid 3;
end;
{ MdDataModuleObject }
CoMdDataModule = class
class function Create: IMdDataModule;
class function CreateRemote(const MachineName: string): IMdDataModule;
end;
implementation
uses ComObj;
class function CoMdDataModule.Create: IMdDataModule;
begin
Result := CreateComObject(Class_MdDataModule) as IMdDataModule;
end;
class function CoMdDataModule.CreateRemote(const MachineName: string): IMdDataModule;
begin
Result := CreateRemoteComObject(MachineName, Class_MdDataModule) as IMdDataModule;
end;
end.
MDSDM.PAS
unit MdsDm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComServ, ComObj, VCLCom, StdVcl, BdeProv, DataBkr, MdServer_TLB, Db,
DBTables;
type
TMdDataModule = class(TDataModule, IMdDataModule)
TableCustomers: TTable;
TableOrders: TTable;
private
{ Private declarations }
public
{ Public declarations }
protected
function Get_TableCustomers: IProvider; safecall;
function Get_TableOrders: IProvider; safecall;
procedure GetBoth(out Customer, Order: OleVariant); safecall;
end;
var
MdDataModule: TMdDataModule;
implementation
{$R *.DFM}
function TMdDataModule.Get_TableCustomers: IProvider;
begin
Result := TableCustomers.Provider;
end;
function TMdDataModule.Get_TableOrders: IProvider;
begin
Result := TableOrders.Provider;
end;
procedure TMdDataModule.GetBoth(out Customer, Order: OleVariant);
begin
Customer := TableCustomers.Provider.Data;
Order := TableOrders.Provider.Data;
end;
initialization
TComponentFactory.Create(ComServer, TMdDataModule,
Class_MdDataModule, ciMultiInstance);
end.
MDSFORM.DFM
object Form1: TForm1
Left = 201
Top = 135
Width = 200
Height = 74
Caption = 'Master-detail server'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
end
MDSDM.DFM
object MdDataModule: TMdDataModule
OldCreateOrder = True
Left = 216
Top = 184
Height = 163
Width = 143
object TableCustomers: TTable
DatabaseName = 'DBDEMOS'
TableName = 'CUSTOMER.DB'
Left = 48
Top = 8
end
object TableOrders: TTable
DatabaseName = 'DBDEMOS'
TableName = 'ORDERS.DB'
Left = 48
Top = 56
end
end
Copyright Marco Cantù 1998