Project Structure

• DsnapMethodsServer.dpr
• DsnapMethodsServer_MainForm.pas
• DsnapMethodsServer_MainForm.dfm {FormDsnapMethodsServer}

program DsnapMethodsServer;

uses
  Forms,
  DsnapMethodsServer_MainForm in 'DsnapMethodsServer_MainForm.pas' {FormDsnapMethodsServer};

{$R *.res}

begin
  if ParamCount > 0 then
    ParamLifeCycle := ParamStr(1);

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormDsnapMethodsServer, FormDsnapMethodsServer);
  Application.Run;
end.

unit DsnapMethodsServer_MainForm;

interface

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


type
  TFormDsnapMethodsServer = class(TForm)
    DSServer1: TDSServer;
    DSServerClass1: TDSServerClass;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSServerClass2: TDSServerClass;
    Memo1: TMemo;
    procedure DSServerClass2GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
    procedure DSServer1Disconnect(DSConnectEventObject: TDSConnectEventObject);
    procedure DSSC2DestroyInstance(
      DSDestroyInstanceEventObject: TDSDestroyInstanceEventObject);
  private
    { Private declarations }
  public
    procedure Log (const strMsg: string);
  end;

{$MethodInfo ON}
  TSimpleServerClass = class(TPersistent)
  public
    function Echo (const Text: string): string;
    function SlowPrime (MaxValue: Integer): Integer;
  end;
{$MethodInfo OFF}

{$MethodInfo ON}
  TStorageServerClass = class(TPersistent)
  private
    FValue: Integer;
  public
    procedure SetValue(const Value: Integer);
    function GetValue: Integer;
    function ToString: string; override;
  published
    property Value: Integer read GetValue write SetValue;
  end;
{$MethodInfo OFF}

var
  FormDsnapMethodsServer: TFormDsnapMethodsServer;
  ParamLifeCycle: string;

implementation

{$R *.dfm}

procedure TFormDsnapMethodsServer.DSServer1Connect(
  DSConnectEventObject: TDSConnectEventObject);
begin
  Log ('Client connected');
end;

procedure TFormDsnapMethodsServer.DSServer1Disconnect(
  DSConnectEventObject: TDSConnectEventObject);
begin
  Log ('Client disconnected');
end;

procedure TFormDsnapMethodsServer.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := TSimpleServerClass;
end;

procedure TFormDsnapMethodsServer.DSSC2DestroyInstance(
  DSDestroyInstanceEventObject: TDSDestroyInstanceEventObject);
begin
  // only if LifeCycle = 'Invocation' or 'Server'
  // uncomment to avoid memory leak
  DSDestroyInstanceEventObject.ServerClassInstance.Free;
end;

procedure TFormDsnapMethodsServer.DSServerClass2GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  DSServerClass2.LifeCycle := ParamLifeCycle;
  Log ('LifeCycle: ' + DSServerClass2.LifeCycle);
  PersistentClass := TStorageServerClass;
end;

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

{ TSimpleServerClass }

function TSimpleServerClass.Echo(const Text: string): string;
begin
  FormDsnapMethodsServer.Log ('Echoing ' + Text);
  Result := Text + '...' +
    Copy (Text, 2, maxint) + '...' +
    Copy (Text, Length (Text) - 1, 2);
end;

{function local to the unit}
function IsPrime (N: Integer): Boolean;
var
  Test: Integer;
begin
  IsPrime := True;
  for Test := 2 to N - 1 do
    if (N mod Test) = 0 then
    begin
      IsPrime := False;
      break; {jump out of the for loop}
    end;
end;

function TSimpleServerClass.SlowPrime(MaxValue: Integer): Integer;
var
  I: Integer;
begin
  FormDsnapMethodsServer.Log (
    'Starting SlowPrime for ' + IntToHex (Self.GetHashCode, 4));
  // counts the prime numbers below the given value
  Result := 0;
  for I := 1 to MaxValue do
  begin
    if IsPrime (I) then
      Inc (Result);
  end;
  FormDsnapMethodsServer.Log (
    'Done SlowPrime for ' + IntToHex (Self.GetHashCode, 4));
end;

{ TStorageServerClass }

function TStorageServerClass.GetValue: Integer;
begin
  FormDsnapMethodsServer.Log ('Getting value: ' + IntToStr (FValue));
  Result := FValue;
end;

procedure TStorageServerClass.SetValue(const Value: Integer);
begin
  FormDsnapMethodsServer.Log ('Setting value: ' + IntToStr (Value));
  FValue := Value;
end;

function TStorageServerClass.ToString: string;
begin
  FormDsnapMethodsServer.Log ('Returning ToString for ' +
    IntToHex (GetHashCode, 4));
  Result := 'Value: ' + IntToStr (Value) +
    ' - Object: ' + IntToHex (GetHashCode, 4);
end;

initialization
  ReportMemoryLeaksOnShutdown := True;

end.

object FormDsnapMethodsServer: TFormDsnapMethodsServer
  Left = 0
  Top = 0
  Caption = 'DsnapMethodsServer'
  ClientHeight = 283
  ClientWidth = 434
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 16
    Top = 16
    Width = 401
    Height = 249
    TabOrder = 0
  end
  object DSServer1: TDSServer
    OnConnect = DSServer1Connect
    OnDisconnect = DSServer1Disconnect
    AutoStart = True
    HideDSAdmin = False
    Left = 48
    Top = 96
  end
  object DSServerClass1: TDSServerClass
    OnGetClass = DSServerClass1GetClass
    Server = DSServer1
    LifeCycle = 'Session'
    Left = 128
    Top = 128
  end
  object DSTCPServerTransport1: TDSTCPServerTransport
    PoolSize = 20
    Server = DSServer1
    BufferKBSize = 32
    Left = 88
    Top = 176
  end
  object DSServerClass2: TDSServerClass
    OnGetClass = DSServerClass2GetClass
    OnDestroyInstance = DSSC2DestroyInstance
    Server = DSServer1
    LifeCycle = 'Invocation'
    Left = 192
    Top = 200
  end
end