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