Project Structure

• ThinPlus2009Server.dpr
• AppSForm.pas
• AppSForm.dfm {ServerForm}
• AppSRDM.pas
• AppSRDM.dfm {AppServerPlus}

program ThinPlus2009Server;

uses
  Forms,
  AppSForm in 'AppSForm.pas' {ServerForm},
  AppSRDM in 'AppSRDM.pas' {AppServerPlus: TRemoteDataModule} {AppServerPlus: CoClass};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TServerForm, ServerForm);
  Application.Run;
end.

unit AppSForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DSCommonServer, DSTCPServerTransport, DSServer;

type
  TServerForm = class(TForm)
    lbLog: TListBox;
    DSServer1: TDSServer;
    DSServerClass1: TDSServerClass;
    DSTCPServerTransport1: TDSTCPServerTransport;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
  private
    { Private declarations }
  public
    procedure Add (strLog: string);
  end;

var
  ServerForm: TServerForm;

implementation

{$R *.DFM}

uses
  AppSRDM;

{ TServerForm }

procedure TServerForm.Add(strLog: string);
begin
  // add item and move to it
  lbLog.ItemIndex := lbLog.Items.Add (strLog);
end;

procedure TServerForm.DSServerClass1GetClass(DSServerClass: TDSServerClass;
  var PersistentClass: TPersistentClass);
begin
  PersistentClass := TAppServerPlus;
end;

end.

object ServerForm: TServerForm
  Left = 281
  Top = 286
  Caption = 'AppServerPlus'
  ClientHeight = 240
  ClientWidth = 400
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object lbLog: TListBox
    Left = 0
    Top = 0
    Width = 400
    Height = 240
    Align = alClient
    ItemHeight = 13
    TabOrder = 0
  end
  object DSServer1: TDSServer
    AutoStart = True
    HideDSAdmin = False
    Left = 72
    Top = 96
  end
  object DSServerClass1: TDSServerClass
    OnGetClass = DSServerClass1GetClass
    Server = DSServer1
    LifeCycle = 'Session'
    Left = 160
    Top = 96
  end
  object DSTCPServerTransport1: TDSTCPServerTransport
    PoolSize = 0
    Server = DSServer1
    BufferKBSize = 32
    Left = 72
    Top = 160
  end
end

unit AppSRDM;

interface

uses
  Windows, Messages, SysUtils, Classes, DataBkr, DBClient, DB,
  Provider, DBTables, Variants, SqlExpr, FMTBcd, WideStrings,
  DBXInterbase;

type
  TAppServerPlus = class(TRemoteDataModule)
    DataSourceDept: TDataSource;
    ProviderDepartments: TDataSetProvider;
    ProviderQuery: TDataSetProvider;
    SQLMonitor1: TSQLMonitor;
    SQLConnection1: TSQLConnection;
    SQLWithParams: TSQLDataSet;
    SQLDepartments: TSQLDataSet;
    SQLEmployees: TSQLDataSet;
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure ProviderQueryGetDataSetProperties(Sender: TObject;
      DataSet: TDataSet; out Properties: OleVariant);
    procedure ProviderDepartmentsUpdateData(Sender: TObject;
      DataSet: TCustomClientDataSet);
    procedure ProviderDepartmentsBeforeUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
      UpdateKind: TUpdateKind; var Applied: Boolean);
    procedure ProviderDepartmentsBeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure ProviderEmployeeBeforeUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
      UpdateKind: TUpdateKind; var Applied: Boolean);
    procedure ProviderEmployeeAfterApplyUpdates(Sender: TObject;
      var OwnerData: OleVariant);
    procedure ProviderEmployeeUpdateError(Sender: TObject;
      DataSet: TCustomClientDataSet; E: EUpdateError;
      UpdateKind: TUpdateKind; var Response: TResolverResponse);
  private
    { Private declarations }
  public
    procedure Login(const Name, Password: WideString);
  end;

implementation

uses AppSForm;

{$R *.DFM}

procedure TAppServerPlus.Login(const Name, Password: WideString);
begin
  if Password <> Name then
    raise Exception.Create ('Wrong name/password combination received');
  ProviderDepartments.Exported := True;
  ServerForm.Add ('Login:' + Name + '/' + Password);
end;

procedure TAppServerPlus.ProviderQueryGetDataSetProperties(Sender: TObject;
  DataSet: TDataSet; out Properties: OleVariant);
begin
  Properties := VarArrayCreate([0,1], varVariant);
  Properties[0] := VarArrayOf(['Time', Now, True]);
  Properties[1] := VarArrayOf(['Param', SQLWithParams.Params[0].AsString, False]);
end;

