关于Delphi 10.4.2 TIdTCPServer 的多线程通信使用

至于多线程，官方文档就有说明，其实TIdTCPServer运行过程中，当客户端连接成功后默认就是基于TIdSchedulerOfThreadDefault调度分配线程模式，为每个客户端连接都分配单独的处理线程，由于Windows线程的限制，Indy 似乎还有一种特殊的模式TIdYarnOfThread来代替传统线程，至于TIdYarnOfThread这里不做研究，开始上代码

1.启动按钮事件

IdTCPServer1.DefaultPort:= 8000;
IdTCPServer1.ListenQueue:= 1024; //同时处理请求队列数限制
IdTCPServer1.MaxConnections:= 1024;  //同时连接数量限制，为0不限制连接数
IdTCPServer1.ContextClass:= TNewIdServerContext; //设置为自定义TIdServerContext类,作用稍后说明
TIdServerContext.Active:= True;	//启动监听

2.自定义TIdServerContext类
定义这个类的好处就是用于保存用户的个人数据等等

unit uNewIdServerContext;

interface

uses Winapi.Windows, IdCustomTCPServer, IdTCPConnection, IdYarn, IdContext;

type
  TNewIdServerContext = class(TIdServerContext)
    public
      constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;	//重载
    public
      mUserID:DWORD;	//假设这里是用于保存用户的ID
  end;

implementation

constructor TNewIdServerContext.Create(AConnection: TIdTCPConnection;
  AYarn: TIdYarn; AList: TIdContextThreadList);
begin
  inherited Create(AConnection, AYarn, AList);
  mUserID:= 0;	//默认值
end;

end.

3.OnConnect、OnDesConnect、OnExecute事件处理
需要注意的是，OnConnect、OnDesConnect、OnExecute事件都是Socket线程，如果要安全更新VCL控件请使用
TThread.Synchronize(TThread.CurrentThread, procedure begin
//处理代码…
end);
交给主线程完成，这里演示就不做主线程同步处理了

OnConnect 事件

procedure TMainForm.IdTCPServer1Connect(AContext: TIdContext);
begin
  var Context:TNewIdServerContext; //Delphi 10.4.2 支持代码块定义变量
  Context:= TNewIdServerContext(AContext);
  if IdTCPServer1.Contexts.Count >= IdTCPServer1.ListenQueue then
  begin
    Context.Connection.Disconnect;
    Memo1.Lines.Add(
    Format('Socket连接已达到%d上限，%s:%d尝试连接被强制断开！', 
    [IdTCPServer1.ListenQueue, Context.Binding.PeerIP, Context.Binding.PeerPort])
    );
  end;
  
  Context.mUserID:= 123456;  //演示访问用户ID
end;

OnDesConnect事件
…
这里主要是做一些自定义类断开连接要处理的事情，这里就省略了

OnExecute事件
OnExecute事件是无限循环的，只要客户端没有断开，就会一直循环调用，这里是属于Socket线程，操作VCL控件请交给主线程，这里演示就不做处理了

procedure TMainForm.IdTCPServer1Execute(AContext: TIdContext);
var Context:TNewIdServerContext;
    Stream:TStringStream;
begin
  Context:= TNewIdServerContext(AContext); //转换为自定义类
  if Context.Connection.IOHandler.InputBufferIsEmpty then Exit; //为空退出
  
  try
    Stream:= TStringStream.Create; //初始化字符串流
    try
      Context.Connection.IOHandler.InputBuffer.ExtractToStream(Stream); //从缓冲区读入所有数据
      TThread.Synchronize(TThread.CurrentThread, procedure begin
        Memo1.Lines.Add('tcpServerExecute: ' + Stream.DataString.Trim);
      end); //输出到UI界面
    finally
      Stream.Free; //释放
    end;
  except
    on E:Exception do
    begin
      TThread.Synchronize(TThread.CurrentThread, procedure begin Memo1.Lines.Add('ServerExecute: ' + E.Message); end);
    end;
  end;
end;

4.停止服务器监听
这里可能很多人遇到IdTCPServer1.Active:= False;停止监听时程序会卡死或崩溃
其实是没有正确的停止监听服务导致的
当时我测试只有一个连接的时候可以直接IdTCPServer1.Active:= False;停止监听服务
当我测试多个客户端连接时问题就来了，线程会一直锁死
最后的处理方案是先遍历Contexts列表，调用DisConnect，再用定时器检测所有客户端线程结束后再设置IdTCPServer1.Active为False即可

关闭所有客户端连接：

var I:Integer;
    list:TIdContextList;
begin
    list:= IdTCPServer1.Contexts.LockList; //安全锁
    try
      for I := 0 to list.Count-1 do
      begin
        TNewIdServerContext(list.Items[I]).Connection.Disconnect; //断开
      end;
    finally
      IdTCPServer1.Contexts.UnlockList; //解锁
    end;
end;

定时器：

  if IdTCPServer1.Contexts.Count = 0 then
  begin
    IdTCPServer1.Active:= False;
    Memo1.Lines.Add('服务已停止');
	Timer1.Enabled:= False;
  end;