nhcbiznetdriver.pas

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

    constructor Create(ANetIO: TNetIO);
    destructor Destroy; override;

    // 发送UDP包给任何地址
    procedure SendUdpPacket(Packet: TBizUdpPacket;
      const PeerAddr: TPeerAddress;
      NeedAck: Boolean = False;
      OnTaskResult: TUdpTaskResultEvent = nil;
      Caller: TObject = nil;
      SendTimes: Integer = DefUdpSendTryTimes;
      RecvTimeout: Integer = DefUdpSendRecvTimeout);

    // 发起一个TCP连接
    procedure MakeTcpConnection(const PeerAddr: TPeerAddress;
      Caller: TObject = nil;
      OnTaskResult: TTcpTaskResultEvent = nil);

    // 建立TCP连接到指定地址，并允许发送和接收数据
    procedure TransferTcpData(const PeerAddr: TPeerAddress;
      ReqPacket: TBizTcpPacket = nil;
      NeedAck: Boolean = False;
      Caller: TObject = nil;
      OnTaskResult: TTcpTaskResultEvent = nil); overload;

    // 在指定TCP连接上发送和接收数据
    procedure TransferTcpData(Connection: TTcpConnection;
      ReqPacket: TBizTcpPacket = nil;
      NeedAck: Boolean = False;
      Caller: TObject = nil;
      OnTaskResult: TTcpTaskResultEvent = nil); overload;

    // 将TCP连接添加到接收器列表中  
    procedure AddConnToRecverList(Connection: TTcpConnection);
    // 从接收器列表中移除TCP连接 
    procedure RemoveConnFromRecverList(Connection: TTcpConnection);

    // 取消UDP发送请求
    procedure CancelUdpRequest(PacketSeqNumber: Cardinal); overload;
    procedure CancelUdpRequest(Caller: TObject); overload;
    procedure CancelUdpRequest(OnTaskResult: TUdpTaskResultEvent); overload;
    // 取消TCP连接请求
    procedure CancelTcpRequest(Caller: TObject); overload;
    procedure CancelTcpRequest(OnTaskResult: TTcpTaskResultEvent); overload;
    // 取消结果事件
    procedure CancelResultEvent(Caller: TObject);

    property UdpSeqIdAlloc: TSeqAllocator read FUdpSeqIdAlloc;
    property UdpDupChecker: TUdpPacketDupChecker read FUdpDupChecker;
  end;

implementation

uses NhcNetManager, NhLoginPacket;

{ Misc Routines }

//-----------------------------------------------------------------------------
// 描述: 返回 Addr 是不是一个非法的地址
//-----------------------------------------------------------------------------
function IsInvalidAddr(const Addr: TPeerAddress): Boolean;
begin
  Result := (Addr.Ip = 0);
end;

{ TUdpTask }

constructor TUdpTask.Create;
begin
  inherited;
  FAckPacket := TBufferStream.Create;
end;

destructor TUdpTask.Destroy;
begin
  FReqPacket.Free;
  FAckPacket.Free;
  inherited;
end;

function TUdpTask.GetDone: Boolean;
begin
  Result := tsDone in FTaskStatus;
end;

function TUdpTask.GetSuccess: Boolean;
begin
  Result := tsSuccess in FTaskStatus;
end;

//-----------------------------------------------------------------------------
// 描述: 处理应答包
//-----------------------------------------------------------------------------
procedure TUdpTask.ProcessAckPacket(const PacketBuffer;
  PacketSize: Integer; const PeerAddr: TPeerAddress; var Handled: Boolean);
begin
  // nothing
end;

{ TUdpSendPacketTask }

//-----------------------------------------------------------------------------
// 描述: 初始化任务参数
//-----------------------------------------------------------------------------
procedure TUdpSendPacketTask.InitParams(Packet: TBizUdpPacket;
  const PeerAddr: TPeerAddress; SendTimes: Integer;
  OnTaskResult: TUdpTaskResultEvent);
begin
  FReqPacket := Packet;
  FPeerAddr := PeerAddr;
  FTaskParams.SendTimes := SendTimes;
  FOnTaskResult := OnTaskResult;
end;

