DELPHI高性能大容量SOCKET并发（二）：IOCP完成端口控件封装

关注

原创最新推荐文章于 2026-07-29 14:56:38 发布 1.6w 阅读 AI 写同款· GEO 优化 ›

[C++ 网络协议] IOCP（Input Output Completion Port） IOCP的介绍阅读详情

IOCP完成端口介绍：

完成端口模型是Windows平台下SOCKET端口模型最为复杂的一种I/O模型。如果一个应用程序需要同时管理为数众多的套接字，而且希望随着系统内安装的CPU数量的增多，应用程序的性能也可以线性提升，采用完成端口模型，往往可以达到最佳的系统性能。

完成端口可以管理成千上万的连接，长连接传文件可以支持5000个以上，长连接命令交互可以支持20000个以上。这么大并发的连接，更需要考虑的是应用场景，按照100M的网卡传输速度12.5MB/S，如果是5000个传文件连接，则每个连接能分到的速度2.56KB/S；如果是20000个命令交互连接，则每个连接分到的吞吐量是655B/S，这种速度的吞吐量对很多应用是不满足，这时就要考虑加大网卡的传输速度或实现水平扩展，这个我们后续会介绍。

完成端口是由系统内核管理多个线程之间的切换，比外部实现线程池性能要高，CPU利用率上内核和用户态可以达到1:1，很多应用线程池是无法达到的。因此同等连接数的情况下，完成端口要比INDY的TCPServer传输速度要快，吞吐量更高。

要使用完成端口，主要是以下三个函数的使用：CreateIoCompletionPort、GetQueuedCompletionStatus、PostQueuedCompletionStatus。

CreateIoCompletionPort的功能是：1、创建一个完成端口对象；2、将一个句柄和完成端口关联在一起；GetQueuedCompletionStatus是获取完成端口状态，是阻塞式调用，在指定时间内如果没有事件通知，会一直等待；PostQueuedCompletionStatus用于向完成端口投递一个完成事件通知。

function CreateIoCompletionPort(FileHandle, ExistingCompletionPort: THandle; CompletionKey, NumberOfConcurrentThreads: DWORD): THandle; stdcall;NumberOfConcurrentThreads参数定义了在一个完成端口上，同时允许执行的线程数量。将NumberOfConcurrentThreads设为0表示每个处理器各自负责一个线程的运行，为完成端口提供服务，避免过于频繁的线程场景切换。因此可以使用下列语句来创建一个完成端口FIocpHandle := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);

执行线程个数

创建完成端口后，就可以将套接字句柄与对象关联在一起，这时就需要创建工作者线程，以便在完成端口收到数据后，为完成端口提供处理数据线程。到底创建多少个线程为完成端口服务，这个是完成端口最为复杂的一方面，创建多了线程会造成频繁的线程场景切换；创建少了线程如果某一个处理非常耗时，如连接数据库、读写文件，又会造成完成端口拥塞，因此这个参数需要提供设置，并根据最终的应用场景反复测试得出一个结果。一般的经验值是设置为CPU的个数*2+4；

IOCP完成端口一般使用步骤

1、创建一个完成端口；

2、判断系统内安装了多少个处理器；

3、创建工作者线程；

4、创建一个SOCKET套接字开始监听；

5、使用Accept接收连接；

6、调用CreateIoCompletionPort将连接和完成端口绑定在一起；

7、投递接收数据请求

8、工作者线程调用GetQueuedCompletionStatus获取事件通知，处理数据；

IOCP控件核心代码

第1步到第4步实现代码：

procedure TIocpServer.Open;
var
  WsaData: TWsaData;
  iNumberOfProcessors, i, iWorkThreadCount: Integer;
  WorkThread: TWorkThread;
  Addr: TSockAddr;
begin
  if WSAStartup($0202, WsaData) <> 0 then  //初始化SOCKET
    raise ESocketError.Create(GetLastWsaErrorStr);
  FIocpHandle := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);  //创建一个完成端口
  if FIocpHandle = 0 then
    raise ESocketError.Create(GetLastErrorStr);
  FSocket := WSASocket(PF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED); //创建一个SOCKET句柄
  if FSocket = INVALID_SOCKET then
    raise ESocketError.Create(GetLastWsaErrorStr);
  FillChar(Addr, SizeOf(Addr), 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := htons(FPort);
  Addr.sin_addr.S_addr := htonl(INADDR_ANY); //在任何地址上监听，如果有多块网卡，会每块都监听，也可以指定只监听某一个IP地址
  if bind(FSocket, @Addr, SizeOf(Addr)) <> 0 then //把SOCKET句柄绑定端口
    raise ESocketError.Create(GetLastWsaErrorStr);
  if listen(FSocket, MaxInt) <> 0 then 
     raise ESocketError.Create(GetLastWsaErrorStr);
  iNumberOfProcessors := GetCPUCount; //获取CPU个数
  iWorkThreadCount := iNumberOfProcessors * 2 + 4; //由于服务器处理可能比较费时间，因此线程设为CPU*2+4
  if iWorkThreadCount < FMinWorkThrCount then //限定最大工作者线程和最小工作者线程
    iWorkThreadCount := FMinWorkThrCount;
  if iWorkThreadCount > FMaxWorkThrCount then
    iWorkThreadCount := FMaxWorkThrCount;
  for i := 0 to iWorkThreadCount - 1 do //创建工作者线程
  begin
    WorkThread := TWorkThread.Create(Self, True);
    FWorkThreads.Add(WorkThread);
    WorkThread.Resume;
  end;
  FAcceptThreadPool.Active := True; //启动监听线程池
  FAcceptThread := TAcceptThread.Create(Self, True); //启动监听线程
  FAcceptThread.Resume;
end;

第5步和第6步实现代码：

procedure TIocpServer.AcceptClient;
var
  ClientSocket: TSocket;
begin
  ClientSocket := WSAAccept(FSocket, nil, nil, nil, 0); //接收连接
  if ClientSocket <> INVALID_SOCKET then
  begin
    if not FActive then
    begin
      closesocket(ClientSocket);
      Exit;
    end;
    FAcceptThreadPool.PostSocket(ClientSocket); //这里使用线程池主要作用是为了判断发送的第一个字节身份标识，用来是判断协议类型
  end;
end;

FAcceptThreadPool是一个用完成端口实现的线程池TIocpThreadPool，主要是有TCheckThread来判断完成端口的返回，并检测是否6S内有发送标志位上来，主要实现过程是响应OnConnect事件，并在OnConnect事件中判断是否允许连接。

procedure TIocpServer.CheckClient(const ASocket: TSocket);
var
  SocketHandle: TSocketHandle;
  iIndex: Integer;
  ClientSocket: PClientSocket;
begin
  SocketHandle := nil;
  if not DoConnect(ASocket, SocketHandle) then //如果不允许连接，则退出
  begin
    closesocket(ASocket);
    Exit;
  end;
  FSocketHandles.Lock; //加到列表中
  try
    iIndex := FSocketHandles.Add(SocketHandle);
    ClientSocket := FSocketHandles.Items[iIndex];
  finally
    FSocketHandles.UnLock;
  end;
  if CreateIoCompletionPort(ASocket, FIOCPHandle, DWORD(ClientSocket), 0) = 0 then //将连接和完成端口绑定在一起
  begin
    DoError('CreateIoCompletionPort', GetLastWsaErrorStr);
    FSocketHandles.Lock; //如果投递到列表中失败，则删除
    try
      FSocketHandles.Delete(iIndex);
    finally
      FSocketHandles.UnLock;
    end;
  end
  else
  begin
    SocketHandle.PreRecv(nil); //投递接收请求
  end;
end;

procedure TDMDispatchCenter.IcpSvrConnect(const ASocket: Cardinal;
  var AAllowConnect: Boolean; var SocketHandle: TSocketHandle);
var
  BaseSocket: TBaseSocket;
  chFlag: Char;

  function GetSocket(const AEnable: Boolean; BaseSocketClass: TBaseSocketClass): TBaseSocket;
  begin
    if AEnable then
      Result := BaseSocketClass.Create(IcpSvr, ASocket)
    else
      Result := nil;
  end;
begin
  if (GIniOptions.MaxSocketCount > 0) and (IcpSvr.SocketHandles.Count >= GIniOptions.MaxSocketCount) then
  begin
    AAllowConnect := False;
    Exit;
  end;
  if IcpSvr.ReadChar(ASocket, chFlag, 6*1000) then //必须在6S内收到标志
  begin
    case TSocketFlag(Byte(chFlag)) of
      sfSQL: BaseSocket := GetSocket(GIniOptions.SQLProtocol, TSQLSocket);
      sfUpload: BaseSocket := GetSocket(GIniOptions.UploadProtocol, TUploadSocket);
      sfDownload: BaseSocket := GetSocket(GIniOptions.DownloadProtocol, TDownloadSocket);
      sfControl: BaseSocket := GetSocket(GIniOptions.ControlProtocol, TControlSocket);
      sfLog: BaseSocket := GetSocket(GIniOptions.LogProtocol, TLogSocket);
    else
      BaseSocket := nil;;
    end;
    if BaseSocket <> nil then
    begin
      SocketHandle := BaseSocket;
      WriteLogMsg(ltDebug, Format('Client Connect, Local Address: %s:%d; Remote Address: %s:%d',
        [SocketHandle.LocalAddress, SocketHandle.LocalPort, SocketHandle.RemoteAddress, SocketHandle.RemotePort]));
      WriteLogMsg(ltDebug, Format('Client Count: %d', [IcpSvr.SocketHandles.Count + 1]));
      AAllowConnect := True;
    end
    else
      AAllowConnect := False;
  end
  else
    AAllowConnect := False;
end;

其中ReadChar函数是用于判断指定时间是否有数据上来，函数实现过程用Select函数检测：

function TIocpServer.ReadChar(const ASocket: TSocket; var AChar: Char; const ATimeOutMS: Integer): Boolean;
var
  iRead: Integer;
begin
  Result := CheckTimeOut(ASocket, ATimeOutMS);
  if Result then
  begin
    iRead := recv(ASocket, AChar, 1, 0);
    Result := iRead = 1; 
  end;
end;

function TIocpServer.CheckTimeOut(const ASocket: TSocket;
  const ATimeOutMS: Integer): Boolean;
var
  tmTo: TTimeVal;
  FDRead: TFDSet;
begin
  FillChar(FDRead, SizeOf(FDRead), 0);
  FDRead.fd_count := 1;
  FDRead.fd_array[0] := ASocket;
  tmTo.tv_sec := ATimeOutMS div 1000;
  tmTo.tv_usec := (ATimeOutMS mod 1000) * 1000;
  Result := Select(0, @FDRead, nil, nil, @tmTO) = 1;
end;

第7步实现代码

接收连接之后要投递接收数据请求，实现代码：

procedure TSocketHandle.PreRecv(AIocpRecord: PIocpRecord);
var
  iFlags, iTransfer: Cardinal;
  iErrCode: Integer;
begin
  if not Assigned(AIocpRecord) then
  begin
    New(AIocpRecord);
    AIocpRecord.WsaBuf.buf := @FIocpRecvBuf;
    AIocpRecord.WsaBuf.len := MAX_IOCPBUFSIZE;
    FIocpRecv := AIocpRecord;
  end;
  AIocpRecord.Overlapped.Internal := 0;
  AIocpRecord.Overlapped.InternalHigh := 0;
  AIocpRecord.Overlapped.Offset := 0;
  AIocpRecord.Overlapped.OffsetHigh := 0;
  AIocpRecord.Overlapped.hEvent := 0;
  //AIocpRecord.WsaBuf.buf := @FIocpRecvBuf;
  //AIocpRecord.WsaBuf.len := MAX_IOCPBUFSIZE;
  AIocpRecord.IocpOperate := ioRead;
  iFlags := 0;
  if WSARecv(FSocket, @AIocpRecord.WsaBuf, 1, iTransfer, iFlags, @AIocpRecord.Overlapped,
    nil) = SOCKET_ERROR then
  begin
    iErrCode := WSAGetLastError;
    if iErrCode = WSAECONNRESET then //客户端被关闭
      FConnected := False;
    if iErrCode <> ERROR_IO_PENDING then //不抛出异常，触发异常事件
    begin
      FIocpServer.DoError('WSARecv', GetLastWsaErrorStr);
      ProcessNetError(iErrCode);
    end;
  end;
end;

第8步实现代码：

function TIocpServer.WorkClient: Boolean;
var
  ClientSocket: PClientSocket;
  IocpRecord: PIocpRecord;
  iWorkCount: Cardinal;
begin
  IocpRecord := nil;
  iWorkCount := 0;
  ClientSocket := nil;
  Result := False;
  if not GetQueuedCompletionStatus(FIocpHandle, iWorkCount, DWORD(ClientSocket),
    POverlapped(IocpRecord), INFINITE) then //此处有可能多个线程处理同一个SocketHandle对象，因此需要加锁
  begin  //客户端异常断开
    if Assigned(ClientSocket) and Assigned(ClientSocket.SocketHandle) then
    begin
      ClientSocket.SocketHandle.FConnected := False;
      Exit;
    end;
  end;
  if Cardinal(IocpRecord) = SHUTDOWN_FLAG then
    Exit;
  if not FActive then
    Exit;
  Result := True;
  if Assigned(ClientSocket) and Assigned(ClientSocket.SocketHandle) then
  begin
    if ClientSocket.SocketHandle.Connected then
    begin
      if iWorkCount > 0 then
      begin
        try
          ClientSocket.Lock.Enter;
          try
            if Assigned(ClientSocket.SocketHandle) then
              ClientSocket.SocketHandle.ProcessIOComplete(IocpRecord, iWorkCount);
          finally
            ClientSocket.Lock.Leave;
          end;
          if Assigned(ClientSocket.SocketHandle) and (not ClientSocket.SocketHandle.Connected) then
          begin
            ClientSocket.Lock.Enter;
            try
              if Assigned(ClientSocket.SocketHandle) then
                FreeSocketHandle(ClientSocket.SocketHandle);
            finally
              ClientSocket.Lock.Leave;
            end;
          end;
        except
          on E: Exception do
            DoError('ProcessIOComplete', E.Message);
        end;
      end
      else //如果完成个数为0，且状态为接收，则释放连接
      begin
        if IocpRecord.IocpOperate = ioRead then
        begin
          ClientSocket.Lock.Enter;
          try
            if Assigned(ClientSocket.SocketHandle) then
              FreeSocketHandle(ClientSocket.SocketHandle);
          finally
            ClientSocket.Lock.Leave;
          end;
        end
        else
          DoError('WorkClient', 'WorkCount = 0, Code: ' + IntToStr(GetLastError) + ', Message: ' + GetLastErrorStr);
      end;
    end
    else //断开连接
    begin
      ClientSocket.Lock.Enter;
      try
        if Assigned(ClientSocket.SocketHandle) then
          FreeSocketHandle(ClientSocket.SocketHandle);
      finally
        ClientSocket.Lock.Leave;
      end;
    end;
  end
  else //WorkCount为0表示发生了异常，记录日志
    DoError('GetQueuedCompletionStatus', 'Return SocketHandle nil');
end;

第8步主要是使用GetQueuedCompletionStatus函数来获取完成端口事件通知，如果有事件完成，则可以通过lpCompletionKey来知道是哪个句柄有数据收到。

这里有个技巧是我们在绑定的时候使用如下语句：CreateIoCompletionPort(ASocket, FIOCPHandle, DWORD(ClientSocket), 0)，用lpCompletionKey来传递了一个指针，这其中就包含了一个锁和服务对象，定义结构如下：

{* 客户端对象和锁 *}
  TClientSocket = record
    Lock: TCriticalSection;
    SocketHandle: TSocketHandle;
  end;
  PClientSocket = ^TClientSocket;

因而我们在收到事件通知后，就可以直接调用TSocketHandle对象来完成分包解包以及后续的逻辑处理。
这样一个完成端口的整体骨架就有了，后续还有收发数据、分包解包和业务逻辑处理，以及对象和锁分离等细节处理。更详细代码见示例代码的IOCPSocket单元。

V1版下载地址：http://download.youkuaiyun.com/detail/sqldebug_fan/4510076，需要资源10分，有稳定性问题，可以作为研究稳定性用；

V2版下载地址：http://download.youkuaiyun.com/detail/sqldebug_fan/5560185，不需要资源分，解决了稳定性问题和提高性能；免责声明：此代码只是为了演示IOCP编程，仅用于学习和研究，切勿用于商业用途。水平有限，错误在所难免，欢迎指正和指导。邮箱地址：fansheng_hx@163.com

收录于