Project Structure

• DsnapMethodsClient.dpr
• DsnapMethodsClient_ClientForm.pas
• DsnapMethodsClient_ClientForm.dfm {FormDsmcClient}
• DsnapMethodsClient_Proxy.pas
• DsnapMethodsClient_MainForm.pas
• DsnapMethodsClient_MainForm.dfm {FormDsmcMain}

program DsnapMethodsClient;

uses
  Forms,
  DsnapMethodsClient_ClientForm in 'DsnapMethodsClient_ClientForm.pas' {FormDsmcClient},
  DsnapMethodsClient_Proxy in 'DsnapMethodsClient_Proxy.pas',
  DsnapMethodsClient_MainForm in 'DsnapMethodsClient_MainForm.pas' {FormDsmcMain};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormDsmcMain, FormDsmcMain);
  Application.Run;
end.

unit DsnapMethodsClient_ClientForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WideStrings, DbxDatasnap, DB, SqlExpr, DsnapMethodsClient_Proxy,
  StdCtrls, Spin, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze;

type
  TFormDsmcClient = class(TForm)
    SQLConnection1: TSQLConnection;
    btnEcho: TButton;
    Edit1: TEdit;
    btnFormSet: TButton;
    btnFormGet: TButton;
    SpinEdit1: TSpinEdit;
    btnToString: TButton;
    lblToString: TLabel;
    btnPrimes: TButton;
    SpinEdit2: TSpinEdit;
    lblPrimes: TLabel;
    lblGet: TLabel;
    btnPrimesTh: TButton;
    lblPrimesTh: TLabel;
    procedure btnEchoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnFormSetClick(Sender: TObject);
    procedure btnFormGetClick(Sender: TObject);
    procedure btnToStringClick(Sender: TObject);
    procedure btnPrimesClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnPrimesThClick(Sender: TObject);
  private
    SimpleServer: TSimpleServerClassClient;
    StorageServer: TStorageServerClassClient;
    procedure InitStorageServer;
  public
    function ToString: string; override;
  end;

implementation

{$R *.dfm}

type
  TPrimesClientThread = class (TThread)
  private
    FMaxValue: Integer;
    FSimpleServer: TSimpleServerClassClient;
    FCallingForm: TFormDsmcClient;
  protected
    procedure Execute; override;
  public
    constructor Create (MaxValue: Integer;
      SimpleServer: TSimpleServerClassClient;
      CallingForm: TFormDsmcClient);
  end;


procedure TFormDsmcClient.btnEchoClick(Sender: TObject);
begin
  if not Assigned (SimpleServer) then
    SimpleServer := TSimpleServerClassClient.Create (
      SQLConnection1.DBXConnection);
  Edit1.Text := SimpleServer.Echo(Edit1.Text);
end;

procedure TFormDsmcClient.btnFormGetClick(Sender: TObject);
begin
  InitStorageServer;
  lblGet.Caption := IntToStr (StorageServer.GetValue);
end;

procedure TFormDsmcClient.InitStorageServer;
begin
  if not Assigned(StorageServer) then
    StorageServer := TStorageServerClassClient.Create(
      SQLConnection1.DBXConnection);
end;

function TFormDsmcClient.ToString: string;
begin
  InitStorageServer;
  Result := StorageServer.ToString;
end;

procedure TFormDsmcClient.btnFormSetClick(Sender: TObject);
begin
  InitStorageServer;
  StorageServer.SetValue(SpinEdit1.Value);
end;

procedure TFormDsmcClient.btnPrimesClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    if not Assigned (SimpleServer) then
      SimpleServer := TSimpleServerClassClient.Create (
        SQLConnection1.DBXConnection);
    lblPrimes.Caption := IntToStr (
      SimpleServer.SlowPrime(SpinEdit2.Value));
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TFormDsmcClient.btnPrimesThClick(Sender: TObject);
begin
  // btnPrimesTh.Enabled := False;
  if not Assigned (SimpleServer) then
    SimpleServer := TSimpleServerClassClient.Create (
      SQLConnection1.DBXConnection);
  TPrimesClientThread.Create(
    SpinEdit2.Value, SimpleServer, self);
