DELPHI高性能大容量SOCKET并发（三）：接收、发送、缓存

关注

原创最新推荐文章于 2026-08-13 12:07:42 发布 1.2w 阅读 AI 写同款· GEO 优化 ›

Delphi的Socket编程步骤说明比较详细介绍 ClientSocket 和ServerSocket 重要的属性: 1.client和server都有port属性，需要一致才能互相通信 2.client有Address属性,使用时填写对方(server)的IP地址几个重要的事件: client: OnRead事件，当client受到冲击消息时在OnRead事件中可以获得server发送过来消息。 Server: O... 阅读详情

接收

完成端口是结合重叠端口一起使用的，在接收数据之前，我们需要投递一个接收请求，使用function WSARecv(s: TSocket; lpBuffers: LPWSABUF; dwBufferCount: DWORD; var lpNumberOfBytesRecvd, lpFlags: DWORD; lpOverlapped: LPWSAOVERLAPPED; lpCompletionRoutine: LPWSAOVERLAPPED_COMPLETION_ROUTINE): Integer函数，接收连接后，就需要投递一个请求，代码如下：
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.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;
WSARecv会返回错误，可以帮助我们定位网络问题，如连接断了，具体函数代码如下：
procedure TSocketHandle.ProcessNetError(const AErrorCode: Integer);
begin
  if AErrorCode = WSAECONNRESET then //客户端断开连接
    FConnected := False
  else if AErrorCode = WSAEDISCON then //客户端断开连接
    FConnected := False
  else if AErrorCode = WSAENETDOWN then //网络异常
    FConnected := False
  else if AErrorCode = WSAENETRESET then //心跳包拦截到的异常
    FConnected := False
  else if AErrorCode = WSAESHUTDOWN then //连接被关闭
    FConnected := False
  else if AErrorCode = WSAETIMEDOUT then //连接断掉或者网络异常
    FConnected := False;
end;
WSARecv函数还有另外一个作用，如果客户端断开连接了，WSARecv会收到一个0字节的返回，我们可以根据这个释放连接对象。如果客户端直接拔网线，WSARecv是检测不到，这是我们要根据超时来检测。

接收连接之后我们投递一次接收数据请求，然后收到数据处理后，再投递下一次请求，因而我们相当于每次只有一个接收请求，我们只需要定义一个接收结构体和一个固定大小的缓存就可以了，类似：
{* 保存投递请求的地址信息 *}
    FIocpRecv: PIocpRecord;
    FIocpRecvBuf: array[0..MAX_IOCPBUFSIZE-1] of Char;
接收的数据我们一起放在一个内存流中，主要代码如下：
procedure TSocketHandle.ProcessIOComplete(AIocpRecord: PIocpRecord;
  const ACount: Cardinal);
begin
  case AIocpRecord.IocpOperate of
    ioNone: Exit;
    ioRead: //收到数据
    begin
      FActiveTime := Now;
      ReceiveData(AIocpRecord.WsaBuf.buf, ACount);
      if FConnected then
        PreRecv(AIocpRecord); //投递请求
    end;
    ioWrite: //发送数据完成，需要释放AIocpRecord的指针
    begin
      FActiveTime := Now;
      FSendOverlapped.Release(AIocpRecord);
    end;
    ioStream:
    begin
      FActiveTime := Now;
      FSendOverlapped.Release(AIocpRecord);
      WriteStream; //继续发送流
    end;
  end;
end;

procedure TSocketHandle.ReceiveData(AData: PAnsiChar; const ALen: Cardinal);
begin
  FInputBuf.Write(AData^, ALen);
  Process;
end;
有很多完成端口为了提高效率，会对接收队列使用内存池，以减少内存的分配和释放次数，使用内存流会有频繁的申请和释放操作，也容易造成碎片，我们这里没有使用内存池，而是使用FastMM来加快速度。FastMM在多线程和内存碎片方面做的比DELPHI自带的内存管理器要强，一般能提高2到3倍的性能。

发送

发送和接收是类似的，使用function WSASend(s: TSocket; lpBuffers: LPWSABUF; dwBufferCount: DWORD; var lpNumberOfBytesSent: DWORD; dwFlags: DWORD; lpOverlapped: LPWSAOVERLAPPED; lpCompletionRoutine: LPWSAOVERLAPPED_COMPLETION_ROUTINE): Integer函数，如发送一个Buffer的示例代码如下：
procedure TSocketHandle.WriteBuffer(const ABuffer; const ACount: Integer;
  const AIocpOperate: TIocpOperate);
var
  IocpRec: PIocpRecord;
  iErrCode: Integer;
  dSend, dFlag: DWORD;
