{*************************************************************************}
{ 單元說明: 常規業務通訊 NetDriver 實現 (UDP、TCP)                        }
{ ----------------------------------------------------------------------- }
{ 注意事項:                                                               }
{                                                                         }
{   1. TBizNetDriver 提供的所有函數調用都為非阻塞式，操作結果以事件形式   }
{      進行回調。                                                         }
{   2. 調用 TBizNetDriver.SendUdpPacket 系列函數時，調用者創建 Packet     }
{      對象并傳入后，無需釋放該對象，NetDriver 會負責釋放它。在事件回調   }
{      時，調用者可在事件參數 PacketTask 中找到該 Packet 對象。           }
{   4. 調用 TBizNetDriver.TransferTcpData 函數，并通過事件成功獲得        }
{      一個 TTcpConnection 對象后，此連接對象不再由 NetDriver 管理，      }
{      故調用者必須負責釋放此連接對象。                                   }
{   5. 調用 TBizNetDriver.SendUdpPacket / TransferTcpData 函數，          }
{      并傳入事件(OnTaskResult, OnTaskResult)后，在事件激活前，若需銷毀調 }
{      用者對象，則必須先調用TBizNetDriver.CancelXXXRequest(Caller) 函數。}
{                                                                         }
{*************************************************************************}

unit NhcBizNetDriver;

interface

uses
  Windows, SysUtils, Classes, NhContainers, NhSocketObj, NhWinSock2,
  NhcNetBase, NhBaseBizPacket, NhThreadPsr, NhClasses, NhcNetClasses,
  NhBasePacket, NhPubUtils;

const
  DefUdpSendTryTimes        = 3;          // 發送UDP包的默認重試次數
  DefUdpSendRecvTimeout     = 1000*3;     // 等待接收UDP包的默認時限(毫秒)

  MaxChkDupSeqsPerSender    = 100;        // 在檢測重復包時，每個用戶保存最近多少數據包記錄
  MaxUdpPacketCacheSize     = 10000;      // UDP數據包緩沖器的最大容量
  MaxTcpPacketCacheSize     = 10000;      // TCP數據包緩沖器的最大容量

  TcpConnectTimeout         = 1000*10;    // TCP正向連接超時時間(毫秒)
  TcpRecvPacketTimeout      = 1000*20;    // TCP接收數據包的超時時間(毫秒)

type

{ Classes }

  TUdpTask = class;
  TUdpSendPacketTask = class;
  TUdpSendRecvPacketTask = class;
  TUdpTaskList = class;
  TUdpTaskExecutor = class;
  TNetDriverFollowProcessor = class;
  TTcpTask = class;
  TTcpTaskList = class;
  TTcpTaskExecutor = class;
  TBizNetDriver = class;

{ Types }

  // 任務狀態
  TNetDriverTaskStatus = set of (
    tsDone,                             // 任務結束
    tsSuccess                           // 任務成功完成
    );

  // UDP發送結果事件
  TUdpTaskResultEvent = procedure(Task: TUdpTask) of object;
  // TCP連接結果事件
  TTcpTaskResultEvent = procedure(Task: TTcpTask) of object;

{ TUdpTask - UDP數據包發送任務基類 }

  TUdpTask = class(TObject)
  private
    FCaller: TObject;                   // 調用者對象
    FOnTaskResult: TUdpTaskResultEvent; // 發送結果事件
  protected
    FReqPacket: TBizUdpPacket;          // 請求包(已Pack，由調用者創建，NetDriver 負責釋放)
    FAckPacket: TBufferStream;          // 應答包
    FAckPeerAddr: TPeerAddress;         // 應答包的來自地址
    FPeerAddr: TPeerAddress;            // 目的地址
    FTaskStatus: TNetDriverTaskStatus;  // 任務狀態
  protected
    function GetDone: Boolean;
    function GetSuccess: Boolean;

    property Done: Boolean read GetDone;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    // 執行發送任務
    procedure Process; virtual; abstract;
    // 處理應答包
    procedure ProcessAckPacket(const PacketBuffer; PacketSize: Integer;
      const PeerAddr: TPeerAddress; var Handled: Boolean); virtual;

    property ReqPacket: TBizUdpPacket read FReqPacket;
    property AckPacket: TBufferStream read FAckPacket;
    property AckPeerAddr: TPeerAddress read FAckPeerAddr;
    property PeerAddr: TPeerAddress read FPeerAddr;
    property Success: Boolean read GetSuccess;
  end;

{ TUdpSendPacketTask - UDP數據包發送任務 (僅發送) }

  TUdpSendPacketTask = class(TUdpTask)
  private type
    TUdpSendPacketTaskParams = record
      SendTimes: Integer;             // 總共需發送幾次
    end;
  private
    FTaskParams: TUdpSendPacketTaskParams;
  public
    procedure InitParams(Packet: TBizUdpPacket; const PeerAddr: TPeerAddress;
      SendTimes: Integer; OnTaskResult: TUdpTaskResultEvent);

    procedure Process; override;
  end;

{ TUdpSendRecvPacketTask - UDP數據包發送任務 (發送并接收) }

  TUdpSendRecvPacketTask = class(TUdpTask)
  private type
    TUdpSendRecvPacketTaskParams = record
      SendTimes: Integer;             // 最多發送幾次
      RecvTimeout: Integer;           // 每次等待應答的最長時間(毫秒)
      ForwardTimes: Integer;          // 需轉發的次數
    end;

    TUdpSendRecvPacketTaskCtrl = record
      SentTimes: Integer;             // 已發送次數
      LastSendTicks: Cardinal;        // 上次發送時間
    end;
  private
    FTaskParams: TUdpSendRecvPacketTaskParams;
    FTaskCtrl: TUdpSendRecvPacketTaskCtrl;
  public
    procedure InitParams(Packet: TBizUdpPacket; const PeerAddr: TPeerAddress;
      SendTimes, RecvTimeout: Integer; OnTaskResult: TUdpTaskResultEvent);

    procedure Process; override;
    procedure ProcessAckPacket(const PacketBuffer; PacketSize: Integer;
      const PeerAddr: TPeerAddress; var Handled: Boolean); override;
  end;

{ TUdpTaskList - UDP發送任務列表 }

  TUdpTaskList = class(TCustomObjectList)
  private
    function GetItems(Index: Integer): TUdpTask;

    function FindTask(PacketSeqNumber: Cardinal): TUdpTask; overload;
    function FindTask(Caller: TObject): TUdpTask; overload;
    function FindTask(OnTaskResult: TUdpTaskResultEvent): TUdpTask; overload;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add(Task: TUdpTask);
    procedure Remove(Task: TUdpTask);
    procedure Delete(Index: Integer);
    function Extract(Index: Integer): TUdpTask;
    procedure Clear;

    procedure RemoveTasks(PacketSeqNumber: Cardinal); overload;
    procedure RemoveTasks(Caller: TObject); overload;
    procedure RemoveTasks(OnTaskResult: TUdpTaskResultEvent); overload;
    procedure CancelResultEvent(Caller: TObject);

    property Items[Index: Integer]: TUdpTask read GetItems; default;
  end;

{ TUdpTaskExecutor - UDP數據包發送執行器 }
{
  職責:
  1. 處理UDP數據包發送任務，對不同類型的任務采取不同的發送策略。
  2. 將執行完的任務轉移到 TBizNetDriver.FUdpDoneTaskList 中，以便進行事件處理。
}

  TUdpTaskExecutor = class(TObject)
  private
    FTaskList: TUdpTaskList;      // 正在發送中的任務列表
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddReqPacket(Packet: TBizUdpPacket;
      const PeerAddr: TPeerAddress; NeedAck: Boolean;
      OnTaskResult: TUdpTaskResultEvent; Caller: TObject;
      SendTimes, RecvTimeout: Integer);
    procedure ProcessAckPacket(const PacketBuffer; PacketSize: Integer;
      const PeerAddr: TPeerAddress);
    procedure RemoveReqPacket(PacketSeqNumber: Cardinal); overload;
    procedure RemoveReqPacket(Caller: TObject); overload;
    procedure RemoveReqPacket(OnTaskResult: TUdpTaskResultEvent); overload;
    procedure CancelResultEvent(Caller: TObject);
    procedure Clear;

    procedure Execute;
  end;

{ TUdpPacketDupChecker - 重復包檢測器 }

  TUdpPacketDupChecker = class(TSyncObject)
  private
    FActionCodes: TList;                // 需要過濾的數據包的ActionCode
    FSenders: TIntMap;                  // 用戶列表(Key:用戶號碼, Value:TList)

    function IsRegActionCode(ActionCode: Integer): Boolean;
  protected
    function BeforeCheck(const PacketHeader; var SenderID, SeqNumber,
      ActionCode: Integer): Boolean; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    procedure RegisterActionCode(ActionCode: Integer);
    procedure UnregisterActionCode(ActionCode: Integer);

    function Check(const PacketHeader): Boolean;
    procedure ClearUser(SenderID: Integer);
    procedure Clear;
  end;

