4

我定义了一个服务器方法：

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

EchoString 方法返回一个等效的 Value 字符串。

然后我将 TDSTCPServerTransport 与 TDSServer 和 TDSServerClass 一起使用来包装服务器方法。

在客户端，我创建一个 DataSnap TSQLConnection 并生成一个 TServerMethodProxy 客户端类：

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;

我能够通过客户端应用程序中的 TCP 连接使用 EchoString 方法：

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

上述场景是使用 TCP/IP 作为通信协议。

但是，我希望将我的 ServerMethod 与我的客户端一起部署为“进程中”模型。如何在不更改客户端和服务器方法代码的情况下实现这一目标？

为了建立进程连接，我应该将什么参数传递给 TServerMethodClient.Create 构造函数？

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

在旧的 DataSnap 时代，我们可以使用 TLocalConnection 来享受 In Process 访问，而无需更改客户端和服务器代码。

4

2 回答 2

5

DataSnap 服务器方法是在 Delphi 2009 中引入的。大多数有关 DataSnap 服务器方法的视频或演示仅介绍了基于套接字的客户端服务器访问通信。例如：TCP 或 HTTP 协议。

然而，DataSnap 被设计为一种可扩展的数据访问解决方案，能够与一层、两层、三层或更多层模型一起工作。到目前为止，我们看到的所有示例都适用于 2 层或 3 层设计。我找不到任何关于 1 层或进程内设计的例子。

实际上，使用进程内服务器方法非常简单。大多数步骤类似于进程外服务器方法。

定义服务器方法

定义一个众所周知的 EchoString() 和 Sum() 服务器方法：

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.

定义一个 DataModule 来访问服务器方法

像往常一样将 TDSServer 和 TDSServerClass 放到数据模块中。为 TDSServerClass 实例定义一个 OnGetClass 事件。请注意，您不需要删除任何传输组件，例如 TDSTCPServerTransport 或 TDSHTTPServer，因为我们只想在进程内使用服务器方法。

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

单元 MyServerMethodDataModule；

uses MyServerMethod;

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

生成服务器方法客户端类

为进程内服务器生成服务器方法客户端类设计并不容易。您可以尝试任何您熟悉的方法将您的服务器方法连接到 TCP 或 HTTP 传输服务，启动该服务并尝试以任何方式生成客户端类。

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

通过进程内调用服务器方法

从下面的代码可以看出，进程内设计和进程外设计访问服务器方法没有区别。

首先，您创建一个即时数据快照服务器。这会将 DSServer 注册到 TDBXDriverRegistry。例如本例中的 DSServer1。

然后，您可以使用带有 DSServer1 的 TSQLConnection 作为驱动程序名称，而不是需要套接字连接来启动调用服务器方法的进程内通信的“DataSnap”。

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;

故障排除：使用进程内服务器方法后遇到内存泄漏

这发生在 Delphi 2010 build 14.0.3513.24210 中。它可能已在将来的版本中修复。您可以查看 QC#78696 了解最新状态。请注意，您需要添加“ReportMemoryLeaksOnShutdown := True;” 在代码中显示泄漏报告。

内存泄漏与进程内服务器方法无关。这应该是 TDSServerConnection 类中的一个问题，其中属性 ServerConnectionHandler 在使用后没有释放。

这是解决此问题的方法：

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.

故障排除：在运行时为进程内应用程序使用多个服务器方法时遇到“无效命令句柄”

这发生在 Delphi 2010 build 14.0.3513.24210 中。它可能已在将来的版本中修复。您可以查看 QC#78698 了解最新状态。

要重放此问题，您可以将服务器方法用作：

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

或这个：

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

这是解决问题的方法

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.

参考：

  1. QC#78696：用于进程内连接的 TDSServerConnection 内存泄漏
  2. QC#78698：在运行时为进程内应用程序使用多个服务器方法时遇到“无效命令句柄”
于 2009-10-19T14:24:27.377 回答
0

请参阅DataSnap：进程内服务器方法。

于 2009-10-14T09:38:51.223 回答