//-----------------------------------------------------------------------------
// 描述: 执行发送任务
//-----------------------------------------------------------------------------
procedure TUdpSendPacketTask.Process;
begin
  if Done then Exit;

  // 检查地址的合法性
  if IsInvalidAddr(PeerAddr) then
  begin
    FTaskStatus := [tsDone];
    Exit;
  end;

  NetMgr.BizNetDriver.PerformSendUdpPacket(ReqPacket, PeerAddr, FTaskParams.SendTimes);

  FTaskStatus := [tsDone, tsSuccess];
end;

{ TUdpSendRecvPacketTask }

//-----------------------------------------------------------------------------
// 描述: 初始化任务参数
//-----------------------------------------------------------------------------
procedure TUdpSendRecvPacketTask.InitParams(Packet: TBizUdpPacket;
  const PeerAddr: TPeerAddress; SendTimes, RecvTimeout: Integer;
  OnTaskResult: TUdpTaskResultEvent);
begin
  FReqPacket := Packet;
  FPeerAddr := PeerAddr;
  FTaskParams.SendTimes := SendTimes;
  FTaskParams.RecvTimeout := RecvTimeout;
  FOnTaskResult := OnTaskResult;
end;

//-----------------------------------------------------------------------------
// 描述: 执行发送任务
//-----------------------------------------------------------------------------
procedure TUdpSendRecvPacketTask.Process;
var
  CurTicks: Cardinal;
begin
  if Done then Exit;
  CurTicks := GetTickCount;

  // 检查地址的合法性
  if IsInvalidAddr(PeerAddr) then
  begin
    FTaskStatus := [tsDone];
    Exit;
  end;

  // 如果还未收到应答包
  if FAckPacket.Size = 0 then
  begin
    if GetTickDiff(FTaskCtrl.LastSendTicks, CurTicks) >=
      Cardinal(FTaskParams.RecvTimeout) then
    begin
      if FTaskCtrl.SentTimes < FTaskParams.SendTimes then
      begin
        // 发送UDP数据包
        NetMgr.BizNetDriver.PerformSendUdpPacket(ReqPacket, PeerAddr);

        Inc(FTaskCtrl.SentTimes);
        FTaskCtrl.LastSendTicks := CurTicks;
      end else
      begin
        // 任务失败
        FTaskStatus := [tsDone];
      end;
    end;
  end else
  begin
    // 任务成功
    FTaskStatus := [tsDone, tsSuccess];
  end;
end;

//-----------------------------------------------------------------------------
// 描述: 处理应答包
//-----------------------------------------------------------------------------
procedure TUdpSendRecvPacketTask.ProcessAckPacket(const PacketBuffer;
  PacketSize: Integer; const PeerAddr: TPeerAddress; var Handled: Boolean);
var
  HeaderPtr: PBizUdpPacketHeader;
begin
  HeaderPtr := PBizUdpPacketHeader(@PacketBuffer);
  if HeaderPtr.SeqNumber = ReqPacket.Header.SeqNumber then
  begin
    Handled := True;
    if FAckPacket.Size = 0 then
      FAckPacket.Assign(PacketBuffer, PacketSize);
    FAckPeerAddr := PeerAddr;
  end;
end;

{ TUdpTaskList }

constructor TUdpTaskList.Create;
begin
  inherited;
  ThreadSafe := True;
  OwnsObjects := True;
end;

destructor TUdpTaskList.Destroy;
begin
  inherited;
end;

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

function TUdpTaskList.FindTask(PacketSeqNumber: Cardinal): TUdpTask;
var
  Task: TUdpTask;
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    Task := Items[I];
    if Assigned(Task) and
      (PBizUdpPacketHeader(Task.ReqPacket.Buffer).SeqNumber = PacketSeqNumber) then
    begin
      Result := Task;
      Break;
    end;
  end;
end;

function TUdpTaskList.FindTask(Caller: TObject): TUdpTask;
var
  Task: TUdpTask;
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    Task := Items[I];
    if Assigned(Task) and (Task.FCaller = Caller) then
    begin
      Result := Task;
      Break;
    end;
  end;
end;

