DataSnap: In-Process Server Method


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;
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}
function TMyServerMethod.EchoString(Value: string): string; begin   Result := Value; end; function TMyServerMethod.Sum(const a, b: integer): integer; begin   Result := a + b; 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;
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;
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;

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;
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;
var o: TDSServerConnectionHandlerAccess;
  inherited Destroy;
  o := TDSServerConnectionHandlerAccess(ServerConnectionHandler);
  if o.FServerCon = Self then begin
    o.FServerCon := nil;

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;
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.

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

Comments are closed.