Как использовать в процессе серверный метод с DataSnap 2010 - PullRequest
4 голосов
/ 09 октября 2009

Я определяю метод сервера:

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

Метод EchoString возвращает эквивалентную строку значения.

Затем я использую 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;

Я могу использовать метод EchoString через TCP-соединение в клиентском приложении:

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 без изменения как клиентского, так и серверного кода.

Ответы [ 2 ]

5 голосов
/ 19 октября 2009

Метод сервера 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.

Определение модуля данных для доступа к методу сервера

Удалите TDSServer и TDSServerClass как обычно в модуль данных. Определите событие OnGetClass для экземпляра TDSServerClass. Обратите внимание, что вам не нужно удалять какие-либо транспортные компоненты, такие как 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

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

Вызвать метод сервера с помощью in-process

Из следующего кода видно, что нет разницы в доступе к методу сервера для проектирования в процессе и вне процесса.

Сначала вы создаете сервер мгновенного сбора данных. Это зарегистрирует DSServer в TDBXDriverRegistry. например DSServer1 в этом случае.

Затем вы можете использовать TSQLConnection с DSServer1 в качестве имени драйвера вместо «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;

Устранение неполадок: утечка памяти в Encounter после использования методов внутрипроцессного сервера

Это происходит в 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: недопустимая команда "Встреча" обрабатывать ", когда потребляют более одного метод сервера во время выполнения для незавершенное приложение
0 голосов
/ 14 октября 2009
...