⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 nhcnetbusiness.pas

📁 NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit NhcNetBusiness;

interface

uses
  Windows, SysUtils, Classes, NhContainers, NhSocketObj, NhcNetBase,
  NhcBizNetDriver, NhLoginPacket, NhGlobalST, NhBaseBizPacket;

type

{ Classes }

  TBcNetBusiness = class;
  TBcSelfInfo = class;
  TBcNetEventDisper = class;
  TBcNetEventDisperList = class;
  TCheckTimeOutThread = class;

{ TBcNetBusiness }

  TBcNetBusiness = class(TNetHandler)
  private
    FSelfInfo: TBcSelfInfo;                    // 个人信息
    FBattleSvrTcpConn: TTcpConnection;         // 连接服务器的TCP长连接
    FEventDisperList: TBcNetEventDisperList;
    FCheckTimeOutThread: TCheckTimeOutThread;
  private
    function GetIsLoginToBattleSvr: Boolean;
    function CheckTcpBroken(Task: TTcpTask): Boolean;

    procedure DoOnLoginResult(Task: TTcpTask);
    procedure DoOnRegisterResult(Task: TTcpTask);
    procedure DoOnChatResult(Task: TTcpTask);
    procedure DoOnKeepAliveResult(Task: TTcpTask);
    procedure DoOnSendUserEnterGameResult(Task: TTcpTask);

    procedure DoOnUserEnterNotify(Packet: TLoginUserEnterNotifyPacket);
    procedure DoOnUserLeaveNotify(Packet: TLoginUserLeaveNotifyPacket);
    procedure DoOnUserEnterGameNotify(Packet: TLoginUserEnterGameNotifyPacket);
    procedure DoOnUserChatNotify(Packet: TLoginChatNotifyPacket);
    procedure DoOnBroadMsgNotify(Packet: TLoginBroadNotifyPacket);
    procedure DoOnKeepAliveNotify(Packet: TLoginKeepAlivePacket);
  protected
    procedure DispatchUdpPacket(const PacketBuffer; PacketSize: Integer;
      const PeerAddr: TPeerAddress); override;
    procedure DispatchTcpPacket(Connection: TTcpConnection; const PacketBuffer;
      PacketSize: Integer); override;
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure Login(const UserName, Password: string; ClientVer: Cardinal);
    procedure CancelLogin;
    procedure RegisterUser(const UserName, Password: string);
    procedure SendChatMsg(const MsgInfo: TChatMsgInfo);
    procedure SendKeepAlive;
    procedure SendUserEnterGame(GameID: Integer);

    procedure DisconnectBattleConnection;

    property SelfInfo: TBcSelfInfo read FSelfInfo;
    property IsLoginToBattleSvr: Boolean read GetIsLoginToBattleSvr;
    property EventDisperList: TBcNetEventDisperList read FEventDisperList;
  end;

{ TBcSelfInfo }

  TBcSelfInfo = class(TObject)
  private
    FBaseInfo: TBaseUserInfo;                // 基本信息
    FBoardMsg: string;
    FMainRelayPort: Word;
    FGameAry: TGameInfoAry;
    FLastRecvKeepAliveTime: Cardinal;        // 最后接收到KeepAlive的Unix时间
  private
    function GetUserName: string;

    procedure SetGameAry(Value: TGameInfoAry);
  public
    constructor Create;

    function GetGameNameByID(GameID: Integer): string;

    property UserName: string read GetUserName;
    property BaseInfo: TBaseUserInfo read FBaseInfo;
    property BoardMsg: string read FBoardMsg;
    property MainRelayPort: Word read FMainRelayPort;
    property GameAry: TGameInfoAry read FGameAry;
  end;

