如何同步Indy的服务器？

时间：2015-03-20 16:01:41

标签： delphi synchronization indy

根据to this question的例子，我想同步Indy的TIdTCPServer的OnExecute，但我没有收到字符串。在我直接从服务器的执行发送字符串之前，客户端确实收到了它们，所以我很确定这方面没有问题。

因为我需要一个上下文来将行写入缓冲区，所以ServerSync包含一个属性，执行过程的上下文被赋予该属性。

服务器表单：

unit ServerForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdTCPServer, IdContext;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Server: TIdTCPServer;
    memMessages: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Execute(AContext: TIdContext);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ServerSync;

{$R *.dfm}


procedure TForm1.Execute(AContext: TIdContext);
var
  Sync : TServerSync;
begin
  Sync := TServerSync.Create(AContext);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Server := TIdTCPServer.Create;
  Server.Bindings.Add.IP:= '0.0.0.0';
  Server.Bindings.Add.Port:= 1990;
  Server.OnExecute := Execute;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  try     
    memMessages.Lines.Add('Activated Server.');
    Server.Active := True;
  except
    on E : Exception do
      ShowMessage( E.ClassName + ' error raised, with message: ' + E.Message );
  end;
end;

end.

服务器同步：

unit ServerSync;

interface

uses
  IdContext, IdSync;

  type
    TServerSync = class(TIdSync)
    constructor Create( AContext : TIdContext ); overload;
  private
    FContext : TIdContext;
  protected
    procedure DoSynchronize; override;
  end;

implementation

constructor TServerSync.Create(AContext: TIdContext);
begin
  inherited;
  FContext := AContext;
end;

procedure TServerSync.DoSynchronize;
begin
  FContext.Connection.IOHandler.WriteLn('Synced Hello World');
end;

end.

客户端：

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, FMX.Layouts,
  FMX.Memo, FMX.StdCtrls, IdGlobal, IdIntercept;

type
  TpocForm1 = class(TForm)
    ButtonConnect: TButton;
    ButtonDisconnect: TButton;
    Memo1: TMemo;
    procedure ButtonConnectClick(Sender: TObject);
    procedure ButtonDisconnectClick(Sender: TObject);
    procedure AddLine(text : String);

  private

  public
    { Public declarations }
  end;

  TpocTCPClientThread = class(TThread)
    TCPClient: TIdTCPClient;
  protected
    procedure Execute; override;
    procedure AddLineToMemo;
    procedure Connect;
    procedure Disconnect;
  end;

var
  pocForm1: TpocForm1;

implementation
{$R *.fmx}
Const
  PC_IP = '192.168.32.85';
  PORT = 1990;

var
  thread: TpocTCPClientThread;

procedure TpocForm1.ButtonConnectClick(Sender: TObject);
begin
  Memo1.Lines.Add('Client connected with server');
  thread:= TpocTCPClientThread.Create(False);
end;

procedure TpocForm1.ButtonDisconnectClick(Sender: TObject);
begin
  thread.Terminate;
  thread.WaitFor;
  FreeAndNil(thread);
  Memo1.Lines.Add('Client disconnected from server');
end;

procedure TpocForm1.AddLine(text : String);
begin
  Memo1.Lines.Add(text);
end;


procedure TpocTCPClientThread.Execute();
begin
  Connect;

  while not Terminated do
  begin
    Synchronize(AddLineToMemo);
  end;

  Disconnect;
end;

procedure TpocTCPClientThread.AddLineToMemo;
begin
  pocForm1.AddLine(TCPClient.IOHandler.ReadLn(IndyTextEncoding_OSDefault()));
end;

procedure TpocTCPClientThread.Connect;
begin
  TCPClient := TIdTCPClient.Create;
  TCPClient.Host := PC_IP;
  TCPClient.Port := PORT;
  TCPClient.Connect;
end;

procedure TpocTCPClientThread.Disconnect;
begin
  TCPClient.Disconnect;
  TCPClient.Free;
end;


end.

1 个答案:

答案 0 :(得分：5)

你在这段代码中犯了很多错误。

当服务器代码只应创建 1 条目时，服务器代码正在创建 2 Bindings条目。

服务器代码永远不会调用TIdSync.Synchronize()，这是主线程调用被覆盖的DoSynchronize()方法的队列。

服务器代码泄漏了许多TServerSync个对象。 OnExecute是一个循环事件，它在连接的生命周期中以连续循环方式调用。您永远不会在每次循环迭代中创建的Free()对象上调用TServerSync。

服务器代码在同步的IOHandler.WriteLn()代码中调用DoSynchronize()，您的客户端代码在同步的IOHandler.ReadLn()代码中调用AddLineToMemo()。他们不属于那里！套接字I / O属于OnExecute处理程序，未同步。使用synchronizaton访问共享数据，更新UI等，而不是执行套接字I / O.

简而言之，所有这些代码都需要重写。尝试更像这样的东西：

服务器：

unit ServerForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdTCPServer, IdContext;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Server: TIdTCPServer;
    memMessages: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Execute(AContext: TIdContext);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ServerSync;

{$R *.dfm}

procedure TForm1.Execute(AContext: TIdContext);
var
  Sync : TServerSync;
begin
  Sync := TServerSync.Create(AContext);
  try
    Sync.Synchronize;
    AContext.Connection.IOHandler.WriteLn(Sync.Value);
  finally
    Sync.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Server := TIdTCPServer.Create(Self);
  with Server.Bindings.Add do begin
    IP := '0.0.0.0';
    Port:= 1990;
  end;
  Server.OnExecute := Execute;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Server.Active then Exit;
  try     
    Server.Active := True;
  except
    on E : Exception do
    begin
      ShowMessage( E.ClassName + ' error raised, with message: ' + E.Message );
      Exit;
    end;
  end;
  memMessages.Lines.Add('Activated Server.');
end;

end.


unit ServerSync;

interface

uses
  IdSync;

type
  TServerSync = class(TIdSync)
  protected
    procedure DoSynchronize; override;
  end;

implementation

procedure TServerSync.DoSynchronize;
begin
  // this is called in the context of the main UI thread, do something ...
  Value := 'Synced Hello World';
end;

end.

客户端：

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, FMX.Layouts,
  FMX.Memo, FMX.StdCtrls, IdGlobal, IdIntercept;

type
  TpocForm1 = class(TForm)
    ButtonConnect: TButton;
    ButtonDisconnect: TButton;
    Memo1: TMemo;
    procedure ButtonConnectClick(Sender: TObject);
    procedure ButtonDisconnectClick(Sender: TObject);
    procedure AddLine(text : String);    
  private
  public
    { Public declarations }
  end;

var
  pocForm1: TpocForm1;

implementation

{$R *.fmx}

const
  PC_IP = '192.168.32.85';
  PORT = 1990;

type
  TpocTCPClientThread = class(TThread)
  private
    TCPClient: TIdTCPClient;
    FLine: string;
    procedure AddLineToMemo(text: string);
    procedure DoAddLineToMemo;
  protected
    procedure Execute; override;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

var
  thread: TpocTCPClientThread = nil;

procedure TpocForm1.ButtonConnectClick(Sender: TObject);
begin
  if thread = nil then
    thread := TpocTCPClientThread.Create(False);
end;

procedure TpocForm1.ButtonDisconnectClick(Sender: TObject);
begin
  if thread = nil then Exit;
  thread.Terminate;
  thread.WaitFor;
  FreeAndNil(thread);
end;

procedure TpocForm1.AddLine(text : String);
begin
  Memo1.Lines.Add(text);
end;

constructor TpocTCPClientThread.Create;
begin
  inherited Create(False);
  TCPClient := TIdTCPClient.Create;
  TCPClient.Host := PC_IP;
  TCPClient.Port := PORT;
end;

destructor TpocTCPClientThread.Destroy;
begin
  TCPClient.Free;
  inherited;
end;

procedure TpocTCPClientThread.Execute;
begin
  try
    TCPClient.Connect;
  except
    on E: Exception do
      AddLineToMemo('Unable to connect to server. ' + E.ClassName + ' error raised, with message: ' + E.Message );
    Exit;
  end;

  try
    try
      AddLineToMemo('Client connected to server');
      TCPClient.IOHandler.DefStringEncoding := IndyTextEncoding_OSDefault;

      while not Terminated do
      begin
        AddLineToMemo(TCPClient.IOHandler.ReadLn);
      end;
    except
      on E: Exception do
        AddLineToMemo( E.ClassName + ' error raised, with message: ' + E.Message );
    end;
  finally
    TCPClient.Disconnect;
    AddLineToMemo('Client disconnected from server');
  end;
end;

procedure TpocTCPClientThread.AddLineToMemo(text: string);
begin
  FLine := text;
  Synchronize(DoAddLineToMemo);
end;

procedure TpocTCPClientThread.DoAddLineToMemo;
begin
  pocForm1.AddLine(FLine);
end;

end.
相关问题
最新问题