客户端/服务器应用程序

【问题标题】：Client/Server application客户端/服务器应用程序
【发布时间】：2019-10-27 15:48:26
【问题描述】：

我正在编写一个客户端/服务器应用程序。有一个服务器和几个客户端。

连接客户端时，任务是将其IP地址添加到ListBox，断开客户端时，将其从ListBox中移除。然后在客户端和服务器之间交换消息。

出现了三个问题：当客户端连接时，它的IP地址被添加到ListBox中，但是当断开连接时，它并没有从那里删除，代码如下：

type
  TSimpleClient = class(TObject)
    DNS,
    Name        : String;
    ListLink    : Integer;
    Thread      : Pointer;
  end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient.Create;
  Client.DNS := AContext.Connection.Socket.Binding.PeerIP;
  Client.ListLink := ListBox1.Items.Count;
  Client.Thread := AContext;
  ListBox1.Items.Add(Client.DNS);
  AContext.Data := Client;
  Clients.Add(Client);
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  sleep(2000);
  Client :=Pointer (AContext.Data);
  Clients.Delete(Client.ListLink);
  ListBox1.Items.Delete(ListBox1.Items.IndexOf(Client.DNS));
  Client.Free;
  AContext.Data := nil;
end;

第二个问题，在交换消息的时候，西里尔字母被给出为“???”，谷歌都查过了，也没有发现错误。

而第三个问题，客户端上有一个定时器，监听来自服务器的消息，当定时器开启时​​，客户端应用程序挂了，把这一切都放到流中也是一样的麻烦，代码： 

if not IdTCPClient1.Connected then
  Exit;
s := IdTCPClient1.Socket.ReadLn;
if s <> '' then
  Label1.Text := s;

【问题讨论】：

  • 1) 去掉 ListLink 字段，因为您没有在添加/删除客户端时保持更新，所以您滥用它会导致代码出现不良行为。而且 TIdTCPServer 是多线程的，但是你的服务器代码不是线程安全的。从工作线程访问 UI 控件时，您必须与 UI 线程同步，并保护Clients 列表。 2) 你根本没有处理 Unicode。使用 IOHandler 的 DefStringEncoding 属性，如果使用 D2007 或更早版本，则使用 DefAnsiEncoding。 3）您正在 UI 线程中读取，但 Indy 的读取方法会阻塞，直到数据到达。不要阻塞 UI 线程。
  • 以后有时间我会写一个完整而正确的答案。基本上，到目前为止，您编写的大部分代码都需要重写。
  • 谢谢你的回答，雷米。请向我解释更多关于我在代码中的错误。我使用 RAD Studio 10.3 Rio。如何与用户界面线程同步？没有 LinkList 如何跟踪断开连接的客户端？我可以举一个使用 DefStringEncoding 的例子吗？在等待独立方法时如何不阻塞 UI 线程，如果我不知道我是如何阻塞它的？对不起我的愚蠢）
  • 查看我刚刚发布的答案。

标签： delphi indy


【解决方案1】：

我发现你的代码有很多问题。

在服务器端，您需要去掉TSimpleClient.ListLink 字段。您正在滥用它，导致代码中出现不良行为，因为您在添加/删除客户端时没有保持更新。想想当您连接了 2 个客户端时会发生什么，其中ListLink 分别为 0 和 1，然后第一个客户端断开连接。第二个客户端的ListLink 将变为无效，因为您没有将其从 1 递减到 0。

另外TIdTCPServer 是一个多线程组件，它的事件在工作线程的上下文中触发，但您的事件处理程序代码不是线程安全的。当从工作线程访问 UI 控件时，您必须与主 UI 线程同步，并且您必须保护您的 Clients 列表免受跨线程边界的并发访问。在这种情况下，您实际上不需要以自己的 Clients 列表开头，因为 TIdTCPServer 有自己的线程安全 Contexts 列表，您可以使用它来访问连接的客户端。

您也根本没有处理 Unicode。默认情况下，Indy 对 Unicode 字符串的默认字节编码是 US-ASCII，这就是为什么非 ASCII 字符会得到 ?。您可以使用 IOHandler 的 DefStringEncoding 属性来设置不同的字节编码，例如 IndyTextEncoding_UTF8（如果您使用的是 Delphi 2007 或更早版本，您可能还需要使用 IOHandler 的 DefAnsiEncoding 属性来指定 ANSI 字符串的格式转换为/从 Unicode。默认情况下，它设置为IndyTextEncoding_OSDefault)。

试试这样的：

type
  TSimpleClient = class(TObject)
    DNS,
    Name            : String;
    Thread          : Pointer;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create;