{ TBcNetEventDisper }

  TLoginResultEvent = procedure(ResultCode: Integer; const ResultMsg: string;
    UserAry: TBaseUserInfoAry) of object;
  TRegisterResultEvent = procedure(ResultCode: Integer; const ResultMsg: string) of object;
  TBattleSvrTcpBrokenEvent = procedure of object;
  TOnUserEnterNotify = procedure(const UserInfo: TBaseUserInfo) of object;
  TOnUserLeaveNotify = procedure(const UserName: string) of object;
  TOnChatNotify = procedure(const MsgInfo: TChatMsgInfo) of object;
  TOnBroadMsgNotify = procedure(const BroadMsg: string) of object;
  TOnUserEnterGameNotify = procedure(const UserName: string; GameID: Integer) of object;

  TBcNetEventDisper = class(TObject)
  private
    FOnLoginResult: TLoginResultEvent;
    FOnBattleSvrTcpBroken: TBattleSvrTcpBrokenEvent;
    FOnRegisterResult: TRegisterResultEvent;
    FOnUserEnterNotify: TOnUserEnterNotify;
    FOnUserLeaveNotify: TOnUserLeaveNotify;
    FOnChatNotify: TOnChatNotify;
    FOnBroadMsgNotify: TOnBroadMsgNotify;
    FOnUserEnterGame: TOnUserEnterGameNotify;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

    property OnLoginResult: TLoginResultEvent read FOnLoginResult write FOnLoginResult;
    property OnRegisterResult: TRegisterResultEvent read FOnRegisterResult write FOnRegisterResult;
    property OnBattleSvrTcpBroken: TBattleSvrTcpBrokenEvent read FOnBattleSvrTcpBroken write FOnBattleSvrTcpBroken;

    property OnUserEnterNotify: TOnUserEnterNotify read FOnUserEnterNotify write FOnUserEnterNotify;
    property OnUserLeaveNotify: TOnUserLeaveNotify read FOnUserLeaveNotify write FOnUserLeaveNotify;
    property OnUserEnterGameNotify: TOnUserEnterGameNotify read FOnUserEnterGame write FOnUserEnterGame;

    property OnChatNotify: TOnChatNotify read FOnChatNotify write FOnChatNotify;
    property OnBroadMsgNotify: TOnBroadMsgNotify read FOnBroadMsgNotify write FOnBroadMsgNotify;
  end;

{ TBcNetEventDisperList }

  TBcNetEventDisperList = class(TCustomObjectList)
  private
    function GetItems(Index: Integer): TBcNetEventDisper;
    procedure RegisterDisper(Disper: TBcNetEventDisper);
    procedure UnregisterDisper(Disper: TBcNetEventDisper);
  public
    constructor Create;
    property Items[Index: Integer]: TBcNetEventDisper read GetItems;
    property Count;
  public
    procedure InvokeOnLoginResult(ResultCode: Integer; const ResultMsg: string;
      UserAry: TBaseUserInfoAry);
    procedure InvokeOnRegisterResult(ResultCode: Integer; const ResultMsg: string);
    procedure InvokeOnBattleSvrTcpBroken;

    procedure InvokeOnUserEnterNotify(const UserInfo: TBaseUserInfo);
    procedure InvokeOnUserLeaveNotify(const UserName: string);
    procedure InvokeOnUserEnterGameNotify(const UserName: string; GameID: Integer);
    procedure InvokeOnChatNotify(const MsgInfo: TChatMsgInfo);
    procedure InvokeOnBroadMsgNotify(const BroadMsg: string);
  end;

  TCheckTimeOutThread = class(TThread)
  protected
    procedure Execute; override;
  end;

implementation

uses NhcNetManager, DateUtils, NhDebug;

{ TBcNetBusiness }

constructor TBcNetBusiness.Create;
begin
  inherited;
  FSelfInfo := TBcSelfInfo.Create;
  FEventDisperList := TBcNetEventDisperList.Create;
  FCheckTimeOutThread := TCheckTimeOutThread.Create(True);
end;

destructor TBcNetBusiness.Destroy;
begin
  NetMgr.BizNetDriver.CancelUdpRequest(Self);
  NetMgr.BizNetDriver.CancelTcpRequest(Self);
  NetMgr.BizNetDriver.RemoveConnFromRecverList(FBattleSvrTcpConn);

  FBattleSvrTcpConn.Free;

  FCheckTimeOutThread.Free;
  FEventDisperList.Free;
  FSelfInfo.Free;
  inherited;
end;

function TBcNetBusiness.GetIsLoginToBattleSvr: Boolean;
begin
  Result := (FBattleSvrTcpConn <> nil) and FBattleSvrTcpConn.Connected;
end;

function TBcNetBusiness.CheckTcpBroken(Task: TTcpTask): Boolean;
begin
  Result := Task.SocketError;
  if Result then
  begin
    FEventDisperList.InvokeOnBattleSvrTcpBroken;
  end;     
end;

