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