Marco Cantù 1998, Mastering Delphi 4

Project: APPSERV2.DPR


Project Structure


APPSERV2.DPR

program AppServ2;

uses
  Forms,
  SrvForm in 'SrvForm.pas' {Form1},
  AppServ2_TLB in 'AppServ2_TLB.pas',
  RemoteDM in 'RemoteDM.pas' {RdmCount: TDataModule} {RdmCount: CoClass};

{$R *.RES}

{$R *.TLB}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

SRVFORM.PAS

unit SrvForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

end.

APPSERV2_TLB.PAS

unit AppServ2_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. }

{ AppServ2 Library }
{ Version 1.0 }

interface

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

const
  LIBID_AppServ2: TGUID = '{C5DDE901-2214-11D1-98D0-444553540000}';

const

{ Component class GUIDs }
  Class_RdmCount: TGUID = '{C5DDE903-2214-11D1-98D0-444553540000}';

type

{ Forward declarations: Interfaces }
  IRdmCount = interface;
  IRdmCountDisp = dispinterface;

{ Forward declarations: CoClasses }
  RdmCount = IRdmCount;

{ Dispatch interface for RdmCount Object }

  IRdmCount = interface(IDataBroker)
    ['{C5DDE902-2214-11D1-98D0-444553540000}']
    function Get_Table1: IProvider; safecall;
    property Table1: IProvider read Get_Table1;
  end;

{ DispInterface declaration for Dual Interface IRdmCount }

  IRdmCountDisp = dispinterface
    ['{C5DDE902-2214-11D1-98D0-444553540000}']
    function GetProviderNames: OleVariant; dispid 22929905;
    property Table1: IProvider readonly dispid 1;
  end;

{ RdmCountObject }

  CoRdmCount = class
    class function Create: IRdmCount;
    class function CreateRemote(const MachineName: string): IRdmCount;
  end;



implementation

uses ComObj;

class function CoRdmCount.Create: IRdmCount;
begin
  Result := CreateComObject(Class_RdmCount) as IRdmCount;
end;

class function CoRdmCount.CreateRemote(const MachineName: string): IRdmCount;
begin
  Result := CreateRemoteComObject(MachineName, Class_RdmCount) as IRdmCount;
end;


end.

REMOTEDM.PAS

unit RemoteDM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComServ, ComObj, VCLCom, StdVcl, BdeProv, DataBkr, AppServ2_TLB, Db,
  DBTables;

type
  TRdmCount = class(TDataModule, IRdmCount)
    Table1: TTable;
    Table1Name: TStringField;
    Table1Capital: TStringField;
    Table1Continent: TStringField;
    Table1Area: TFloatField;
    Table1Population: TFloatField;
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    function Get_Table1: IProvider; safecall;
  end;

var
  RdmCount: TRdmCount;

implementation

{$R *.DFM}

function TRdmCount.Get_Table1: IProvider;
begin
  Result := Table1.Provider;
end;

initialization
  TComponentFactory.Create(ComServer, TRdmCount,
    Class_RdmCount, ciMultiInstance);
end.

SRVFORM.DFM

object Form1: TForm1
  Left = 310
  Top = 345
  Width = 313
  Height = 91
  Caption = 'AppServ2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  Visible = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 23
    Top = 16
    Width = 264
    Height = 24
    Caption = 'Remote Data Module Server (2)'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -19
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
end

REMOTEDM.DFM

object RdmCount: TRdmCount
  OldCreateOrder = True
  Left = 229
  Top = 131
  Height = 150
  Width = 215
  object Table1: TTable
    Active = True
    DatabaseName = 'DBDEMOS'
    Constraints = <
      item
        CustomConstraint = 'Area > 1000'
        ErrorMessage = 'Area too small'
        FromDictionary = False
      end
      item
        CustomConstraint = 'Name <> '''''
          ErrorMessage = 'Must provide a name'
        FromDictionary = False
      end>
    TableName = 'COUNTRY.DB'
    Left = 16
    Top = 16
    object Table1Name: TStringField
      FieldName = 'Name'
      Size = 24
    end
    object Table1Capital: TStringField
      FieldName = 'Capital'
      Size = 24
    end
    object Table1Continent: TStringField
      DefaultExpression = '''Europe'''
        FieldName = 'Continent'
      Size = 24
    end
    object Table1Area: TFloatField
      FieldName = 'Area'
    end
    object Table1Population: TFloatField
      CustomConstraint = 'Value > 10000'
      ConstraintErrorMessage = 'Population out of range'
      FieldName = 'Population'
    end
  end
end


Copyright Marco Cantù 1998