begin
  inherited;
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient.Create;
  Client.DNS := PeerIP;
  Client.Thread := AContext;
  AContext.Data := Client;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);
  try
    TThread.Queue(nil,
      procedure
      var
        Index: Integer;
      begin
        Index := ListBox1.Items.IndexOfObject(Client);
        if Index <> -1 then
          ListBox1.Items.Delete(Index);
      end;
    );
  finally
    { The anonymous procedure being passed to TThread.Queue() above captures
      the Client variable itself, not its value.  On ARC platforms, we need to
      prevent Free() setting the variable to nil before it can be passed to
      IndexOfObject(), and also because IndexOfObject() expects a live object
      anyway. ARC will free the object when the anonymous procedure exits. On
      non-ARC platforms, it is OK to Free() the object here, the variable will
      not change value, and IndexOfObject() does not need a live object... }
    {$IFNDEF AUTOREFCOUNT}
    Client.Free;
    {$ENDIF}
    AContext.Data := nil;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

或者，您可以从TIdServerContext 派生TSimpleClient 并完全去掉Thread 字段：

type
  TSimpleClient = class(TIdServerContext)
    DNS,
    Name            : String;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      Self.Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.ContextClass := TSimpleClient;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient(AContext);
  Client.DNS := PeerIP;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext);

  TThread.Queue(nil,
    procedure
    var
      Index: Integer;
    begin
      Index := ListBox1.Items.IndexOfObject(Client);
      if Index <> -1 then
        ListBox1.Items.Delete(Index);
    end;
  );
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

在客户端，您正在从主 UI 线程中的套接字读取，但 Indy 使用阻塞套接字，因此它的读取方法将阻塞调用线程，直到请求的数据到达。不要阻塞主 UI 线程！仅当确实有可读取的内容时才读取，或者将读取移动到单独的工作线程中。例如：

IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
...
IdTCPClient1.Disconnect;

...

procedure TForm1.Timer1Timer(Sender: TObject);
var
  s: string;
begin
  if IdTCPClient1.Connected and (not IdTCPClient1.IOHandler.InputBufferIsEmpty) then
  begin
    s := IdTCPClient1.IOHandler.ReadLn;
    if s <> '' then
      Label1.Text := s;
  end;
end;

或者：

type
  TReadingThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TReadingThread.Execute;
var
  s: String;
begin
  while not Terminated do
  begin
    s := Form1.IdTCPClient1.IOHandler.ReadLn;
    if s <> '' then
    begin
      TThread.Queue(nil,
        procedure
        begin
          Form1.Label1.Text := s;
        end
      );
    end;
  end;
end;

...

var
  ReadingThread: TReadingThread = nil;

...

IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
ReadingThread := TReadingThread.Create(False);
...
ReadingThread.Terminate;
try
  IdTCPClient1.Disconnect;
finally
  ReadingThread.WaitFor;
  ReadingThread.Free;
end;

【讨论】：

    【解决方案2】：

    非常感谢 Remy，您的回答确实帮助我解决了我的问题。我的目标是 Windows 和 Android 平台。我稍微修复了你的代码，它对我有用：

    type
  TSimpleClient = class(TObject)
    DNS,
    Name            : String;
    Thread          : Pointer;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create;
begin
  inherited;
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
  Client: TSimpleClient;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
    Client.FlushMsgs;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient.Create;
  Client.DNS := PeerIP;
  Client.Thread := AContext;
  AContext.Data := Client;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);
  try
    TThread.Queue(nil,
      procedure
      var
        Index: Integer;
      begin
        Index := ListBox1.Items.IndexOfObject(Client);
        if Index <> -1 then
          ListBox1.Items.Delete(Index);
      end;
    );
  finally
    { The anonymous procedure being passed to TThread.Queue() above captures
      the Client variable itself, not its value.  On ARC platforms, we need to
      prevent Free() setting the variable to nil before it can be passed to
      IndexOfObject(), and also because IndexOfObject() expects a live object
      anyway. ARC will free the object when the anonymous procedure exits. On
      non-ARC platforms, it is OK to Free() the object here, the variable will
      not change value, and IndexOfObject() does not need a live object... }
    {$IFNDEF AUTOREFCOUNT}
    Client.Free;
    {$ENDIF}
    AContext.Data := nil;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

    我从 TSimpleClient.Queue 过程中添加了对 FlushMsgs 方法的调用，并开始发送消息，每次连接和断开客户端时都会更新客户端列表，并且服务器停止挂起。再次感谢 Remy，您为加快开发提供了很多帮助，金人。

    【讨论】：

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多
      热门标签
      Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode