Windows新异步网络编程模型3 RIO-服务端例子

hksoobe

已于 2023-02-26 00:44:20 修改

阅读量225

点赞数

分类专栏： Delphi 网络编程文章标签：网络

于 2023-02-26 00:40:39 首次发布

本文链接：https://blog.youkuaiyun.com/hksoobe/article/details/129222561

版权

Delphi 同时被 2 个专栏收录

30 篇文章

订阅专栏

网络编程

8 篇文章

订阅专栏

该代码示例展示了一个基于RIO（RegisteredI/ONetworkExtensions）的TCP服务器实现，它支持多个客户端连接，利用RIO接口提高网络I/O性能。服务器监听指定端口，接受新连接，接收并处理数据，以及断开客户端连接。事件处理函数TOnAcceptEvent和TOnReceiveEvent用于处理客户端接入和数据接收事件。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

unit RIOServer;
//charGPT写的代码
interface

uses
  Winapi.Windows, 
  Winapi.Messages, 
  System.SysUtils, 
  System.Variants, 
  System.Classes,
  Winapi.WinSock2, 
  Winapi.MMSystem, 
  Winapi.RIO;

const
  MAX_CLIENTS = 1000;
  MAX_BUFFER_SIZE = 1024;

type
  TClient = class
  public
    Socket: TSocket;
    Address: TSockAddrIn;
    RIO: PRIO_EXTENSION_FUNCTION_TABLE;
    RIOBuf: PRIO_BUF;
    RequestQueue: PRIO_REQUEST_QUEUE;
    DataBuf: array[0..MAX_BUFFER_SIZE - 1] of Byte;
  end;

  TOnAcceptEvent = procedure(Client: TClient) of object;
  TOnReceiveEvent = procedure(Client: TClient; BytesTransferred: DWORD) of object;

  TRioserver = class
  private
    FClients: TList<TClient>;
    FListenSocket: TSocket;
    FRIONotify: THandle;
    FOnAccept: TOnAcceptEvent;
    FOnReceive: TOnReceiveEvent;
    procedure AcceptClient(Overlapped: POverlapped);
    procedure ReceiveData(Client: TClient; Overlapped: POverlapped);
    procedure SendData(Client: TClient; Overlapped: POverlapped);
    procedure DisconnectClient(Client: TClient);
  public
    constructor Create;
    destructor Destroy; override;
    procedure StartListen(Port: Word);
    property OnAccept: TOnAcceptEvent read FOnAccept write FOnAccept;
    property OnReceive: TOnReceiveEvent read FOnReceive write FOnReceive;
  end;

implementation

constructor TRioserver.Create;
begin
  inherited;
  FClients := TList<TClient>.Create;
  FRIONotify := CreateEvent(nil, False, False, nil);
  if FRIONotify = 0 then
  begin
    RaiseLastOSError;
  end;
end;

destructor TRioserver.Destroy;
begin
  CloseHandle(FRIONotify);
  FreeAndNil(FClients);
  inherited;
end;

procedure TRioserver.StartListen(Port: Word);
var
  RetVal: Integer;
  SockAddr: TSockAddrIn;
begin
  FListenSocket := WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, WSA_FLAG_REGISTERED_IO);
  if FListenSocket = INVALID_SOCKET then
  begin
    RaiseLastOSError;
  end;
  SockAddr.sin_family := AF_INET;
  SockAddr.sin_addr.S_addr := htonl(INADDR_ANY);
  SockAddr.sin_port := htons(Port);
  RetVal := bind(FListenSocket, SockAddr, SizeOf(SockAddr));
  if RetVal = SOCKET_ERROR then
begin
  RaiseLastOSError;
end;
  RetVal := listen(FListenSocket, SOMAXCONN);
  if RetVal = SOCKET_ERROR then
  begin
    RaiseLastOSError;
  end;
  AcceptClient(nil);
end;

procedure TRioserver.AcceptClient(Overlapped: POverlapped);
var
  Client: TClient;
  AcceptExBuffer: array[0..(SizeOf(TSockAddrIn) + 16) * 2 - 1] of Byte;
  BytesTransferred: DWORD;
begin
  Client := TClient.Create;
  Client.RIO := RIO.RIO_GetExtensionFunctionTable;
  Client.RIOBuf := RIO.RIO_CreateCompletionQueue(MAX_BUFFER_SIZE, FRIONotify);
  if Client.RIOBuf = nil then
  begin
    RaiseLastOSError;
  end;
  if not RIO.AcceptEx(FListenSocket, Client.Socket, @AcceptExBuffer, 0, SizeOf(TSockAddrIn) + 16,
    SizeOf(TSockAddrIn) + 16, @BytesTransferred, Overlapped) then
  begin
    RaiseLastOSError;
  end;
  Client.RequestQueue := RIO.RIO_CreateRequestQueue(Client.Socket, 1, 1, 1, Client.RIOBuf, Client.RIOBuf, nil);
  if Client.RequestQueue = nil then
  begin
    RaiseLastOSError;
  end;
  FClients.Add(Client);
  if Assigned(FOnAccept) then
  begin
    FOnAccept(Client);
  end;
  ReceiveData(Client, nil);
  AcceptClient(nil);
end;

procedure TRioserver.ReceiveData(Client: TClient; Overlapped: POverlapped);
var
  RIOBuf: PRIO_BUF;
  RIOBufferID: DWORD;
  BytesTransferred: DWORD;
begin
  RIOBuf := Client.RIO.RIOReceive(Client.RequestQueue, @Client.DataBuf, MAX_BUFFER_SIZE, 0, Overlapped, @RIOBufferID);
  if RIOBuf = nil then
  begin
    RaiseLastOSError;
  end;

  BytesTransferred := RIO.RIO_GetCompletionStatus(Client.RIOBuf, RIOBufferID, BytesTransferred);
  if BytesTransferred = 0 then
  begin
    DisconnectClient(Client);
  end else begin
    if Assigned(FOnReceive) then
    begin
      FOnReceive(Client, BytesTransferred);
    end;
    ReceiveData(Client, nil);
  end;
end;

procedure TRioserver.SendData(Client: TClient; Overlapped: POverlapped);
var
  RIOBuf: PRIO_BUF;
  RIOBufferID: DWORD;
  BytesTransferred: DWORD;
  DataToSend: array[0..MAX_BUFFER_SIZE - 1] of Byte;
begin
  FillChar(DataToSend, MAX_BUFFER_SIZE, 0);
  RIOBuf := Client.RIO.RIOSend(Client.RequestQueue, @DataToSend, MAX_BUFFER_SIZE, 0, Overlapped, @RIOBufferID);
  if RIOBuf = nil then
  begin
    RaiseLastOSError;
  end;
  BytesTransferred := RIO.RIO_GetCompletionStatus(Client.RIOBuf, RIOBufferID, BytesTransferred);
end;

procedure TRioserver.DisconnectClient(Client: TClient);
begin
  RIO.RIO_CloseCompletionQueue(Client.RIOBuf);
  RIO.RIO_DeregisterBuffer(Client.RIOBuf);
  closesocket(Client.Socket);
  FClients.Remove(Client);
  Client.Free;
end;

end.