Diocp学习笔记 3、服务端连接、发送、接收（以实际例子记录）（DELPHI 通讯框架）

服务器通过TDiocpCoderTcpServer类进行创建，并设置相应值

一、创建服务

var
  FTcpServer: TDiocpCoderTcpServer;  //声明全局变量
//创建服务
procedure TfrmServer.FormCreate(Sender: TObject);
begin
  FUILocker := TIocpLocker.Create('界面异步操作锁');
 // FOfflineMsgs := TObjectList<TOfflineInfo>.Create;

  FTcpServer := TDiocpCoderTcpServer.Create(Self);
  FTcpServer.CreateDataMonitor;  // 创建监视器(如不创建TFMMonitor创建后不能获取监控数据)
  FTcpServer.WorkerCount := 3;   //设置线程
  // register decoder and encoder class
  FTcpServer.RegisterCoderClass(TIOCPStreamDecoder, TIOCPStreamEncoder);  // 注册加解密流类
  FTcpServer.RegisterContextClass(TMyClientContext);  // 注册客户端Context 绑定接收事件等 自己创建的类(在这里设置好后，客户端地发送请求后，会调用TMyClientContext里面的DoContextAction)
  //FTcpServer.OnContextDisconnected := OnContextNotifyEvent;
  // 设置日志记录
  sfLogger.setAppender(TStringsAppender.Create(mmoMsg.Lines));
  sfLogger.AppendInMainThread := true;

  TFMMonitor.CreateAsChild(tsState, FTcpServer);  // 创建服务端运行监控 窗体
end;

二、启用服务

  FTcpServer.Port := 60544;   //设置端口
  FTcpServer.Active := true;  //启用服务

三、停止服务

  FTcpServer.SafeStop;

四、接收客户端消息

因为在注册服务端的时候通过FTcpServer.RegisterContextClass(TMyClientContext); 注册了类TMyClientContext为客户端通讯类，所以在类下重写DoContextAction 用来接收客户端传过来的数据，并进行处理操作

/// <summary>
/// 处理客户端传来的数据
/// </summary>
procedure TMyClientContext.DoContextAction(const pvObject: TObject);
var
  lvCMDObj: TSimpleMsgPack;
begin
  // 此方法已经在 TIOCPCoderClientContext.DoExecuteRequest 中处理了线程同步了
  
  lvCMDObj := TSimpleMsgPack.Create;
  try
    try
      TMemoryStream(pvObject).Position := 0;
      //通过通讯传值操作将传过来对象转换为数据结构对象
      lvCMDObj.DecodeFromStream(TMemoryStream(pvObject));  // 解密消息
      
      //对消息进行处理操作，如返回此等操作都在这一步进行处理
      ChatExecute(lvCMDObj);  // 根据消息协议类型由对应的事件处理

      // 通知客户端本次调用是否成功
      if lvCMDObj.O['cmdIndex'] <> nil then  // 或 lvCMDObj.ForcePathObject('cmdIndex').AsString <> ''
      begin
        if lvCMDObj.O['result.code'] = nil then
          lvCMDObj.I['result.code'] := 0;
      end;
    except
      on E:Exception do
      begin
        lvCMDObj.ForcePathObject('result.code').AsInteger := -1;
        lvCMDObj.ForcePathObject('result.msg').AsString := e.Message;
        sfLogger.logMessage('处理逻辑出现异常:'+ e.Message);
        {$IFDEF CONSOLE}
        writeln('处理逻辑出现异常:'+ e.Message);
        {$ENDIF}
      end;
    end;

    //对客户端进行回传
    if lvCMDObj.O['cmdIndex'] <> nil then
    begin
      TMemoryStream(pvObject).Clear;
      lvCMDObj.EncodeToStream(TMemoryStream(pvObject));  // 加密消息
      TMemoryStream(pvObject).Position := 0;
      Self.WriteObject(pvObject);  // 添加到SendingQueue回写对象
    end;
  finally
    lvCMDObj.Free;
  end;
end;

五、给客户端传消息

1》给所有客户端传消息
可以通过Self.Owner.GetOnlineContextList(lvList)函数获得所有会话，进行传递

procedure TMyClientContext.DispatchMsgPackToAll(AMsgPack: TSimpleMsgPack);
var
  lvMS:TMemoryStream;
  i:Integer;
  lvList:TList;
  lvContext:TIOCPCoderClientContext;
begin
  lvMS := TMemoryStream.Create;
  lvList := TList.Create;
  try
    AMsgPack.EncodeToStream(lvMS);
    lvMS.Position := 0;
    // 通知所有在线的客户端有人上线或下线等行为
    Self.Owner.GetOnlineContextList(lvList);
    for i := 0 to lvList.Count - 1 do
    begin
      lvContext := TIOCPCoderClientContext(lvList[i]);
      if lvContext <> Self then
      begin
        lvContext.LockContext('推送信息', nil);
        try
          lvContext.WriteObject(lvMS);
        finally
          lvContext.UnLockContext('推送信息', nil);
        end;
      end;
    end;
  finally
    lvMS.Free;
    lvList.Free;
  end;
end;

2>指定客户端传消息
因指定客户但只知道ID编号。需要通过会话查找到此会话号，在进行传递

查找

var
  vMsgPackTo: TSimpleMsgPack;
  vFromSession, vToSession: TChatSession;


vToSession := TChatSession(ChatSessions.FindSession(vToUserID));
if vToSession <> nil then  // 接收用户在
begin
  vToContext := vToSession.Context;
  if vToContext <> nil then
  begin
     vMsgPackTo := TSimpleMsgPack.Create;
     try
        vMsgPackTo.ForcePathObject('cmdIndex').AsInteger := 6;
        vMsgPackTo.ForcePathObject('userid').AsString := vFromUserID;
        vMsgPackTo.ForcePathObject('requestID').AsString :=
          AMsgPackFrom.ForcePathObject('requestID').AsString;
        vMsgPackTo.ForcePathObject('msg').AsString :=
          AMsgPackFrom.ForcePathObject('params.msg').AsString;
        SendMsgPack(vMsgPackTo, vToContext);
    finally
         vMsgPackTo.Free;
     end;
   end;
end;

procedure TMyClientContext.SendMsgPack(AMsgPack: TSimpleMsgPack; pvContext: TObject);
var
  lvMS:TMemoryStream;
begin
  lvMS := TMemoryStream.Create;
  try
    AMsgPack.EncodeToStream(lvMS);
    lvMS.Position := 0;
    TIOCPCoderClientContext(pvContext).WriteObject(lvMS);
  finally
    lvMS.Free;
  end;
end;

3>在接收时直接回写
因为在接收的时候SELF代表的就是客户端的Context所以直接发送就可以了

      TMemoryStream(pvObject).Clear;
      lvCMDObj.EncodeToStream(TMemoryStream(pvObject));  // 加密消息
      TMemoryStream(pvObject).Position := 0;
      Self.WriteObject(pvObject);  // 添加到SendingQueue回写对象

标签：FTcpServer,end,lvMS,TMemoryStream,DELPHI,lvCMDObj,Diocp,服务端,客户端
来源： https://blog.csdn.net/z123191456/article/details/88585135