mormot2创建一个异步websocket服务端

前面讲了mormot搭建一个httpserver的服务

用的是多线程模式，其实他还有异步httpserver

FServer: THttpAsyncServer;

uses
  SysUtils, Classes, DateUtils,
  mormot.core.base,
  mormot.crypt.core,
  mormot.core.json,
  mormot.net.server,
  mormot.net.http,
  mormot.core.buffers,
  mormot.core.data,
  mormot.core.variants,
  mormot.core.text,
  datasnap.DBClient,
  mormot.core.os,
  mormot.net.async,

WebSocket 是什么、它的核心作用以及如何使用，对吧？简单来说，WebSocket 是一种能让浏览器和服务器之间建立全双工、长连接的通信协议，解决了传统 HTTP 只能 "客户端主动问、服务器被动答" 的单向通信问题。

一、先搞懂：为什么需要 WebSocket？

传统 HTTP 通信是 "请求 - 响应" 模式：

• 客户端发请求 → 服务器回响应 → 连接断开；
• 想实现实时更新（比如聊天、股票行情、直播弹幕），只能靠 "轮询"（客户端每隔几秒发一次请求），效率低、耗资源。

而 WebSocket 一旦建立连接，就像打电话一样：

• 服务器和客户端双向随时发消息，不用反复建立连接；
• 连接一直保持，直到主动关闭，实时性极高、开销极小。

二、WebSocket 核心特点（新手必知）

1. 全双工通信：双方同时收发数据，不像 HTTP 是半双工（客户端发完等响应，服务器不能主动发）；
2. 长连接：一次握手（HTTP 升级）后，连接持续有效，避免频繁 TCP 握手的开销；
3. 轻量级：数据帧格式简单，头部开销小，比 HTTP 传输效率高；
4. 兼容性：主流浏览器（Chrome/Firefox/Edge）都支持，基于 TCP 协议，端口可复用 80/443（避免防火墙拦截）。

三、核心工作流程（通俗版）

1. 握手（建立连接）：客户端先通过 HTTP 发送一个 "升级请求"，告诉服务器 "我想换成 WebSocket 协议"；
2. 确认升级：服务器同意后，返回 101 状态码，连接从 HTTP 升级为 WebSocket；
3. 双向通信：连接建立后，客户端和服务器可以随时互相发消息（文本 / 二进制）；
4. 关闭连接：任意一方主动发送关闭帧，连接断开。

下面是异步websocket的实现

我这里用餐厅ID来标识客户端的唯一，一个餐厅一个客户端，然后连接上来。

websocket主要有个升级的过程，从http升级到websocket，

传输协议用websocket的帧

THotelConnection = class
  public
    ConnectionHandle: integer;
    HotelId: RawUtf8;
    ClientId: RawUtf8;
    UserId: Integer;
    UserName: RawUtf8;
    ConnectedAt: TDateTime;
    LastActive: TDateTime;
    RemoteIP: RawUtf8;
  end;

//消息类型，服务端，客户端都用这个
type
  TWSMessageType = (
    wmtUnknown = 0,           // 未知类型
    wmtPing,                  // 心跳请求
    wmtPong,                  // 心跳响应
    wmtCommand,               // 通用命令
    wmtCommandResponse,       // 通用命令响应
    wmtCommandError,          // 命令错误
    wmtEcho,                  // 回声测试
    wmtEchoResponse,           // 回声响应
  );

//消息处理
function TMormot2WebSocketServer.MsgIncomingFrame(Sender: TWebSocketProcess;
  var Frame: TWebSocketFrame): Boolean;
var
  handle: integer;
  hotelConn: THotelConnection;
  doc: TDocVariantData;
  msgTypeStr: RawUtf8;
  msgType: TWSMessageType;
  requestId, responseData, data, errorMsg: RawUtf8;
  pending: TPendingRequest;
begin
  Result := False;

  if (Sender = nil) or (Sender.Protocol = nil) then
    Exit;

  handle := Sender.Protocol.ConnectionID;

  if Frame.opcode = focContinuation then
  begin
    //获取餐厅信息
    hotelConn := GetConnectionInfo(handle);
    if hotelConn <> nil then
    begin
      SendWelcomeMessage(handle);
    end;
    Exit;
  end;

  // 只处理文本帧
  if Frame.opcode <> focText then
    Exit;

  // 更新最后活动时间
  hotelConn := GetConnectionInfo(handle);
  if hotelConn <> nil then
    hotelConn.LastActive := Now;

  // ============ 处理纯文本心跳 ============
  if Frame.payload = 'PING' then
  begin
    Log(Format('❤️  收到文本PING: Handle=%d', [handle]));
    SendPongResponse(handle);
    Exit;
  end
  else if Frame.payload = 'PONG' then
  begin
    Log(Format('❤️  收到文本PONG: Handle=%d', [handle]));
    Exit;
  end;

  try
    // 解析JSON消息
    if not doc.InitJson(Frame.payload) then
    begin
      LogError(Format('❌ 无效的JSON消息: Handle=%d', [handle]));
      Log(Format('  原始内容: %s', [Frame.payload]));
      Exit;
    end;

    // 提取消息类型
    msgTypeStr := doc.U['type'];
    msgType := StrToWSMessageType(msgTypeStr);

    if msgType = wmtUnknown then
    begin
      LogError(Format('❌ 未知消息类型: %s (Handle=%d)', [msgTypeStr, handle]));
      Log(Format('  消息内容: %s', [Frame.payload]));
      Exit;
    end;

    Log(Format('📨 处理消息: 类型=%s, 连接=%d',
      [WSMessageTypeToStr(msgType), handle]));

    // 提取请求ID
    if doc.Exists(requestId) then
    requestId := doc.U['requestId'];

    // 根据消息类型处理
    case msgType of
      wmtPing:
        begin
          Log(Format('❤️  收到JSON心跳: Handle=%d', [handle]));
          SendHeartbeatResponse(handle, doc);
        end;

      wmtCommandResponse:
        begin
          HandleCommandResponse(handle, doc);
        end;

      wmtCommandError:
        begin
          HandleCommandError(handle, doc);
        end;

      wmtEcho:
        begin
          Log(Format('🔊 收到回声测试: Handle=%d', [handle]));
          if doc.Exists('message') then
            data := doc.U['message']
          else
            data := Frame.payload;
          SendEchoResponse(handle, data);
        end;

      else
        begin
          Log(Format('⚠️  未处理的消息类型: %s', [WSMessageTypeToStr(msgType)]));
        end;
    end;

  except
    on E: Exception do
    begin
      LogError(Format('处理消息异常: Handle=%d', [handle]), E.Message);
    end;
  end;
end;



procedure TMormot2WebSocketServer.AddConnectionInfo(Handle: integer;
  const HotelId, ClientId: RawUtf8; UserId: Integer; const UserName, Token, RemoteIP: RawUtf8);
var
  hotelConn: THotelConnection;
  connectionList: TList<integer>;
begin
  // 创建连接信息
  hotelConn := THotelConnection.Create;
  hotelConn.ConnectionHandle := Handle;
  hotelConn.HotelId := HotelId; //餐厅id
  hotelConn.ClientId := ClientId;
  hotelConn.UserId := UserId;
  hotelConn.UserName := UserName;
  hotelConn.RemoteIP := RemoteIP;
  hotelConn.ConnectedAt := Now;
  hotelConn.LastActive := Now;

  FCriticalSection.Enter;
  try
    // 存储连接信息
    FConnectionInfo.Add(Handle, hotelConn);
    InterlockedIncrement(FTotalConnections);

    if not FHotelConnections.FindAndCopy(HotelId, Pointer(connectionList)) then
    begin
      connectionList := TList<integer>.Create;
      FHotelConnections.Add(HotelId, connectionList);
    end;
    connectionList.Add(Handle);

    Log(Format('连接已添加: Handle=%d, Hotel=%s, IP=%s',
      [Handle, HotelId, RemoteIP]));
  finally
    FCriticalSection.Leave;
  end;
end;




function TMormot2WebSocketServer.Start: Boolean;
var
  opts: THttpServerOptions;
  protocol: TWebSocketProtocolJson;
begin
  if FIsRunning then
  begin
    Log('服务器已经在运行中');
    Exit(True);
  end;

  Result := False;

  try
    opts := [hsoNoXPoweredHeader, hsoHeadersInterning, hsoEnableLogging];


    Log(Format('🔧 正在创建 WebSocket 服务器，端口: %d', [FPort]));

    // 创建 WebSocket 服务器
    FServer := TWebSocketAsyncServer.Create(
      IntToStr(FPort),      // 端口
      nil,                  // OnStart回调
      nil,                  // OnStop回调
      'WS_Async',       // 进程名
      DEFAULT_THREAD_POOL_SIZE, // 线程池大小
      30000,                // KeepAlive超时
      opts,                 // 服务器选项
      nil                   // 日志类
    );


    Log('✅ 服务器实例创建成功');



    protocol := TWebSocketProtocolJson.Create('');  // 空 URI 匹配所有路径
    if protocol = nil then
    begin
      LogError('❌ 创建 WebSocket 协议失败');
      Exit;
    end;

    protocol.OnBeforeIncomingFrame := ProcessIncomingFrame;

    FServer.WebSocketProtocols.Add(protocol);



    FServer.OnWebSocketUpgraded := OnWSUpgrade;      // 升级认证
    FServer.OnWebSocketClose := OnWSClose;          // 连接关闭
    FServer.OnWebSocketConnect := OnWebSocketConnectHandler ;
    FServer.OnWebSocketDisconnect :=  OnWebSocketDisconnectHandler;

    FServer.Settings.HeartbeatDelay := 20000;
    FServer.Settings.SendDelay := 10;
    FServer.ProcessName := 'IFC WebSocket Service';


    Log('🔧 正在启动服务器...');

     FServer.WaitStarted(10);


    // 验证服务器是否真的启动了
    if not FServer.Started then
    begin
      LogError('❌ 服务器启动失败: Started=False');
      Exit;
    end;

    FIsRunning := True;

    Result := True;

  except
    on E: Exception do
    begin
      LogError('启动服务器失败', E.Message);
      LogError('异常类型: ' + E.ClassName);

      // 检查是否为端口冲突
      if E.Message.Contains('10048') or E.Message.Contains('Address already in use') then
        LogError('⚠️  端口可能被占用，请检查其他程序是否使用了端口 ' + IntToStr(FPort));

      FreeAndNil(FServer);
      FIsRunning := False;
    end;
  end;
end;


function TMormot2WebSocketServer.OnWSUpgrade(Protocol: TWebSocketProtocol): integer;
var
  token, hotelId, clientId, userName, remoteIP: RawUtf8;
  userId: Integer;
  handle: integer;
begin
  Result := HTTP_BADREQUEST; // 默认返回错误

  if (Protocol = nil) then
  begin
    LogError('WebSocket升级失败: Protocol为空');
    Exit;
  end;


  // 获取连接信息
  handle := Protocol.ConnectionID;
  remoteIP := Protocol.RemoteIP;

  // 存储连接信息
  AddConnectionInfo(handle, hotelId, clientId, userId, userName, token, remoteIP);

  protocol.OnBeforeIncomingFrame := MsgIncomingFrame;
  Result := HTTP_SUCCESS; // 200 OK - 升级成功
end;