procedure TAppServerPlus.ProviderDepartmentsUpdateData(Sender: TObject;
  DataSet: TCustomClientDataSet);
begin
  ServerForm.Add ('ProviderCustomer.OnUpdateData');
end;

procedure TAppServerPlus.ProviderDepartmentsBeforeUpdateRecord(
  Sender: TObject; SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
  UpdateKind: TUpdateKind; var Applied: Boolean);
begin
  ServerForm.Add ('ProviderCustomer.UpdateRecord');
end;

procedure TAppServerPlus.ProviderDepartmentsBeforeGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
begin
  ServerForm.Add ('ProviderCustomer.BeforeGetRecords');
end;


procedure TAppServerPlus.ProviderEmployeeBeforeUpdateRecord(
  Sender: TObject; SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
  UpdateKind: TUpdateKind; var Applied: Boolean);
begin
  ServerForm.Add ('fix hire date');
  DeltaDS.FieldByName('HIRE_DATE').NewValue := Now;
end;

procedure TAppServerPlus.ProviderEmployeeAfterApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
  ServerForm.Add ('after apply...');
end;

procedure TAppServerPlus.ProviderEmployeeUpdateError(Sender: TObject;
  DataSet: TCustomClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
  var Response: TResolverResponse);
begin
  ServerForm.Add ('Error: ' + E.Message);
end;

procedure TAppServerPlus.RemoteDataModuleCreate(Sender: TObject);
begin
  ProviderDepartments.Exported := False;
end;

end.

object AppServerPlus: TAppServerPlus
  OldCreateOrder = False
  OnCreate = RemoteDataModuleCreate
  Height = 255
  Width = 573
  object DataSourceDept: TDataSource
    DataSet = SQLDepartments
    Left = 56
    Top = 104
  end
  object ProviderDepartments: TDataSetProvider
    DataSet = SQLDepartments
    Exported = False
    OnUpdateData = ProviderDepartmentsUpdateData
    BeforeUpdateRecord = ProviderDepartmentsBeforeUpdateRecord
    BeforeGetRecords = ProviderDepartmentsBeforeGetRecords
    Left = 56
    Top = 40
  end
  object ProviderQuery: TDataSetProvider
    DataSet = SQLWithParams
    OnGetDataSetProperties = ProviderQueryGetDataSetProperties
    Left = 48
    Top = 200
  end
  object SQLMonitor1: TSQLMonitor
    SQLConnection = SQLConnection1
    Left = 416
    Top = 80
  end
  object SQLConnection1: TSQLConnection
    ConnectionName = 'IBCONNECTION'
    DriverName = 'Interbase'
    GetDriverFunc = 'getSQLDriverINTERBASE'
    LibraryName = 'dbexpint.dll'
    LoginPrompt = False
    Params.Strings = (
      'DriverName=Interbase'

              'Database=C:\Program Files\Common Files\CodeGear Shared\Data\Empl' +
        'oyee.GDB'
      'RoleName=RoleName'
      'User_Name=sysdba'
      'Password=masterkey'
      'ServerCharSet='
      'SQLDialect=3'
      'ErrorResourceFile='
      'LocaleCode=0000'
      'BlobSize=-1'
      'CommitRetain=False'
      'WaitOnLocks=True'
      'Interbase TransIsolation=ReadCommited')
    VendorLib = 'GDS32.DLL'
    Left = 416
    Top = 144
  end
  object SQLWithParams: TSQLDataSet
    SchemaName = 'SYSDBA'
    CommandText = 'select * from employee where job_code = :job_code'
    DbxCommandType = 'Dbx.SQL'
    MaxBlobSize = -1
    Params = <
      item
        DataType = ftString
        Name = 'job_code'
        ParamType = ptInput
        Value = 'Eng'
      end>
    SQLConnection = SQLConnection1
    Left = 128
    Top = 200
  end
  object SQLDepartments: TSQLDataSet
    SchemaName = 'sysdba'
    CommandText = 'select * from DEPARTMENT'
    DbxCommandType = 'Dbx.SQL'
    MaxBlobSize = -1
    Params = <>
    SQLConnection = SQLConnection1
    Left = 136
    Top = 56
  end
  object SQLEmployees: TSQLDataSet
    SchemaName = 'sysdba'
    CommandText = 'select * from EMPLOYEE where dept_no = :dept_no'
    DbxCommandType = 'Dbx.SQL'
    DataSource = DataSourceDept
    MaxBlobSize = -1
    Params = <
      item
        DataType = ftUnknown
        Name = 'dept_no'
        ParamType = ptInput
      end>
    SQLConnection = SQLConnection1
    Left = 136
    Top = 104
  end
end