Как потреблять в метод сервера процесс с DataSnap 2010

Question

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

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; 

я в состоянии потреблять метод EchoString через соединение TCP в клиентском приложении:

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

выше сценарии используют протокол TCP/IP в качестве протокола связи.

Однако я хочу развернуть мой ServerMethod вместе с моим клиентом как модель «In Process». Как я могу достичь этого, не меняя код моего клиента и сервера?

Какой параметр следует передать в конструктор TServerMethodClient.Create, чтобы установить соединение в процессе?

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

В старый день DataSnap, мы можем использовать TLocalConnection наслаждаться доступом процесса без изменения как клиентские и серверные коды.

Answer 1

Метод DataSnap Server был представлен в Delphi 2009. Большинство видео или демонстраций о методе сервера DataSnap доступно только для доступа к доступу к серверу на основе сокетов. например: протокол TCP или HTTP.

Однако DataSnap был разработан как масштабируемое решение для доступа к данным, способное работать с одной, двумя, тремя или более уровнями модели. Все примеры, которые мы видим до сих пор, подходят для дизайна 2 или 3 уровня. Я не могу найти никакого примера, говорящего о 1 уровне или в процессе разработки.

Действительно, очень просто работать с методом внутрипроцессного сервера. Большинство этапов аналогичны методам обработки вне процесса.

Определения сервера Метод

Определить хорошо известную EchoString() и() метод сервера Суммы:

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, как обычно, в модуль данных. Определите событие 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. 

Призовите метод сервера с помощью в процессе

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

Во-первых, вы создаете мгновение сервера datasnap. Это зарегистрирует 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; 

Troubleshoot: Encounter Memory Leak после потребляют серверные методы в процессе

Это происходит в Delphi 2010 сборки 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. 

Troubleshoot: Encounter «Неверная команда ручки», когда потребляют больше, чем один метод сервера во время выполнения для в процессе применения

Это происходит в 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. 

Reference :

1. QC# 78696: Утечка памяти в TDSServerConnection для в процессе соединения
2. QC# 78698: Encounter «Неверная команда ручки», когда потребляют больше, чем один метод сервера во время выполнения для в процессе применения

Answer 2

См. DataSnap: In-Process Server Method.