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