end;

procedure TFormDsmcClient.btnToStringClick(Sender: TObject);
begin
  InitStorageServer;
  lblToString.Caption := StorageServer.ToString;
end;

procedure TFormDsmcClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // destroy when closed
  Action := caFree;
end;

procedure TFormDsmcClient.FormCreate(Sender: TObject);
begin
  try
    SQLConnection1.Open;
  except
    ShowMessage ('Run the server and restart the client application');
  end;
end;

{ TPrimesClientThread }

constructor TPrimesClientThread.Create(
  MaxValue: Integer; SimpleServer: TSimpleServerClassClient;
  CallingForm: TFormDsmcClient);
begin
  FSimpleServer := SimpleServer;
  FMaxValue := MaxValue;
  FCallingForm := CallingForm;
  FreeOnTerminate := True;
  inherited Create (False);
end;

procedure TPrimesClientThread.Execute;
var
  nResult: Integer;
begin
  nResult := FSimpleServer.SlowPrime(FMaxValue);
  Synchronize (procedure ()
    begin
      FCallingForm.lblPrimesTh.Caption := IntToStr (nResult);
      // FCallingForm.btnPrimesTh.Enabled := True;
    end);
end;

end.

object FormDsmcClient: TFormDsmcClient
  Left = 0
  Top = 0
  Caption = 'DsnapMethodsClient Client'
  ClientHeight = 297
  ClientWidth = 453
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object lblToString: TLabel
    Left = 168
    Top = 220
    Width = 50
    Height = 13
    Caption = 'lblToString'
  end
  object lblPrimes: TLabel
    Left = 296
    Top = 61
    Width = 41
    Height = 13
    Caption = 'lblPrimes'
  end
  object lblGet: TLabel
    Left = 168
    Top = 189
    Width = 27
    Height = 13
    Caption = 'lblGet'
  end
  object lblPrimesTh: TLabel
    Left = 168
    Top = 96
    Width = 53
    Height = 13
    Caption = 'lblPrimesTh'
  end
  object btnEcho: TButton
    Left = 80
    Top = 24
    Width = 75
    Height = 25
    Caption = 'btnEcho'
    TabOrder = 0
    OnClick = btnEchoClick
  end
  object Edit1: TEdit
    Left = 161
    Top = 26
    Width = 176
    Height = 21
    TabOrder = 1
    Text = 'Marco'
  end
  object btnFormSet: TButton
    Left = 80
    Top = 152
    Width = 75
    Height = 25
    Caption = 'btnFormSet'
    TabOrder = 2
    OnClick = btnFormSetClick
  end
  object btnFormGet: TButton
    Left = 80
    Top = 184
    Width = 75
    Height = 25
    Caption = 'btnFormGet'
    TabOrder = 3
    OnClick = btnFormGetClick
  end
  object SpinEdit1: TSpinEdit
    Left = 168
    Top = 154
    Width = 169
    Height = 22
    MaxValue = 0
    MinValue = 0
    TabOrder = 4
    Value = 0
  end
  object btnToString: TButton
    Left = 80
    Top = 215
    Width = 75
    Height = 25
    Caption = 'btnToString'
    TabOrder = 5
    OnClick = btnToStringClick
  end
  object btnPrimes: TButton
    Left = 80
    Top = 56
    Width = 75
    Height = 25
    Caption = 'btnPrimes'
    TabOrder = 6
    OnClick = btnPrimesClick
  end
  object SpinEdit2: TSpinEdit
    Left = 161
    Top = 58
    Width = 121
    Height = 22
    MaxValue = 0
    MinValue = 0
    TabOrder = 7
    Value = 10000
  end
  object btnPrimesTh: TButton
    Left = 80
    Top = 88
    Width = 75
    Height = 25
    Caption = 'btnPrimesTh'
    TabOrder = 8
    OnClick = btnPrimesThClick
  end
  object SQLConnection1: TSQLConnection
    DriverName = 'Datasnap'
    LoginPrompt = False
    Left = 32
    Top = 80
  end
