高性能大容量SOCKET并发（二）：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步实现代码：

[delphi] view plain copy print ?

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

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步实现代码：

[delphi] view plain copy print ?

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

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事件中判断是否允许连接。

[delphi] view plain copy print ?

1. procedure TIocpServer.CheckClient(const ASocket: TSocket);  
2. var  
3.   SocketHandle: TSocketHandle;  
4.   iIndex: Integer;  
5.   ClientSocket: PClientSocket;  
6. begin  
7.   SocketHandle := nil;  
8.   if not DoConnect(ASocket, SocketHandle) then //如果不允许连接，则退出   
9.   begin  
10.     closesocket(ASocket);  
11.     Exit;  
12.   end;  
13.   FSocketHandles.Lock; //加到列表中   
14.   try  
15.     iIndex := FSocketHandles.Add(SocketHandle);  
16.     ClientSocket := FSocketHandles.Items[iIndex];  
17.   finally  
18.     FSocketHandles.UnLock;  
19.   end;  
20.   if CreateIoCompletionPort(ASocket, FIOCPHandle, DWORD(ClientSocket), 0) = 0 then //将连接和完成端口绑定在一起   
21.   begin  
22.     DoError('CreateIoCompletionPort', GetLastWsaErrorStr);  
23.     FSocketHandles.Lock; //如果投递到列表中失败，则删除   
24.     try  
25.       FSocketHandles.Delete(iIndex);  
26.     finally  
27.       FSocketHandles.UnLock;  
28.     end;  
29.   end  
30.   else  
31.   begin  
32.     SocketHandle.PreRecv(nil); //投递接收请求   
33.   end;  
34. end;  

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;

[delphi] view plain copy print ?

1. procedure TDMDispatchCenter.IcpSvrConnect(const ASocket: Cardinal;  
2.   var AAllowConnect: Boolean; var SocketHandle: TSocketHandle);  
3. var  
4.   BaseSocket: TBaseSocket;  
5.   chFlag: Char;  
6.   
7.   function GetSocket(const AEnable: Boolean; BaseSocketClass: TBaseSocketClass): TBaseSocket;  
8.   begin  
9.     if AEnable then  
10.       Result := BaseSocketClass.Create(IcpSvr, ASocket)  
11.     else  
12.       Result := nil;  
13.   end;  
14. begin  
15.   if (GIniOptions.MaxSocketCount > 0) and (IcpSvr.SocketHandles.Count >= GIniOptions.MaxSocketCount) then  
16.   begin  
17.     AAllowConnect := False;  
18.     Exit;  
19.   end;  
20.   if IcpSvr.ReadChar(ASocket, chFlag, 6*1000) then //必须在6S内收到标志   
21.   begin  
22.     case TSocketFlag(Byte(chFlag)) of  
23.       sfSQL: BaseSocket := GetSocket(GIniOptions.SQLProtocol, TSQLSocket);  
24.       sfUpload: BaseSocket := GetSocket(GIniOptions.UploadProtocol, TUploadSocket);  
25.       sfDownload: BaseSocket := GetSocket(GIniOptions.DownloadProtocol, TDownloadSocket);  
26.       sfControl: BaseSocket := GetSocket(GIniOptions.ControlProtocol, TControlSocket);  
27.       sfLog: BaseSocket := GetSocket(GIniOptions.LogProtocol, TLogSocket);  
28.     else  
29.       BaseSocket := nil;;  
30.     end;  
31.     if BaseSocket <> nil then  
32.     begin  
33.       SocketHandle := BaseSocket;  
34.       WriteLogMsg(ltDebug, Format('Client Connect, Local Address: %s:%d; Remote Address: %s:%d',  
35.         [SocketHandle.LocalAddress, SocketHandle.LocalPort, SocketHandle.RemoteAddress, SocketHandle.RemotePort]));  
36.       WriteLogMsg(ltDebug, Format('Client Count: %d', [IcpSvr.SocketHandles.Count + 1]));  
37.       AAllowConnect := True;  
38.     end  
39.     else  
40.       AAllowConnect := False;  
41.   end  
42.   else  
43.     AAllowConnect := False;  
44. 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函数检测：

[delphi] view plain copy print ?

1. function TIocpServer.ReadChar(const ASocket: TSocket; var AChar: Char; const ATimeOutMS: Integer): Boolean;  
2. var  
3.   iRead: Integer;  
4. begin  
5.   Result := CheckTimeOut(ASocket, ATimeOutMS);  
6.   if Result then  
7.   begin  
8.     iRead := recv(ASocket, AChar, 1, 0);  
9.     Result := iRead = 1;   
10.   end;  
11. end;  
12.   
13. function TIocpServer.CheckTimeOut(const ASocket: TSocket;  
14.   const ATimeOutMS: Integer): Boolean;  
15. var  
16.   tmTo: TTimeVal;  
17.   FDRead: TFDSet;  
18. begin  
19.   FillChar(FDRead, SizeOf(FDRead), 0);  
20.   FDRead.fd_count := 1;  
21.   FDRead.fd_array[0] := ASocket;  
22.   tmTo.tv_sec := ATimeOutMS div 1000;  
23.   tmTo.tv_usec := (ATimeOutMS mod 1000) * 1000;  
24.   Result := Select(0, @FDRead, nil, nil, @tmTO) = 1;  
25. end;  

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步实现代码

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

[delphi] view plain copy print ?

