The DataSnap Server method was introduced in Delphi 2009. Most of the videos or demos about the DataSnap server method are only available for access to socket-based server. For example: TCP or HTTP.
However, DataSnap was designed as a scalable data access solution that can work with one, two, three or more levels of the model. All the examples that we see so far are suitable for level 2 or 3 design. I can not find any example talking about level 1 or during development.
In fact, it is very simple to work with the in-process server method. Most steps are similar to out-of-process server methods.
Define a server method
Define the well-known EchoString () and Sum () 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 the TDSServer and TDSServerClass, as usual, into the data module. Define the OnGetClass event for the TDSServerClass instance. Please note that you do not need to remove any transport components such as TDSTCPServerTransport or TDSHTTPServer, since we only want to use the server-side method for the in-process process.
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;
Creating Server Method Client Classes
It is not easy to create the class construction of client server methods for the embedded server. You can try any methods that you are familiar with, to connect your server-side method to the TCP or HTTP transport service, start the service and try 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.
Server method call through in-process
You can see from the following code that there is no other access to the server method for the in-process and out-of-process.
First, you create an instant datasnap server. This will register the DSServer in the TDBXDriverRegistry. for example DSServer1 in this case.
You can then use TSQLConnection with DSServer1 as the driver name instead of “DataSnap,” which requires a socket connection to initiate in-process communication using 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;
Troubleshooting: Encounter memory leak after using embedded server methods
This happens in Delphi 2010 build 14.0.3513.24210. It may have been fixed in a future release. You can check QC # 78696 for the latest status. Note that you need to add "ReportMemoryLeaksOnShutdown: = True"; in code to show a leak report.
Memory leaks are not related to in-process server methods. This should be a problem in the TDSServerConnection class, where the ServerConnectionHandler property is not freed after use.
Here is the 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.
Troubleshooting: Encounter "Invalid command handle" when using more than one runtime server method for an embedded application
This happens in Delphi 2010 build 14.0.3513.24210. It may have been fixed in a future release. You can check QC # 78698 for the latest status.
To reproduce this problem, you can use 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 that:
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 the 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:
- QC # 78696: Memory leak in TDSServerConnection for connection process
- QC # 78698: Encounter "Invalid command to process" when consuming more than one server at run time for in-process application