begin
  IocpRec := FSendOverlapped.Allocate(ACount);
  FillChar(IocpRec.Overlapped, SizeOf(IocpRec.Overlapped), 0);
  IocpRec.IocpOperate := AIocpOperate;
  System.Move(ABuffer, IocpRec.WsaBuf.buf^, ACount);
  dFlag := 0;
  if WSASend(FSocket, @IocpRec.WsaBuf, 1, dSend, dFlag, @IocpRec.Overlapped, nil) = SOCKET_ERROR then
  begin
    iErrCode := WSAGetLastError;
    if iErrCode <> ERROR_IO_PENDING then
    begin
      FIocpServer.DoError('WSASend', GetLastWsaErrorStr);
      ProcessNetError(iErrCode);
    end;
  end;  
end;
检测网络连接类似接收逻辑。

发送时需要先申请一个缓存，发送完成后释放这个缓存，因而在WriteBuffer时需要先用FSendOverlapped申请一个缓存，然后用WSASend投递给完成端口，完成端口执行完成后，需要释放这块缓存，代码如下：
procedure TSocketHandle.ProcessIOComplete(AIocpRecord: PIocpRecord;
  const ACount: Cardinal);
begin
  case AIocpRecord.IocpOperate of
    ioNone: Exit;
    ioRead: //收到数据
    begin
      FActiveTime := Now;
      ReceiveData(AIocpRecord.WsaBuf.buf, ACount);
      if FConnected then
        PreRecv(AIocpRecord); //投递请求
    end;
    ioWrite: //发送数据完成，需要释放AIocpRecord的指针
    begin
      FActiveTime := Now;
      FSendOverlapped.Release(AIocpRecord);
    end;
    ioStream:
    begin
      FActiveTime := Now;
      FSendOverlapped.Release(AIocpRecord);
      WriteStream; //继续发送流
    end;
  end;
end;
在这儿如果要加快速度和减少内存碎片，也可以使用内存池等技术。

FSendOverlapped是一个列表管理，代码如下：
  {* 发送所申请的重叠端口缓冲 *}
  TSendOverlapped = class
  private
    FList: TList;
    FLock: TCriticalSection;
    procedure Clear;
  public
    constructor Create;
    destructor Destroy; override;
    {* 申请一个 *}
    function Allocate(ALen: Cardinal): PIocpRecord;
    {* 释放一个 *}
    procedure Release(AValue: PIocpRecord);
  end;
{ TSendOverlapped }

procedure TSendOverlapped.Clear;
var
  i: Integer;
begin
  FLock.Enter;
  try
    for i := 0 to FList.Count - 1 do
    begin
      FreeMemory(PIocpRecord(FList.Items[i]).WsaBuf.buf);
      PIocpRecord(FList.Items[i]).WsaBuf.buf := nil;
      Dispose(PIocpRecord(FList.Items[i]));
    end;
    FList.Clear;
  finally
    FLock.Leave;
  end;
end;

constructor TSendOverlapped.Create;
begin
  inherited Create;
  FList := TList.Create;
  FLock := TCriticalSection.Create;
end;

destructor TSendOverlapped.Destroy;
begin
  Clear;
  FList.Free;
  FLock.Free;
  inherited;
end;

function TSendOverlapped.Allocate(ALen: Cardinal): PIocpRecord;
begin
  FLock.Enter;
  try
    New(Result);
    Result.Overlapped.Internal := 0;
    Result.Overlapped.InternalHigh := 0;
    Result.Overlapped.Offset := 0;
    Result.Overlapped.OffsetHigh := 0;
    Result.Overlapped.hEvent := 0;
    Result.IocpOperate := ioNone;
    Result.WsaBuf.buf := GetMemory(ALen);
    Result.WsaBuf.len := ALen;
    FList.Add(Result);
  finally
    FLock.Leave;
  end;
end;

procedure TSendOverlapped.Release(AValue: PIocpRecord);
var
  i: Integer;
begin
  FLock.Enter;
  try
    for i := 0 to FList.Count - 1 do
    begin
      if Cardinal(AValue) = Cardinal(FList[i]) then
      begin
        FreeMemory(PIocpRecord(FList.Items[i]).WsaBuf.buf);
        PIocpRecord(FList.Items[i]).WsaBuf.buf := nil;
        Dispose(PIocpRecord(FList.Items[i]));
        FList.Delete(i);
        Break;
      end;
    end;
  finally
    FLock.Leave;
  end;
end;
TSendOverlapped由于只给一个TSocketHandle服务，因而可以不加锁，因为对每个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