{ TTcpTask }

  // TCP連接任務狀態
  TTcpTaskState = (
    ttsConnect,                // 發起連接
    ttsWaitConnect,            // 等待連接成功
    ttsSendReqPacket,          // 發送請求包
    ttsWaitAckPacket           // 等待應答包
    );

  TTcpTask = class(TObject)
  private
    FExecutor: TTcpTaskExecutor;          // 所屬 TcpTaskExecutor
    FCaller: TObject;                     // 調用者對象
    FOnTaskResult: TTcpTaskResultEvent;   // 結果事件
    FPeerAddr: TPeerAddress;              // 目的地址
    FConnection: TTcpConnection;          // TCP 連接 (由 NetDriver 創建，Caller 負責釋放)
    FReqPacket: TBizTcpPacket;            // 請求包(已Pack，由調用者創建，NetDriver 負責釋放)
    FAckPacket: TBufferStream;            // 應答包
    FNeedAck: Boolean;                    // 是否需要接收應答包
    FNeedConnect: Boolean;                // 是否需要發起連接
    FTaskStatus: TNetDriverTaskStatus;    // 任務狀態
    FSocketError: Boolean;                // 套接字是否發生了錯誤
    FState: TTcpTaskState;
    FLastStateTicks: Cardinal;
    FReqPacketSentSize: Integer;
  private
    function GetDone: Boolean;
    function GetSuccess: Boolean;
    procedure CancelResultEvent;
    procedure SetState(Value: TTcpTaskState);
    procedure SetNeedSleep(Value: Boolean);

    procedure DoStateConnect;
    procedure DoStateWaitConnect;
    procedure DoStateSendReqPacket;
    procedure DoStateWaitAckPacket;

    property Done: Boolean read GetDone;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure InitParams(Executor: TTcpTaskExecutor;
      const PeerAddr: TPeerAddress; Connection: TTcpConnection;
      ReqPacket: TBizTcpPacket; NeedAck: Boolean; Caller: TObject;
      OnTaskResult: TTcpTaskResultEvent);

    // 執行連接和發送任務
    procedure Process; virtual;
    // 處理應答包
    procedure ProcessAckPacket(const PacketBuffer; PacketSize: Integer;
      var Handled: Boolean); virtual;

    property ReqPacket: TBizTcpPacket read FReqPacket;
    property AckPacket: TBufferStream read FAckPacket;
    property PeerAddr: TPeerAddress read FPeerAddr;
    property Connection: TTcpConnection read FConnection;
    property Success: Boolean read GetSuccess;
    property SocketError: Boolean read FSocketError;
  end;

{ TTcpTaskList - TCP連接任務列表 }

  TTcpTaskList = class(TCustomObjectList)
  private
    function GetItems(Index: Integer): TTcpTask;

    function FindTask(Caller: TObject): TTcpTask; overload;
    function FindTask(OnTaskResult: TTcpTaskResultEvent): TTcpTask; overload;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add(Task: TTcpTask);
    procedure Remove(Task: TTcpTask);
    procedure Delete(Index: Integer);
    function Extract(Index: Integer): TTcpTask;
    procedure Clear;

    procedure SetSocketError(Connection: TTcpConnection; SocketError: Boolean);
    procedure RemoveTasks(Caller: TObject); overload;
    procedure RemoveTasks(OnTaskResult: TTcpTaskResultEvent); overload;
    procedure CancelResultEvent(Caller: TObject);

    property Items[Index: Integer]: TTcpTask read GetItems; default;
  end;

{ TTcpTaskExecutor }

  TTcpTaskExecutor = class(TObject)
  private
    FTaskList: TTcpTaskList;     // 正在工作中的任務列表
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddRequest(const PeerAddr: TPeerAddress;
      Connection: TTcpConnection; ReqPacket: TBizTcpPacket; NeedAck: Boolean;
      Caller: TObject; OnTaskResult: TTcpTaskResultEvent);
    procedure ProcessAckPacket(const PacketBuffer; PacketSize: Integer);
    procedure AddTask(Task: TTcpTask);
    procedure RemoveRequest(Caller: TObject); overload;
    procedure RemoveRequest(OnTaskResult: TTcpTaskResultEvent); overload;
    procedure CancelResultEvent(Caller: TObject);
    procedure SetSocketError(Connection: TTcpConnection; SocketError: Boolean);
    procedure Clear;

    procedure Execute;
  end;