function TUdpTaskList.FindTask(OnTaskResult: TUdpTaskResultEvent): TUdpTask;
var
  Task: TUdpTask;
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    Task := Items[I];
    if Assigned(Task) and (Addr(Task.FOnTaskResult) = Addr(OnTaskResult)) then
    begin
      Result := Task;
      Break;
    end;
  end;
end;

procedure TUdpTaskList.Add(Task: TUdpTask);
begin
  if Task <> nil then
    inherited Add(Task, False);
end;

procedure TUdpTaskList.Remove(Task: TUdpTask);
begin
  inherited Remove(Task);
end;

procedure TUdpTaskList.Delete(Index: Integer);
begin
  inherited Delete(Index);
end;

function TUdpTaskList.Extract(Index: Integer): TUdpTask;
begin
  Result := TUdpTask(inherited Extract(Index));
end;

procedure TUdpTaskList.Clear;
begin
  inherited Clear;
end;

procedure TUdpTaskList.RemoveTasks(PacketSeqNumber: Cardinal);
var
  Task: TUdpTask;
begin
  Lock;
  try
    while True do
    begin
      Task := FindTask(PacketSeqNumber);
      if Task <> nil then
        inherited Remove(Task)
      else
        Break;
    end;
  finally
    Unlock;
  end;
end;

procedure TUdpTaskList.RemoveTasks(Caller: TObject);
var
  Task: TUdpTask;
begin
  Lock;
  try
    while True do
    begin
      Task := FindTask(Caller);
      if Task <> nil then
        inherited Remove(Task)
      else
        Break;
    end;
  finally
    Unlock;
  end;
end;

procedure TUdpTaskList.RemoveTasks(OnTaskResult: TUdpTaskResultEvent);
var
  Task: TUdpTask;
begin
  Lock;
  try
    while True do
    begin
      Task := FindTask(OnTaskResult);
      if Task <> nil then
        inherited Remove(Task)
      else
        Break;
    end;
  finally
    Unlock;
  end;
end;

procedure TUdpTaskList.CancelResultEvent(Caller: TObject);
var
  Task: TUdpTask;
  I: Integer;
begin
  Lock;
  try
    for I := 0 to Count - 1 do
    begin
      Task := Items[I];
      if Assigned(Task) and (Task.FCaller = Caller) then
        Task.FOnTaskResult := nil;
    end;
  finally
    Unlock;
  end;
end;

{ TUdpTaskExecutor }

constructor TUdpTaskExecutor.Create;
begin
  inherited Create;
  FTaskList := TUdpTaskList.Create;
end;

destructor TUdpTaskExecutor.Destroy;
begin
  Clear;
  FTaskList.Free;
  inherited;
end;

//-----------------------------------------------------------------------------
// 描述: 添加一个等候发送的请求包到处理器中
//-----------------------------------------------------------------------------
procedure TUdpTaskExecutor.AddReqPacket(Packet: TBizUdpPacket;
  const PeerAddr: TPeerAddress; NeedAck: Boolean;
  OnTaskResult: TUdpTaskResultEvent; Caller: TObject; 
  SendTimes, RecvTimeout: Integer);
var
  Task: TUdpTask;
begin
  if NeedAck then
  begin
    Task := TUdpSendRecvPacketTask.Create;
    TUdpSendRecvPacketTask(Task).InitParams(Packet, PeerAddr, SendTimes,
      RecvTimeout, OnTaskResult);
  end else
  begin
    Task := TUdpSendPacketTask.Create;
    TUdpSendPacketTask(Task).InitParams(Packet, PeerAddr, SendTimes, OnTaskResult);
  end;

  Task.FCaller := Caller;
  FTaskList.Add(Task);
end;

//-----------------------------------------------------------------------------
// 描述: 收到应答包后，将其放入处理器中对应的位置
//-----------------------------------------------------------------------------
procedure TUdpTaskExecutor.ProcessAckPacket(const PacketBuffer;
  PacketSize: Integer; const PeerAddr: TPeerAddress);
var
  I: Integer;
  Handled: Boolean;
begin
  FTaskList.Lock;
  try
    Handled := False;
    for I := 0 to FTaskList.Count - 1 do
    begin
      FTaskList[I].ProcessAckPacket(PacketBuffer, PacketSize, PeerAddr, Handled);
      if Handled then Break;
    end;
  finally
    FTaskList.Unlock;