1. procedure TSocketHandle.PreRecv(AIocpRecord: PIocpRecord);  
2. var  
3.   iFlags, iTransfer: Cardinal;  
4.   iErrCode: Integer;  
5. begin  
6.   if not Assigned(AIocpRecord) then  
7.   begin  
8.     New(AIocpRecord);  
9.     AIocpRecord.WsaBuf.buf := @FIocpRecvBuf;  
10.     AIocpRecord.WsaBuf.len := MAX_IOCPBUFSIZE;  
11.     FIocpRecv := AIocpRecord;  
12.   end;  
13.   AIocpRecord.Overlapped.Internal := 0;  
14.   AIocpRecord.Overlapped.InternalHigh := 0;  
15.   AIocpRecord.Overlapped.Offset := 0;  
16.   AIocpRecord.Overlapped.OffsetHigh := 0;  
17.   AIocpRecord.Overlapped.hEvent := 0;  
18.   //AIocpRecord.WsaBuf.buf := @FIocpRecvBuf;   
19.   //AIocpRecord.WsaBuf.len := MAX_IOCPBUFSIZE;   
20.   AIocpRecord.IocpOperate := ioRead;  
21.   iFlags := 0;  
22.   if WSARecv(FSocket, @AIocpRecord.WsaBuf, 1, iTransfer, iFlags, @AIocpRecord.Overlapped,  
23.     nil) = SOCKET_ERROR then  
24.   begin  
25.     iErrCode := WSAGetLastError;  
26.     if iErrCode = WSAECONNRESET then //客户端被关闭   
27.       FConnected := False;  
28.     if iErrCode <> ERROR_IO_PENDING then //不抛出异常，触发异常事件   
29.     begin  
30.       FIocpServer.DoError('WSARecv', GetLastWsaErrorStr);  
31.       ProcessNetError(iErrCode);  
32.     end;  
33.   end;  
34. end;  

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步实现代码：

[delphi] view plain copy print ?

1. function TIocpServer.WorkClient: Boolean;  
2. var  
3.   ClientSocket: PClientSocket;  
4.   IocpRecord: PIocpRecord;  
5.   iWorkCount: Cardinal;  
6. begin  
7.   IocpRecord := nil;  
8.   iWorkCount := 0;  
9.   ClientSocket := nil;  
10.   Result := False;  
11.   if not GetQueuedCompletionStatus(FIocpHandle, iWorkCount, DWORD(ClientSocket),  
12.     POverlapped(IocpRecord), INFINITE) then //此处有可能多个线程处理同一个SocketHandle对象，因此需要加锁   
13.   begin  //客户端异常断开   
14.     if Assigned(ClientSocket) and Assigned(ClientSocket.SocketHandle) then  
15.     begin  
16.       ClientSocket.SocketHandle.FConnected := False;  
17.       Exit;  
18.     end;  
19.   end;  
20.   if Cardinal(IocpRecord) = SHUTDOWN_FLAG then  
21.     Exit;  
22.   if not FActive then  
23.     Exit;  
24.   Result := True;  
25.   if Assigned(ClientSocket) and Assigned(ClientSocket.SocketHandle) then  
26.   begin  
27.     if ClientSocket.SocketHandle.Connected then  
28.     begin  
29.       if iWorkCount > 0 then  
30.       begin  
31.         try  
32.           ClientSocket.Lock.Enter;  
33.           try  
34.             if Assigned(ClientSocket.SocketHandle) then  
35.               ClientSocket.SocketHandle.ProcessIOComplete(IocpRecord, iWorkCount);  
36.           finally  
37.             ClientSocket.Lock.Leave;  
38.           end;  
39.           if Assigned(ClientSocket.SocketHandle) and (not ClientSocket.SocketHandle.Connected) then  
40.           begin  
41.             ClientSocket.Lock.Enter;  
42.             try  
43.               if Assigned(ClientSocket.SocketHandle) then  
44.                 FreeSocketHandle(ClientSocket.SocketHandle);  
45.             finally  
46.               ClientSocket.Lock.Leave;  
47.             end;  
48.           end;  
49.         except  
50.           on E: Exception do  
51.             DoError('ProcessIOComplete', E.Message);  
52.         end;  
53.       end  
54.       else //如果完成个数为0，且状态为接收，则释放连接   
55.       begin  
56.         if IocpRecord.IocpOperate = ioRead then  
57.         begin  
58.           ClientSocket.Lock.Enter;  
59.           try  
60.             if Assigned(ClientSocket.SocketHandle) then  
61.               FreeSocketHandle(ClientSocket.SocketHandle);  
62.           finally  
63.             ClientSocket.Lock.Leave;  
64.           end;  
65.         end  
66.         else  
67.           DoError('WorkClient', 'WorkCount = 0, Code: ' + IntToStr(GetLastError) + ', Message: ' + GetLastErrorStr);  
68.       end;  
69.     end  
70.     else //断开连接   
71.     begin  
72.       ClientSocket.Lock.Enter;  
73.       try  
74.         if Assigned(ClientSocket.SocketHandle) then  
75.           FreeSocketHandle(ClientSocket.SocketHandle);  
76.       finally  
77.         ClientSocket.Lock.Leave;  
78.       end;  
79.     end;  
80.   end  
81.   else //WorkCount为0表示发生了异常，记录日志   
82.     DoError('GetQueuedCompletionStatus', 'Return SocketHandle nil');  
83. end;  

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来传递了一个指针，这其中就包含了一个锁和服务对象，定义结构如下：

[delphi] view plain copy print ?

1. {* 客户端对象和锁 *}  
2.   TClientSocket = record  
3.     Lock: TCriticalSection;  
4.     SocketHandle: TSocketHandle;  
5.   end;  
6.   PClientSocket = ^TClientSocket;  

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

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

下载地址：http://download.csdn.net/detail/sqldebug_fan/4510076