{ TTcpPacketReceiver - TCP數據包接收器 }

  TTcpPacketReceiver = class(TObject)
  private
    FConnection: TTcpConnection;          // TCP連接
    FBuffer: TBufferStream;               // 接收緩存
    FMaxRecvPktCount: Integer;            // 最多接收數據包個數
    FCurRecvPktCount: Integer;            // 當前已接收數據包個數
    FDone: Boolean;                       // 任務是否已完成
  private
    procedure RecvPacket;
  public
    constructor Create(Connection: TTcpConnection; MaxRecvPktCount: Integer);
    destructor Destroy; override;
    procedure Process;
    property Done: Boolean read FDone;
  end;

{ TTcpPacketRecverList - TCP數據包接收器列表 }

  TTcpPacketRecverList = class(TSyncObject)
  private
    FRecverList: TObjectList;      // TTcpPacketReceiver[]
  private
    function FindConnection(Connection: TTcpConnection): Integer;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddConnection(Connection: TTcpConnection; MaxRecvPktCount: Integer);
    procedure RemoveConnection(Connection: TTcpConnection);

    procedure Process;
  end;

{ TNetDriverExecuteProcessor - NetDriver 執行處理器 }

  TNetDriverExecuteProcessor = class(TBcThreadProcessor)
  protected
    procedure Process; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TNetDriverFollowProcessor - NetDriver 后繼處理器 }
{
  職責:
  1. 將 NetIO 分派過來的UDP包，以 sync 方式繼續分派。
  2. 以 sync 方式調用UDP的 "發送結果事件" 和TCP的 "連接結果事件"。
}

  TNetDriverFollowProcessor = class(TBcThreadProcessor)
  private
    procedure ProcessUdpPacketCache;
    procedure ProcessUdpDoneTaskList;
    procedure ProcessTcpPacketCache;
    procedure ProcessTcpDoneTaskList;
  protected
    procedure Process; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TBizNetDriver }

  TBizNetDriver = class(TNetDriver)
  private
    FUdpTaskExecutor: TUdpTaskExecutor;             // UDP數據包發送執行器
    FUdpSeqIdAlloc: TSeqAllocator;                  // UDP數據包順序號分配器
    FUdpPacketCache: TUdpPacketCache;               // UDP數據包緩沖器(用于緩存收到的UDP包)
    FUdpDoneTaskList: TUdpTaskList;                 // 已結束的UDP發送任務的列表
    FUdpDupChecker: TUdpPacketDupChecker;           // UDP重復包檢測器

    FTcpTaskExecutor: TTcpTaskExecutor;             // TCP連接執行器
    FTcpDoneTaskList: TTcpTaskList;                 // 已結束的TCP連接任務
    FTcpPacketRecverList: TTcpPacketRecverList;     // TCP數據包接收器
    FTcpPacketCache: TTcpPacketCache;               // TCP數據包緩沖器(用于緩存收到的TCP包)

    FExecuteProcessor: TNetDriverExecuteProcessor;  // NetDriver 執行處理器
    FFollowProcessor: TNetDriverFollowProcessor;    // NetDriver 后繼處理器
  private
    procedure InitDupPktChkActionCodes;

    procedure PerformSendUdpPacket(Packet: TPacket;
      const PeerAddr: TPeerAddress; SendTimes: Integer = 1);
    procedure DoProcessUdpAckPacket(const PacketBuffer; PacketSize: Integer;
      const PeerAddr: TPeerAddress);
    procedure DoProcessTcpAckPacket(Connection: TTcpConnection;
      const PacketBuffer; PacketSize: Integer);
  protected
    function FilterUdpPacket(const PacketBuffer; PacketSize: Integer): Boolean; override;
    procedure DispatchUdpPacket(const PacketBuffer; PacketSize: Integer;
      const PeerAddr: TPeerAddress); override;
    procedure DispatchTcpPacket(Connection: TTcpConnection; const PacketBuffer;
      PacketSize: Integer); override;
  public
    procedure Initialize; override;
    procedure Finalize; override;
    procedure DoBeforeLogin; override;
    procedure DoBeforeLogout; override;
    procedure DoAfterLogin; override;
    procedure DoAfterLogout; override;
    procedure CollectGarbage; override;
  public