How to use consume in process server method with DataSnap 2010

Question

I define a server method:

TServerMethod = class(TPersistent)
public
  function EchoString(Value: string): string;
end;

The method EchoString return an equivalent Value string.

I then use TDSTCPServerTransport with TDSServer and TDSServerClass to wrap the server methods.

In client side, I create a DataSnap TSQLConnection and generate a TServerMethodProxy client class:

function TServerMethodClient.EchoString(Value: string): string;
begin
  if FEchoStringCommand = nil then
  begin
    FEchoStringCommand := FDBXConnection.CreateCommand;
    FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FEchoStringCommand.Text := 'TServerMethod.EchoString';
    FEchoStringCommand.Prepare;
  end;
  FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
  FEchoStringCommand.ExecuteUpdate;
  Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;

I able to consume the EchoString method via TCP connection in client application:

var o: TServerMethodClient;
begin
  o := TSeverMethodClient.Create(SQLConnection1.DBXConnection);
  try
    ShowMessage(o.EchoString('Hello'));
  finally
    o.Free;
  end;
end;

The above scenarios is using TCP/IP as communication protocol.

However, I wish to deploy my ServerMethod together with my client as "In Process" model. How can I achieve that without changing my client and server method code?

What parameter should I pass to TServerMethodClient.Create constructor in order to establish a in process connection?

o := TSeverMethodClient.Create(SQLConnection1.DBXConnection);

In old DataSnap day, we can use TLocalConnection to enjoy In Process access without changing both client and server codes.

Answer 1

See DataSnap: In-Process Server Method.

Answer 2

DataSnap Server Method was introduced in Delphi 2009. Most video or demo about DataSnap server method available only introduce socket based client server access communication. e.g.: TCP or HTTP protocol.

However, DataSnap was designed as a scalable data access solution that able to work with one, two, three or more tiers model. All examples we see so far are suitable for 2 or 3 tiers design. I can’t find any example talking about 1 tier or in-process design.

Indeed, it is very simple to work with in-process server method. Most steps are similar to out-of-process server methods.

Define a Server Method

Define a well known EchoString() and a Sum() server method:

unit MyServerMethod;

interface

uses Classes, DBXCommon;

type
  {$MethodInfo On}
  TMyServerMethod = class(TPersistent)
  public
    function EchoString(Value: string): string;
    function Sum(const a, b: integer): integer; 
  end;
  {$MethodInfo Off}

implementation

function TMyServerMethod.EchoString(Value: string): string;
begin
  Result := Value;
end;

function TMyServerMethod.Sum(const a, b: integer): integer;
begin
  Result := a + b;
end;

end.

Define a DataModule to access the server method

Drop a TDSServer and TDSServerClass as usual to the data module. Define a OnGetClass event to TDSServerClass instance. Please note that you don’t need to drop any transport components like TDSTCPServerTransport or TDSHTTPServer as we only want to consume the server method for in-process only.

object MyServerMethodDataModule1: TMyServerMethodDataModule
  OldCreateOrder = False
  Height = 293
  Width = 419
  object DSServer1: TDSServer
    AutoStart = True
    HideDSAdmin = False
    Left = 64
    Top = 40
  end
  object DSServerClass1: TDSServerClass
    OnGetClass = DSServerClass1GetClass
    Server = DSServer1
    LifeCycle = 'Server'
    Left = 64
    Top = 112
  end
end

unit MyServerMethodDataModule;

uses MyServerMethod;

procedure TMyServerMethodDataModule.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := TMyServerMethod;
end;

Generate Server Method Client Classes

It is not easy to generate the server method client classes design for in-process server. You may try any methods you are familiar with to hook up your server method to TCP or HTTP transport service, start the service and attempt to generate the client class by any means.

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

unit DataSnapProxyClient;

interface

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

type
  TMyServerMethodClient = class
  private
    FDBXConnection: TDBXConnection;
    FInstanceOwner: Boolean;
    FEchoStringCommand: TDBXCommand;
  public
    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
    destructor Destroy; override;
    function EchoString(Value: string): string;
    function Sum(const a, b: integer): integer;
  end;

implementation

function TMyServerMethodClient.EchoString(Value: string): string;
begin
  if FEchoStringCommand = nil then
  begin
    FEchoStringCommand := FDBXConnection.CreateCommand;
    FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FEchoStringCommand.Text := 'TMyServerMethod.EchoString';
    FEchoStringCommand.Prepare;
  end;
  FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
  FEchoStringCommand.ExecuteUpdate;
  Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;

function TMyServerMethodClient.Sum(a: Integer; b: Integer): Integer;
begin
  if FSumCommand = nil then
  begin
    FSumCommand := FDBXConnection.CreateCommand;
    FSumCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FSumCommand.Text := 'TMyServerMethod.Sum';
    FSumCommand.Prepare;
  end;
  FSumCommand.Parameters[0].Value.SetInt32(a);
  FSumCommand.Parameters[1].Value.SetInt32(b);
  FSumCommand.ExecuteUpdate;
  Result := FSumCommand.Parameters[2].Value.GetInt32;
end;

constructor TMyServerMethodClient.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 TMyServerMethodClient.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 TMyServerMethodClient.Destroy;
begin
  FreeAndNil(FEchoStringCommand);
  inherited;
end;

end.

Invoke the server method via in-process

You may see from the following code that there is no different to access the server method for in-process and out-of-process design.

First, you create an instant of datasnap server. This will register the DSServer to the TDBXDriverRegistry. e.g. DSServer1 in this case.

You may then use TSQLConnection with DSServer1 as driver name instead of “DataSnap” that require socket connection to initiate in-process communication invoking the server method.

var o: TMyServerMethodDataModule;
    Q: TSQLConnection;
    c: TMyServerMethodClient;
begin
  o := TMyServerMethodDataModule.Create(Self);
  Q := TSQLConnection.Create(Self);
  try
    Q.DriverName := 'DSServer1';
    Q.LoginPrompt := False;
    Q.Open;

    c := TMyServerMethodClient.Create(Q.DBXConnection);
    try
      ShowMessage(c.EchoString('Hello'));
    finally
      c.Free;
    end;

  finally
    o.Free;
    Q.Free;
  end;
end;

Troubleshoot: Encounter Memory Leak after consume the in-process server methods

This happens in Delphi 2010 build 14.0.3513.24210. It may have fixed in future release. You may check QC#78696 for latest status. Please note that you need to add “ReportMemoryLeaksOnShutdown := True;” in the code to show the leak report.

The memory leaks has no relation with in-process server methods. It should be a problem in class TDSServerConnection where a property ServerConnectionHandler doesn’t free after consume.

Here is a fix for the problem:

unit DSServer.QC78696;

interface

implementation

uses SysUtils,
     DBXCommon, DSServer, DSCommonServer, DBXMessageHandlerCommon, DBXSqlScanner,
     DBXTransport,
     CodeRedirect;

type
  TDSServerConnectionHandlerAccess = class(TDBXConnectionHandler)
    FConProperties: TDBXProperties;
    FConHandle: Integer;
    FServer: TDSCustomServer;
    FDatabaseConnectionHandler: TObject;
    FHasServerConnection: Boolean;
    FInstanceProvider: TDSHashtableInstanceProvider;
    FCommandHandlers: TDBXCommandHandlerArray;
    FLastCommandHandler: Integer;
    FNextHandler: TDBXConnectionHandler;
    FErrorMessage: TDBXErrorMessage;
    FScanner: TDBXSqlScanner;
    FDbxConnection: TDBXConnection;
    FTransport: TDSServerTransport;
    FChannel: TDbxChannel;
    FCreateInstanceEventObject: TDSCreateInstanceEventObject;
    FDestroyInstanceEventObject: TDSDestroyInstanceEventObject;
    FPrepareEventObject: TDSPrepareEventObject;
    FConnectEventObject: TDSConnectEventObject;
    FErrorEventObject: TDSErrorEventObject;
    FServerCon: TDSServerConnection;
  end;

  TDSServerConnectionPatch = class(TDSServerConnection)
  public
    destructor Destroy; override;
  end;

  TDSServerDriverPatch = class(TDSServerDriver)
  protected
    function CreateConnectionPatch(ConnectionBuilder: TDBXConnectionBuilder): TDBXConnection;
  end;

destructor TDSServerConnectionPatch.Destroy;
begin
  inherited Destroy;
  TDSServerConnectionHandlerAccess(ServerConnectionHandler).FServerCon := nil;
  ServerConnectionHandler.Free;
end;

function TDSServerDriverPatch.CreateConnectionPatch(
  ConnectionBuilder: TDBXConnectionBuilder): TDBXConnection;
begin
  Result := TDSServerConnectionPatch.Create(ConnectionBuilder);
end;

var QC78696: TCodeRedirect;

initialization
  QC78696 := TCodeRedirect.Create(@TDSServerDriverPatch.CreateConnection, @TDSServerDriverPatch.CreateConnectionPatch);
finalization
  QC78696.Free;
end.

Troubleshoot: Encounter "Invalid command handle" when consume more than one server method at runtime for in-process application

This happens in Delphi 2010 build 14.0.3513.24210. It may have fixed in future release. You may check QC#78698 for latest status.

To replay this problem, you may consume the server method as:

c := TMyServerMethodClient.Create(Q.DBXConnection);
try
  ShowMessage(c.EchoString('Hello'));
  ShowMessage(IntToStr(c.Sum(100, 200)));
finally
  c.Free;
end;

or this:

c := TMyServerMethodClient.Create(Q.DBXConnection);
try
  ShowMessage(c.EchoString('Hello'));
  ShowMessage(IntToStr(c.Sum(100, 200)));
  ShowMessage(c.EchoString('Hello'));
finally
  c.Free;
end;

Here is a fix for the problem

unit DSServer.QC78698;

interface

implementation

uses SysUtils, Classes,
     DBXCommon, DBXMessageHandlerCommon, DSCommonServer, DSServer,
     CodeRedirect;

type
  TDSServerCommandAccess = class(TDBXCommand)
  private
    FConHandler: TDSServerConnectionHandler;
    FServerCon: TDSServerConnection;
    FRowsAffected: Int64;
    FServerParameterList: TDBXParameterList;
  end;

  TDSServerCommandPatch = class(TDSServerCommand)
  private
    FCommandHandle: integer;
    function Accessor: TDSServerCommandAccess;
  private
    procedure ExecutePatch;
  protected
    procedure DerivedClose; override;
    function DerivedExecuteQuery: TDBXReader; override;
    procedure DerivedExecuteUpdate; override;
    function DerivedGetNextReader: TDBXReader; override;
    procedure DerivedPrepare; override;
  end;

  TDSServerConnectionPatch = class(TDSServerConnection)
  public
    function CreateCommand: TDBXCommand; override;
  end;

  TDSServerDriverPatch = class(TDSServerDriver)
  private
    function CreateServerCommandPatch(DbxContext: TDBXContext; Connection:
        TDBXConnection; MorphicCommand: TDBXCommand): TDBXCommand;
  public
    constructor Create(DBXDriverDef: TDBXDriverDef); override;
  end;

constructor TDSServerDriverPatch.Create(DBXDriverDef: TDBXDriverDef);
begin
  FCommandFactories := TStringList.Create;
  rpr;
  InitDriverProperties(TDBXProperties.Create);
  // '' makes this the default command factory.
  //
  AddCommandFactory('', CreateServerCommandPatch);
end;

function TDSServerDriverPatch.CreateServerCommandPatch(DbxContext: TDBXContext;
    Connection: TDBXConnection; MorphicCommand: TDBXCommand): TDBXCommand;
var
  ServerConnection: TDSServerConnection;
begin
  ServerConnection := Connection as TDSServerConnection;
  Result := TDSServerCommandPatch.Create(DbxContext, ServerConnection, TDSServerHelp.GetServerConnectionHandler(ServerConnection));
end;

function TDSServerCommandPatch.Accessor: TDSServerCommandAccess;
begin
  Result := TDSServerCommandAccess(Self);
end;

procedure TDSServerCommandPatch.DerivedClose;
var
  Message: TDBXCommandCloseMessage;
begin
  Message := Accessor.FServerCon.CommandCloseMessage;
  Message.CommandHandle := FCommandHandle;
  Message.HandleMessage(Accessor.FConHandler);
end;

function TDSServerCommandPatch.DerivedExecuteQuery: TDBXReader;
var
  List: TDBXParameterList;
  Parameter: TDBXParameter;
  Reader: TDBXReader;
begin
  ExecutePatch;
  List := Parameters;
  if (List <> nil) and (List.Count > 0) then
  begin
    Parameter := List.Parameter[List.Count - 1];
    if Parameter.DataType = TDBXDataTypes.TableType then
    begin
      Reader := Parameter.Value.GetDBXReader;
      Parameter.Value.SetNull;
      Exit(Reader);
    end;
  end;
  Result := nil;
end;

procedure TDSServerCommandPatch.DerivedExecuteUpdate;
begin
  ExecutePatch;
end;

function TDSServerCommandPatch.DerivedGetNextReader: TDBXReader;
var
  Message: TDBXNextResultMessage;
begin
  Message := Accessor.FServerCon.NextResultMessage;
  Message.CommandHandle := FCommandHandle;
  Message.HandleMessage(Accessor.FConHandler);
  Result := Message.NextResult;
end;

procedure TDSServerCommandPatch.DerivedPrepare;
begin
  inherited;
  FCommandHandle := Accessor.FServerCon.PrepareMessage.CommandHandle;
end;

procedure TDSServerCommandPatch.ExecutePatch;
var
  Count: Integer;
  Ordinal: Integer;
  Params: TDBXParameterList;
  CommandParams: TDBXParameterList;
  Message: TDBXExecuteMessage;
begin
  Message := Accessor.FServerCon.ExecuteMessage;
  if not IsPrepared then
    Prepare;
  for ordinal := 0 to Parameters.Count - 1 do
    Accessor.FServerParameterList.Parameter[Ordinal].Value.SetValue(Parameters.Parameter[Ordinal].Value);
  Message.Command := Text;
  Message.CommandType := CommandType;
  Message.CommandHandle := FCommandHandle;
  Message.Parameters := Parameters;
  Message.HandleMessage(Accessor.FConHandler);
  Params := Message.Parameters;
  CommandParams := Parameters;
  if Params <> nil then
  begin
    Count := Params.Count;
    if Count > 0 then
      for ordinal := 0 to Count - 1 do
      begin
        CommandParams.Parameter[Ordinal].Value.SetValue(Params.Parameter[Ordinal].Value);
        Params.Parameter[Ordinal].Value.SetNull;
      end;
  end;
  Accessor.FRowsAffected := Message.RowsAffected;
end;

function TDSServerConnectionPatch.CreateCommand: TDBXCommand;
var
  Command: TDSServerCommand;
begin
  Command := TDSServerCommandPatch.Create(FDbxContext, self, ServerConnectionHandler);
  Result := Command;
end;

var QC78698: TCodeRedirect;

initialization
  QC78698 := TCodeRedirect.Create(@TDSServerConnection.CreateCommand, @TDSServerConnectionPatch.CreateCommand);
finalization
  QC78698.Free;
end.

Reference:

1. QC#78696: Memory Leak in TDSServerConnection for in-process connection
2. QC#78698: Encounter "Invalid command handle" when consume more than one server method at runtime for in-process application