end

//
 // Created by the DataSnap proxy generator.
//

 unit DsnapMethodsClient_Proxy;

interface

uses DBXCommon, Classes, SysUtils, DB, SqlExpr, DBXDBReaders;

type
  TSimpleServerClassClient = class
  private
    FDBXConnection: TDBXConnection;
    FInstanceOwner: Boolean;
    FEchoCommand: TDBXCommand;
    FSlowPrimeCommand: TDBXCommand;
  public
    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
    destructor Destroy; override;
    function Echo(Text: string): string;
    function SlowPrime(MaxValue: Integer): Integer;
  end;

  TStorageServerClassClient = class
  private
    FDBXConnection: TDBXConnection;
    FInstanceOwner: Boolean;
    FSetValueCommand: TDBXCommand;
    FGetValueCommand: TDBXCommand;
    FToStringCommand: TDBXCommand;
  public
    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
    destructor Destroy; override;
    procedure SetValue(Value: Integer);
    function GetValue: Integer;
    function ToString: string; override; // override added manually
  end;

implementation

function TSimpleServerClassClient.Echo(Text: string): string;
begin
  if FEchoCommand = nil then
  begin
    FEchoCommand := FDBXConnection.CreateCommand;
    FEchoCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FEchoCommand.Text := 'TSimpleServerClass.Echo';
    FEchoCommand.Prepare;
  end;
  FEchoCommand.Parameters[0].Value.SetWideString(Text);
  FEchoCommand.ExecuteUpdate;
  Result := FEchoCommand.Parameters[1].Value.GetWideString;
end;

function TSimpleServerClassClient.SlowPrime(MaxValue: Integer): Integer;
begin
  if FSlowPrimeCommand = nil then
  begin
    FSlowPrimeCommand := FDBXConnection.CreateCommand;
    FSlowPrimeCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FSlowPrimeCommand.Text := 'TSimpleServerClass.SlowPrime';
    FSlowPrimeCommand.Prepare;
  end;
  FSlowPrimeCommand.Parameters[0].Value.SetInt32(MaxValue);
  FSlowPrimeCommand.ExecuteUpdate;
  Result := FSlowPrimeCommand.Parameters[1].Value.GetInt32;
end;


constructor TSimpleServerClassClient.Create(ADBXConnection: TDBXConnection);
begin
  inherited Create;
  if ADBXConnection = nil then
    raise EInvalidOperation.Create('Connection cannot be nil.  Make sure the connection has been opened.');
  FDBXConnection := ADBXConnection;
FInstanceOwner := True;
end;


constructor TSimpleServerClassClient.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
  inherited Create;
  if ADBXConnection = nil then
    raise EInvalidOperation.Create('Connection cannot be nil.  Make sure the connection has been opened.');
  FDBXConnection := ADBXConnection;
FInstanceOwner := AInstanceOwner;
end;


destructor TSimpleServerClassClient.Destroy;
begin
  FreeAndNil(FEchoCommand);
  FreeAndNil(FSlowPrimeCommand);
  inherited;
end;

procedure TStorageServerClassClient.SetValue(Value: Integer);
begin
  if FSetValueCommand = nil then
  begin
    FSetValueCommand := FDBXConnection.CreateCommand;
    FSetValueCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FSetValueCommand.Text := 'TStorageServerClass.SetValue';
    FSetValueCommand.Prepare;
  end;
  FSetValueCommand.Parameters[0].Value.SetInt32(Value);
  FSetValueCommand.ExecuteUpdate;
end;

function TStorageServerClassClient.GetValue: Integer;
begin
  if FGetValueCommand = nil then
  begin
    FGetValueCommand := FDBXConnection.CreateCommand;
    FGetValueCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FGetValueCommand.Text := 'TStorageServerClass.GetValue';
    FGetValueCommand.Prepare;
  end;
  FGetValueCommand.ExecuteUpdate;
  Result := FGetValueCommand.Parameters[0].Value.GetInt32;
end;

function TStorageServerClassClient.ToString: string;
begin
  if FToStringCommand = nil then
  begin
    FToStringCommand := FDBXConnection.CreateCommand;
    FToStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FToStringCommand.Text := 'TStorageServerClass.ToString';
    FToStringCommand.Prepare;
  end;
  FToStringCommand.ExecuteUpdate;
  Result := FToStringCommand.Parameters[0].Value.GetWideString;
end;


constructor TStorageServerClassClient.Create(ADBXConnection: TDBXConnection);
begin
  inherited Create;
  if ADBXConnection = nil then
    raise EInvalidOperation.Create('Connection cannot be nil.  Make sure the connection has been opened.');
  FDBXConnection := ADBXConnection;
FInstanceOwner := True;
end;


constructor TStorageServerClassClient.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
  inherited Create;
  if ADBXConnection = nil then
    raise EInvalidOperation.Create('Connection cannot be nil.  Make sure the connection has been opened.');
  FDBXConnection := ADBXConnection;
FInstanceOwner := AInstanceOwner;
end;


destructor TStorageServerClassClient.Destroy;
begin
  FreeAndNil(FSetValueCommand);
  FreeAndNil(FGetValueCommand);
  FreeAndNil(FToStringCommand);
  inherited;
end;

end.

unit DsnapMethodsClient_MainForm;

interface

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

type
  TFormDsmcMain = class(TForm)
    btnNewForm: TButton;
    btnUpdateStatus: TButton;
    Memo1: TMemo;
    rgLifeCycle: TRadioGroup;
    btnStartServer: TButton;
    procedure btnNewFormClick(Sender: TObject);
    procedure btnUpdateStatusClick(Sender: TObject);
    procedure btnStartServerClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure Log (const strMsg: string);
  end;

var
  FormDsmcMain: TFormDsmcMain;

implementation

uses DsnapMethodsClient_ClientForm;

{$R *.dfm}

procedure TFormDsmcMain.btnNewFormClick(Sender: TObject);
begin
  // create a client form, with a connection to the server
  with TFormDsmcClient.Create(Application) do
  begin
    Show;
  end;
end;

procedure TFormDsmcMain.btnStartServerClick(Sender: TObject);
var
  aStr: AnsiString;
begin
  Log (rgLifeCycle.Items[rgLifeCycle.ItemIndex]);
  aStr := 'DsnapMethodsServer.exe ' +
    rgLifeCycle.Items[rgLifeCycle.ItemIndex];
  WinExec (PAnsiChar (aStr), CmdShow);
end;

procedure TFormDsmcMain.btnUpdateStatusClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to Screen.FormCount - 1 do
    if Screen.Forms[I].ClassType = TFormDsmcClient then
      Log (IntToStr (I) + ': ' + Screen.Forms[I].ToString);
end;

procedure TFormDsmcMain.Log(const strMsg: string);
begin
  Memo1.Lines.Add (strMsg);
end;

end.

object FormDsmcMain: TFormDsmcMain
  Left = 0
  Top = 0
  Caption = 'DsnapMethodsClient Main'
  ClientHeight = 292
  ClientWidth = 599
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnNewForm: TButton
    Left = 16
    Top = 8
    Width = 91
    Height = 25
    Caption = 'btnNewForm'
    TabOrder = 0
    OnClick = btnNewFormClick
  end
  object btnUpdateStatus: TButton
    Left = 120
    Top = 8
    Width = 97
    Height = 25
    Caption = 'btnUpdateStatus'
    TabOrder = 1
    OnClick = btnUpdateStatusClick
  end
  object Memo1: TMemo
    Left = 16
    Top = 40
    Width = 417
    Height = 241
    TabOrder = 2
  end
  object rgLifeCycle: TRadioGroup
    Left = 447
    Top = 40
    Width = 138
    Height = 113
    Caption = 'rgLifeCycle'
    ItemIndex = 0
    Items.Strings = (
      'Session'
      'Invocation'
      'Server')
    TabOrder = 3
  end
  object btnStartServer: TButton
    Left = 448
    Top = 8
    Width = 97
    Height = 25
    Caption = 'btnStartServer'
    TabOrder = 4
    OnClick = btnStartServerClick
  end
end