//-----------------------------------------------------------------------------
// 描述: Login 结果事件
//-----------------------------------------------------------------------------
procedure TBcNetBusiness.DoOnBroadMsgNotify(Packet: TLoginBroadNotifyPacket);
begin
  FEventDisperList.InvokeOnBroadMsgNotify(Packet.BroadMsg);
end;

procedure TBcNetBusiness.DoOnChatResult(Task: TTcpTask);
begin
  if CheckTcpBroken(Task) then Exit;
end;

procedure TBcNetBusiness.DoOnKeepAliveNotify(Packet: TLoginKeepAlivePacket);
begin
  FSelfInfo.FLastRecvKeepAliveTime := DateTimeToUnix(Now);
end;

procedure TBcNetBusiness.DoOnKeepAliveResult(Task: TTcpTask);
begin
  __DebugMsg('[%s] KeepAlive Success!', [SelfInfo.FBaseInfo.UserName]);

  if CheckTcpBroken(Task) then Exit;
end;

procedure TBcNetBusiness.DoOnLoginResult(Task: TTcpTask);
var
  AckPacket: TLoginAuthAckPacket;
  ResultCode: Integer;
  ResultMsg: string;
begin
  AckPacket := TLoginAuthAckPacket.Create;
  try
    if Task.Success then
    begin
      if AckPacket.Unpack(Task.AckPacket) then
      begin
        ResultCode := AckPacket.ResultCode;
        ResultMsg:= AckPacket.ResultMsg;
      end
      else
      begin
        ResultCode := retFailure;
        ResultMsg := '无法连接到指定的服务器';
      end;
    end else begin
      ResultCode := retFailure;
      ResultMsg := '无法连接到指定的服务器';
    end;

    if ResultCode = retSuccess then
    begin
      FBattleSvrTcpConn := Task.Connection;
      NetMgr.BizNetDriver.AddConnToRecverList(FBattleSvrTcpConn);

      // 启动检查断线的进程
      FSelfInfo.FLastRecvKeepAliveTime := DateTimeToUnix(Now);
      FCheckTimeOutThread.Resume;

      FSelfInfo.FBaseInfo := AckPacket.BaseUserInfo;
      FSelfInfo.FBoardMsg := AckPacket.BoardMsg;
      FSelfInfo.FMainRelayPort := AckPacket.MainRelayPort;
      FSelfInfo.SetGameAry(AckPacket.GameAry);
    end;

    FEventDisperList.InvokeOnLoginResult(ResultCode, ResultMsg,
      AckPacket.UserAry);
  finally
    AckPacket.Free;
  end;
end;

procedure TBcNetBusiness.DoOnRegisterResult(Task: TTcpTask);
var
  AckPacket: TRegisterAckPacket;
  ResultCode: Integer;
  ResultMsg: string;
begin
  AckPacket := TRegisterAckPacket.Create;
  try
    if Task.Success then
    begin
      if AckPacket.Unpack(Task.AckPacket) then
      begin
        ResultCode := AckPacket.ResultCode;
        ResultMsg:= AckPacket.ResultMsg;
      end
      else
      begin
        ResultCode := retFailure;
        ResultMsg := '无法连接到指定的服务器';
      end;
    end else begin
      ResultCode := retFailure;
      ResultMsg := '无法连接到指定的服务器';
    end;

    FEventDisperList.InvokeOnRegisterResult(ResultCode, ResultMsg);
  finally
    AckPacket.Free;
  end;
end;

procedure TBcNetBusiness.DoOnSendUserEnterGameResult(Task: TTcpTask);
begin
  if CheckTcpBroken(Task) then Exit;
end;

procedure TBcNetBusiness.DoOnUserChatNotify(Packet: TLoginChatNotifyPacket);
begin
  FEventDisperList.InvokeOnChatNotify(Packet.MsgInfo);
end;

procedure TBcNetBusiness.DoOnUserEnterGameNotify(
  Packet: TLoginUserEnterGameNotifyPacket);
begin
  FEventDisperList.InvokeOnUserEnterGameNotify(Packet.UserName, Packet.GameID);
end;

procedure TBcNetBusiness.DoOnUserEnterNotify(
  Packet: TLoginUserEnterNotifyPacket);
begin
  FEventDisperList.InvokeOnUserEnterNotify(Packet.UserInfo);
end;

procedure TBcNetBusiness.DoOnUserLeaveNotify(
  Packet: TLoginUserLeaveNotifyPacket);
begin
  FEventDisperList.InvokeOnUserLeaveNotify(Packet.UserName);
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -