📄 nhcbiznetdriver.pas
字号:
{*************************************************************************}
{ 单元说明: 常规业务通讯 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -