DELPHI: ошибка многопоточного соединения клиент / сервер - PullRequest
3 голосов
/ 07 апреля 2011

Это мой первый пост здесь, так что будьте осторожны: -)

Я хочу создать клиент-серверное приложение, которое использует datasnap для передачи данных.Это довольно простая задача - и есть много примеров, из которых можно извлечь уроки.НО - Имея сервер Datasnap (сборка из мастера Delphi XE), я столкнулся с проблемой, и я надеюсь, что кто-то может направить меня в правильном направлении.

Сервер и Клиент работают на одном компьютере (то естьдизайн на данный момент).На сервере запущен жизненный цикл сеанса.Сервер и Клиент совместно используют класс (опубликовано ниже).

Сервер предоставляет простой метод - GetServerObject, который использует метод GetNewObject.Сам сервер является приложением VCL - основной формой является fmServer.OnCreate устанавливает свойство серверов FormObject (FormObject: = TMyDataObject.Create);

function TServerMethods2.GetNewObject: TMyDataObject;
begin
  Result := TMyDataObject.Create;
end;

function TServerMethods2.GetServerObject: TMyDataObject;
begin
  Result := GetNewObject;
  if not Result.Assign(fmServer.FormObject) then
    raise Exception.Create('Server error : Assign failed!');
end;

Все это довольно тривиально - и моя проблема появляется, только если я превращаю свое клиентское приложение в многопоточного монстра :-) (читай- более 1 потока).

Так вот код потока для клиента.

  TDataThread = class(TThread)
  private
    DSConn: TSQLConnection;
  protected
    procedure Execute; override;
  public
    constructor Create(aConn: TSQLConnection); overload;
  end;

constructor TDataThread.Create(aConn: TSQLConnection);
begin
  inherited Create(False);
  DSConn := aConn.CloneConnection;
  FreeOnTerminate := true;
end;

procedure TDataThread.Execute;
var
  DSMethod: TServerMethods2Client;
  aDataObject : TMyDataObject;
begin
  NameThreadForDebugging('Data');
  { Place thread code here }
  DSMethod := nil;
  try
    while not terminated do
    begin
      sleep(10);
      if DSConn.Connected then
      begin
        try
          if DSMethod = nil then
            DSMethod := TServerMethods2Client.Create(DSConn.DBXConnection,false);
          if DSMethod <> nil then
            try
              aDataObject := DSMethod.GetserverObject;
            finally
              freeandnil(aDataObject);
            end;
        except
          freeandnil(DSMethod);
          DSConn.Connected := False;
        end
      end
      else
      begin
        // connect
        try
          sleep(100);
          DSConn.Open;
        except
          ;
        end;
      end;
    end;
  finally
    freeandnil(DSMethod);
    DSConn.Close;
    freeandnil(DSConn);
  end;

Когда я создаю более 1 из этих потоков - в конечном итоге я получаю ошибку (будучи«не удается установить ...» или что-то «удаленная ошибка dbx ...» ... и т. д.

Я просто не могу заставить это работать - так что я могу порождать сотни потоков / соединений к источнику данныхсервер.

Я знаю, что этот вопрос сложен, но я надеюсь, что кто-то умнее меня: -)

Если я попробую тот же код потока клиента - но получу доступ к более простому методу сервера(скажем, echostring из образца), тогда я могу запустить его с сотнями потоков.Возможно, я отвечаю себе здесь - но я слишком слеп, чтобы осознать это: -)

unit uDataObject;

interface

uses
  SysUtils;

Type
  TMyDataObject = class(TObject)
  private
    fString: String;
    fInteger: Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Assign(aSource: TMyDataObject): boolean;
    property aString: String read fString write fString;
    property aInteger: Integer read fInteger write fInteger;
  end;

implementation

{ TMyDataObject }

function TMyDataObject.Assign(aSource: TMyDataObject): boolean;
begin
  if aSource <> nil then
  begin
    try
      fString := aSource.aString;
      fInteger := aSource.aInteger;
      Result := True;
    except
      Result := false;
    end;
  end
  else
    Result := false;
end;

constructor TMyDataObject.Create;
begin
  inherited;
  Randomize;
  fString := 'The time of creation is : ' + FormatDateTime('ddmmyyyy hh:nn:ss:zzz', Now);
  fInteger := Random(100);
end;

destructor TMyDataObject.Destroy;
begin
  inherited;
end;
end.

Вся помощь приветствуется

Ответы [ 2 ]

0 голосов
/ 03 мая 2011

На это в основном ответили в комментариях и отчете об ошибках, но ... Проблема, которую вы видите, вызвана проблемой многопоточности в коде маршаллера XE.Если два потока (или два клиента) вызывают метод сервер-сервер, который принимает или возвращает определенные пользователем типы (любой тип, который будет использовать маршаллер / демаршаллер) одновременно, тогда может произойти исключение.

Iя не знаю идеального обходного пути для XE, но если возможно не использовать пользовательские типы, то вы не должны видеть проблем с многопоточностью.

Mat

0 голосов
/ 08 апреля 2011

Когда работает простой серверный метод, я думаю, что ваша проблема должна быть найдена, если какой-то "настоящий" код делает или использует.

Возможно, это связано с подключением (попробуйте изменить более простой код наиспользуйте соединение) Ваша проблема также может быть CloneConnection.Клонированное соединение освобождается, когда освобождается соединение, от которого оно клонируется.Смотри http://docwiki.embarcadero.com/VCL/en/SqlExpr.TSQLConnection.CloneConnection

...