nhcnetbusiness.pas

NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库

//-----------------------------------------------------------------------------
// 描述: 收到 NetDriver 分派过来的TCP数据
//-----------------------------------------------------------------------------
procedure TBcNetBusiness.DisconnectBattleConnection;
begin
  NetMgr.BizNetDriver.RemoveConnFromRecverList(FBattleSvrTcpConn);
  FreeAndNil(FBattleSvrTcpConn);
end;

procedure TBcNetBusiness.DispatchTcpPacket(Connection: TTcpConnection;
  const PacketBuffer; PacketSize: Integer);
var
  HeaderPtr: PBizTcpPacketHeader;
  Packet: TBizTcpPacket;

  procedure ProcessBattlePacket;
  begin
    case HeaderPtr.ActionCode of
      acLgUserEnterNotify:               // 收到用户进入消息
        begin
          Packet := TLoginUserEnterNotifyPacket.Create;
          if Packet.Unpack(PacketBuffer, PacketSize) then
            DoOnUserEnterNotify(TLoginUserEnterNotifyPacket(Packet));
        end;
      acLgUserLeaveNotify:               // 收到用户退出消息
        begin
          Packet := TLoginUserLeaveNotifyPacket.Create;
          if Packet.Unpack(PacketBuffer, PacketSize) then
            DoOnUserLeaveNotify(TLoginUserLeaveNotifyPacket(Packet));
        end;
      acLgChatNotify:                    // 收到用户聊天消息
        begin
          Packet := TLoginChatNotifyPacket.Create;
          if Packet.Unpack(PacketBuffer, PacketSize) then
            DoOnUserChatNotify(TLoginChatNotifyPacket(Packet));
        end;
      acLgBroadNotify:                   // 收到系统公告消息
        begin
          Packet := TLoginBroadNotifyPacket.Create;
          if Packet.Unpack(PacketBuffer, PacketSize) then
            DoOnBroadMsgNotify(TLoginBroadNotifyPacket(Packet));
        end;
      acLgKeepAlive:                   // KeepAlive
        begin
          Packet := TLoginKeepAlivePacket.Create;
          if Packet.Unpack(PacketBuffer, PacketSize) then
            DoOnKeepAliveNotify(TLoginKeepAlivePacket(Packet));
        end;
      acLgUserEnterGameNotify:         // 用户进入游戏通知
        begin
          Packet := TLoginUserEnterGameNotifyPacket.Create;
          if Packet.Unpack(PacketBuffer, PacketSize) then
            DoOnUserEnterGameNotify(TLoginUserEnterGameNotifyPacket(Packet));
        end;
    end;
  end;
begin
  HeaderPtr := PBizTcpPacketHeader(@PacketBuffer);
  Packet := nil;
  try
    ProcessBattlePacket;
  finally
    Packet.Free;
  end;
end;

procedure TBcNetBusiness.DispatchUdpPacket(const PacketBuffer;
  PacketSize: Integer; const PeerAddr: TPeerAddress);
begin
  // nothing
end;


//-----------------------------------------------------------------------------
// 描述: 登录
//-----------------------------------------------------------------------------
procedure TBcNetBusiness.Login(const UserName, Password: string;
  ClientVer: Cardinal);
var
  Packet: TLoginAuthPacket;
begin
  NetMgr.BizNetDriver.RemoveConnFromRecverList(FBattleSvrTcpConn);
  FreeAndNil(FBattleSvrTcpConn);

  Packet := TLoginAuthPacket.Create;
  Packet.InitHeader;
  Packet.InitData(UserName, Password, ClientVer);

  NetMgr.BizNetDriver.TransferTcpData(NetMgr.ServerAddr, Packet, True, Self,
    DoOnLoginResult);
end;

procedure TBcNetBusiness.RegisterUser(const UserName, Password: string);
var
  Packet: TRegisterPacket;
begin
  Packet := TRegisterPacket.Create;
  Packet.InitHeader;
  Packet.InitData(UserName, Password);

  NetMgr.BizNetDriver.TransferTcpData(NetMgr.ServerAddr, Packet, True, Self,
    DoOnRegisterResult);
end;

procedure TBcNetBusiness.SendChatMsg(const MsgInfo: TChatMsgInfo);
var
  Packet: TLoginChatNotifyPacket;
begin
  Packet := TLoginChatNotifyPacket.Create;
  Packet.InitHeader;
  Packet.InitData(MsgInfo);

  NetMgr.BizNetDriver.TransferTcpData(FBattleSvrTcpConn, Packet, False, Self,
    DoOnChatResult);
end;

procedure TBcNetBusiness.SendKeepAlive;
var
  Packet: TLoginKeepAlivePacket;
begin
  Packet := TLoginKeepAlivePacket.Create;
  Packet.InitHeader;
  Packet.InitData;

  NetMgr.BizNetDriver.TransferTcpData(FBattleSvrTcpConn, Packet, False, Self,
    DoOnKeepAliveResult);
end;

procedure TBcNetBusiness.SendUserEnterGame(GameID: Integer);
var
  Packet: TLoginUserEnterGameNotifyPacket;
begin
  Packet := TLoginUserEnterGameNotifyPacket.Create;
  Packet.InitHeader;
  Packet.InitData(SelfInfo.UserName, GameID);

  NetMgr.BizNetDriver.TransferTcpData(FBattleSvrTcpConn, Packet, False, Self,
    DoOnSendUserEnterGameResult);
end;

//-----------------------------------------------------------------------------
// 描述: 取消登录
//-----------------------------------------------------------------------------
procedure TBcNetBusiness.CancelLogin;
begin
  NetMgr.BizNetDriver.CancelTcpRequest(DoOnLoginResult);
end;

{ TBcSelfInfo }

constructor TBcSelfInfo.Create;
begin
  inherited;
  FLastRecvKeepAliveTime := DateTimeToUnix(Now);
end;

function TBcSelfInfo.GetGameNameByID(GameID: Integer): string;
var
  I: Integer;
begin
  Result := '空闲';
  for I := 0 to Length(GameAry) - 1 do
  begin
    if GameAry[I].GameID = GameID then
    begin
      Result := GameAry[I].GameName;
      Break;
    end;
  end;
end;

function TBcSelfInfo.GetUserName: string;
begin
  Result := FBaseInfo.UserName;
end;

procedure TBcSelfInfo.SetGameAry(Value: TGameInfoAry);
var
  I: Integer;
begin
  SetLength(FGameAry, Length(Value));
  for I := 0 to Length(Value) - 1 do
    FGameAry[I] := Value[I];
end;

{ TBcNetEventDisper }

procedure TBcNetEventDisper.AfterConstruction;
begin
  inherited;
  NetMgr.NetBusiness.EventDisperList.RegisterDisper(Self);
end;

procedure TBcNetEventDisper.BeforeDestruction;
begin
  NetMgr.NetBusiness.EventDisperList.UnregisterDisper(Self);
  inherited;
end;

{ TBcNetEventDisperList }

constructor TBcNetEventDisperList.Create;
begin
  inherited Create(False, True);
end;

function TBcNetEventDisperList.GetItems(Index: Integer): TBcNetEventDisper;
begin
  Result := TBcNetEventDisper(inherited Items[Index]);
end;

procedure TBcNetEventDisperList.RegisterDisper(Disper: TBcNetEventDisper);
begin
  Add(Disper, False);
end;

procedure TBcNetEventDisperList.UnregisterDisper(Disper: TBcNetEventDisper);
begin
  Extract(Disper);
end;

procedure TBcNetEventDisperList.InvokeOnLoginResult(ResultCode: Integer;
  const ResultMsg: string; UserAry: TBaseUserInfoAry);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnLoginResult) then
      Items[I].FOnLoginResult(ResultCode, ResultMsg, UserAry);
end;

procedure TBcNetEventDisperList.InvokeOnRegisterResult(ResultCode: Integer;
  const ResultMsg: string);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnRegisterResult) then
      Items[I].FOnRegisterResult(ResultCode, ResultMsg);
end;

procedure TBcNetEventDisperList.InvokeOnUserEnterGameNotify(
  const UserName: string; GameID: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnUserEnterGame) then
      Items[I].FOnUserEnterGame(UserName, GameID);
end;

procedure TBcNetEventDisperList.InvokeOnUserEnterNotify(
  const UserInfo: TBaseUserInfo);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnUserEnterNotify) then
      Items[I].FOnUserEnterNotify(UserInfo);
end;

procedure TBcNetEventDisperList.InvokeOnUserLeaveNotify(const UserName: string);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnUserLeaveNotify) then
      Items[I].FOnUserLeaveNotify(UserName);
end;

procedure TBcNetEventDisperList.InvokeOnBattleSvrTcpBroken;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnBattleSvrTcpBroken) then
      Items[I].FOnBattleSvrTcpBroken;
end;

procedure TBcNetEventDisperList.InvokeOnBroadMsgNotify(const BroadMsg: string);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnBroadMsgNotify) then
      Items[I].FOnBroadMsgNotify(BroadMsg);
end;

procedure TBcNetEventDisperList.InvokeOnChatNotify(const MsgInfo: TChatMsgInfo);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Assigned(Items[I].FOnChatNotify) then
      Items[I].FOnChatNotify(MsgInfo);
end;

{ TCheckTimeOutThread }

procedure TCheckTimeOutThread.Execute;
var
  Elapsed: Cardinal;
  LastSendTime: Cardinal;
begin
  LastSendTime := 0;

  while not Terminated do
  begin
    Elapsed := DateTimeToUnix(Now) - NetMgr.NetBusiness.SelfInfo.FLastRecvKeepAliveTime;
    if Elapsed > 60 then
    begin
      __DebugMsg('Recv KeepAliveTick TimeOut! ElapsedTime=%d', [Elapsed]);

      NetMgr.NetBusiness.FBattleSvrTcpConn.Disconnect;
    end;

    if (DateTimeToUnix(Now) - LastSendTime) > 15 then
    begin
      NetMgr.NetBusiness.SendKeepAlive;
      LastSendTime := DateTimeToUnix(Now);
    end;

    Sleep(100);
  end;
end;

end.