-
消息边界：明确的帧结构解决TCP流式传输的问题
-
类型安全：明确的操作码和内容类型
-
扩展性：支持加密、压缩、分片等高级功能
-
可靠性：序列ID、确认机制、重试机制
-
兼容性：版本控制和魔术字验证
-
高性能：二进制编码，高效解析
这种设计可以让TCP通信像WebSocket一样有序、可靠，同时保持TCP的高性能优势。
unit TcpFrameProtocol;
interface
uses
SysUtils, Classes, SyncObjs, mormot.core.base, mormot.core.data,
mormot.core.json, mormot.core.text, mormot.net.sock;
type
/// TCP帧操作码（针对酒店系统优化）
TTcpFrameOpCode = (
tfoUnknown, // 未知
tfoText, // 文本数据
tfoBinary, // 二进制数据
tfoJson, // JSON数据
tfoCommand, // 命令/请求
tfoResponse, // 响应
tfoHeartbeat, // 心跳
tfoError, // 错误
tfoAck, // 确认
tfoClose, // 关闭连接
tfoPing, // Ping
tfoPong, // Pong
// 酒店系统专用操作码
tfoDoorLockControl, // 门锁控制
tfoRoomStatus, // 房间状态
tfoGuestCheckIn, // 客人入住
tfoGuestCheckOut, // 客人退房
tfoKeyCardIssue, // 发卡
tfoKeyCardCancel, // 取消卡
tfoWebhookNotify, // Webhook通知
tfoIFCForward, // 转发到IFC
tfoIFCResponse // IFC响应
);
/// TCP帧负载类型
TTcpFrameContent = (
tfcRaw, // 原始数据
tfcString, // 字符串
tfcStream, // 流数据
tfcEncrypted, // 加密数据
tfcCompressed // 压缩数据
);
/// TCP帧头标志位
TTcpFrameFlags = set of (
tffEncrypted, // 加密
tffCompressed, // 压缩
tffFragmented, // 分片
tffLastFragment, // 最后分片
tffNeedAck, // 需要确认
tffPriorityHigh, // 高优先级
tffPriorityLow, // 低优先级
tffUrgent, // 紧急消息
tffSystem // 系统消息
);
/// TCP帧头
TTcpFrameHeader = packed record
Magic: Cardinal; // 魔术字，用于验证
Version: Byte; // 版本号
OpCode: Byte; // 操作码（TTcpFrameOpCode）
Content: Byte; // 内容类型（TTcpFrameContent）
Flags: Word; // 标志位
SequenceId: Cardinal; // 序列ID（用于确认）
PayloadLength: Int64; // 负载长度
Checksum: Word; // 头部校验和
Timestamp: Int64; // 时间戳（Unix时间戳，毫秒）
SessionId: Cardinal; // 会话ID
SourceId: array[0..15] of AnsiChar; // 源标识（16字节）
DestinationId: array[0..15] of AnsiChar; // 目标标识（16字节）
end;
/// TCP帧
TTcpFrame = record
Header: TTcpFrameHeader;
Payload: RawByteString;
/// 获取操作码
function OpCode: TTcpFrameOpCode;
/// 获取内容类型
function Content: TTcpFrameContent;
/// 获取标志位
function Flags: TTcpFrameFlags;
/// 获取时间戳
function DateTime: TDateTime;
/// 获取源标识
function Source: RawUtf8;
/// 获取目标标识
function Destination: RawUtf8;
/// 设置源标识
procedure SetSource(const AId: RawUtf8);
/// 设置目标标识
procedure SetDestination(const AId: RawUtf8);
end;
/// TCP帧编码/解码器
TTcpFrameCodec = class
private
const
FRAME_MAGIC = $AA55AA55; // 帧魔术字
FRAME_VERSION = 1; // 当前版本
HEADER_SIZE = SizeOf(TTcpFrameHeader);
class function CalculateChecksum(const Header: TTcpFrameHeader): Word;
public
/// 编码帧为字节流
class function Encode(const Frame: TTcpFrame): RawByteString;
/// 解码字节流为帧
class function Decode(const Data: RawByteString; out Frame: TTcpFrame): Boolean; overload;
class function Decode(Stream: TStream; out Frame: TTcpFrame): Boolean; overload;
/// 创建各种类型的帧
class function CreateFrame(AOpCode: TTcpFrameOpCode;
const APayload: RawByteString = ''): TTcpFrame;
class function CreateJsonFrame(const Json: RawUtf8;
AOpCode: TTcpFrameOpCode = tfoJson): TTcpFrame;
class function CreateCommandFrame(const Command: RawUtf8;
const Params: RawUtf8 = ''): TTcpFrame;
class function CreateResponseFrame(RequestId: Cardinal;
Success: Boolean; const Data: RawUtf8 = ''): TTcpFrame;
class function CreateErrorFrame(ErrorCode: Integer;
const ErrorMsg: RawUtf8): TTcpFrame;
class function CreateHeartbeatFrame: TTcpFrame;
/// 酒店系统专用帧创建
class function CreateDoorLockFrame(const HotelId, RoomNo, Command: RawUtf8;
const Data: RawUtf8 = ''): TTcpFrame;
class function CreateWebhookFrame(const Event, JsonData: RawUtf8): TTcpFrame;
class function CreateIFCForwardFrame(const HotelId, Command, Data: RawUtf8): TTcpFrame;
end;
/// TCP帧处理器接口
ITcpFrameHandler = interface
['{E4B5F8A2-3C7D-4A1B-9D8E-7F6C5D4E3A2B}']
procedure HandleFrame(const Frame: TTcpFrame);
end;
/// TCP帧路由器（根据操作码路由到不同处理器）
TTcpFrameRouter = class
private
FHandlers: array[TTcpFrameOpCode] of TList;
FLock: TRTLCriticalSection;
public
constructor Create;
destructor Destroy; override;
/// 注册处理器
procedure RegisterHandler(AOpCode: TTcpFrameOpCode; Handler: ITcpFrameHandler);
/// 注销处理器
procedure UnregisterHandler(AOpCode: TTcpFrameOpCode; Handler: ITcpFrameHandler);
/// 路由帧
procedure RouteFrame(const Frame: TTcpFrame);
/// 清空所有处理器
procedure Clear;
end;
/// TCP帧发送队列（带重试和确认机制）
TTcpFrameSender = class
private
type
TPendingFrame = record
Frame: TTcpFrame;
SendTime: Int64;
RetryCount: Integer;
Callback: TProc<TTcpFrame>;
end;
private
FSocket: TTcpSocket;
FSendQueue: TThreadList<TPendingFrame>;
FPendingAcks: TSynDictionary; // SequenceId -> TPendingFrame
FSequenceCounter: Cardinal;
FWorkerThread: TThread;
FActive: Boolean;
FAckTimeout: Integer;
FMaxRetries: Integer;
procedure WorkerThreadExecute;
procedure SendFrameInternal(const Frame: TTcpFrame);
procedure HandleAckFrame(const Frame: TTcpFrame);
public
constructor Create(ASocket: TTcpSocket);
destructor Destroy; override;
/// 发送帧（异步）
procedure SendFrame(const Frame: TTcpFrame;
Callback: TProc<TTcpFrame> = nil);
/// 发送帧并等待响应（同步）
function SendFrameSync(const Frame: TTcpFrame;
Timeout: Integer = 5000): TTcpFrame;
/// 启动发送器
procedure Start;
/// 停止发送器
procedure Stop;
/// 处理接收到的帧（用于确认）
procedure ProcessReceivedFrame(const Frame: TTcpFrame);
property AckTimeout: Integer read FAckTimeout write FAckTimeout;
property MaxRetries: Integer read FMaxRetries write FMaxRetries;
end;
/// TCP帧接收器
TTcpFrameReceiver = class
private
FSocket: TTcpSocket;
FBuffer: RawByteString;
FBufferPos: Integer;
FWorkerThread: TThread;
FActive: Boolean;
FOnFrameReceived: TProc<TTcpFrame>;
FOnError: TProc<string>;
procedure WorkerThreadExecute;
function ReadFromSocket: Boolean;
function ExtractFrame: TTcpFrame;
public
constructor Create(ASocket: TTcpSocket);
destructor Destroy; override;
/// 启动接收器
procedure Start;
/// 停止接收器
procedure Stop;
/// 处理缓冲区数据
procedure ProcessBuffer;
/// 事件
property OnFrameReceived: TProc<TTcpFrame> read FOnFrameReceived write FOnFrameReceived;
property OnError: TProc<string> read FOnError write FOnError;
end;
/// TCP帧会话（组合发送器和接收器）
TTcpFrameSession = class
private
FSocket: TTcpSocket;
FSender: TTcpFrameSender;
FReceiver: TTcpFrameReceiver;
FRouter: TTcpFrameRouter;
FSessionId: Cardinal;
FSourceId: RawUtf8;
FDestinationId: RawUtf8;
procedure HandleFrameReceived(const Frame: TTcpFrame);
public
constructor Create(ASocket: TTcpSocket);
destructor Destroy; override;
/// 连接到服务器
function Connect(const Host: RawUtf8; Port: Integer): Boolean;
/// 断开连接
procedure Disconnect;
/// 发送帧
procedure SendFrame(const Frame: TTcpFrame; Callback: TProc<TTcpFrame> = nil);
/// 发送帧并等待响应
function SendFrameSync(const Frame: TTcpFrame; Timeout: Integer = 5000): TTcpFrame;
/// 发送JSON数据
procedure SendJson(const Json: RawUtf8; AOpCode: TTcpFrameOpCode = tfoJson);
/// 发送命令
function SendCommand(const Command: RawUtf8; const Params: RawUtf8 = '';
Timeout: Integer = 5000): TTcpFrame;
/// 发送心跳
procedure SendHeartbeat;
/// 注册帧处理器
procedure RegisterHandler(AOpCode: TTcpFrameOpCode; Handler: ITcpFrameHandler);
/// 开始会话
procedure Start;
/// 停止会话
procedure Stop;
property SessionId: Cardinal read FSessionId;
property SourceId: RawUtf8 read FSourceId write FSourceId;
property DestinationId: RawUtf8 read FDestinationId write FDestinationId;
end;
implementation
{ TTcpFrame }
function TTcpFrame.OpCode: TTcpFrameOpCode;
begin
Result := TTcpFrameOpCode(Header.OpCode);
end;
function TTcpFrame.Content: TTcpFrameContent;
begin
Result := TTcpFrameContent(Header.Content);
end;
function TTcpFrame.Flags: TTcpFrameFlags;
begin
Result := TTcpFrameFlags(Header.Flags);
end;
function TTcpFrame.DateTime: TDateTime;
begin
Result := UnixMSTimeToDateTime(Header.Timestamp);
end;
function TTcpFrame.Source: RawUtf8;
begin
Result := RawUtf8(Header.SourceId);
Result := Trim(Result);
end;
function TTcpFrame.Destination: RawUtf8;
begin
Result := RawUtf8(Header.DestinationId);
Result := Trim(Result);
end;
procedure TTcpFrame.SetSource(const AId: RawUtf8);
begin
FillChar(Header.SourceId, SizeOf(Header.SourceId), 0);
if AId <> '' then
Move(PAnsiChar(AId)^, Header.SourceId[0], Min(Length(AId), SizeOf(Header.SourceId)));
end;
procedure TTcpFrame.SetDestination(const AId: RawUtf8);
begin
FillChar(Header.DestinationId, SizeOf(Header.DestinationId), 0);
if AId <> '' then
Move(PAnsiChar(AId)^, Header.DestinationId[0], Min(Length(AId), SizeOf(Header.DestinationId)));
end;
{ TTcpFrameCodec }
class function TTcpFrameCodec.Encode(const Frame: TTcpFrame): RawByteString;
var
header: TTcpFrameHeader;
begin
header := Frame.Header;
// 填充固定字段
header.Magic := FRAME_MAGIC;
header.Version := FRAME_VERSION;
header.PayloadLength := Length(Frame.Payload);
// 设置时间戳
header.Timestamp := DateTimeToUnixMSTime(Now);
// 计算校验和
header.Checksum := 0;
header.Checksum := CalculateChecksum(header);
// 编码帧
SetLength(Result, HEADER_SIZE + header.PayloadLength);
// 复制帧头
Move(header, Result[1], HEADER_SIZE);
// 复制负载
if header.PayloadLength > 0 then
Move(Pointer(Frame.Payload)^, Result[HEADER_SIZE + 1], header.PayloadLength);
end;
class function TTcpFrameCodec.Decode(const Data: RawByteString;
out Frame: TTcpFrame): Boolean;
var
dataLen: Integer;
begin
dataLen := Length(Data);
// 检查数据长度是否足够
if dataLen < HEADER_SIZE then
begin
Result := False;
Exit;
end;
// 读取帧头
Move(Data[1], Frame.Header, HEADER_SIZE);
// 验证魔术字
if Frame.Header.Magic <> FRAME_MAGIC then
begin
Result := False;
Exit;
end;
// 验证版本
if Frame.Header.Version > FRAME_VERSION then
begin
Result := False;
Exit;
end;
// 验证校验和
if Frame.Header.Checksum <> CalculateChecksum(Frame.Header) then
begin
Result := False;
Exit;
end;
// 验证负载长度
if dataLen < HEADER_SIZE + Frame.Header.PayloadLength then
begin
Result := False;
Exit;
end;
// 提取负载
if Frame.Header.PayloadLength > 0 then
begin
SetLength(Frame.Payload, Frame.Header.PayloadLength);
Move(Data[HEADER_SIZE + 1], Frame.Payload[1], Frame.Header.PayloadLength);
end
else
Frame.Payload := '';
Result := True;
end;
class function TTcpFrameCodec.Decode(Stream: TStream; out Frame: TTcpFrame): Boolean;
var
header: TTcpFrameHeader;
bytesRead: Integer;
begin
Result := False;
// 读取帧头
bytesRead := Stream.Read(header, HEADER_SIZE);
if bytesRead <> HEADER_SIZE then
Exit;
// 验证魔术字
if header.Magic <> FRAME_MAGIC then
Exit;
// 验证版本
if header.Version > FRAME_VERSION then
Exit;
// 验证校验和
if header.Checksum <> CalculateChecksum(header) then
Exit;
// 读取负载
if header.PayloadLength > 0 then
begin
SetLength(Frame.Payload, header.PayloadLength);
bytesRead := Stream.Read(Frame.Payload[1], header.PayloadLength);
if bytesRead <> header.PayloadLength then
Exit;
end;
Frame.Header := header;
Result := True;
end;
class function TTcpFrameCodec.CreateFrame(AOpCode: TTcpFrameOpCode;
const APayload: RawByteString): TTcpFrame;
begin
FillChar(Result, SizeOf(Result), 0);
Result.Header.OpCode := Byte(AOpCode);
Result.Header.Content := Byte(tfcRaw);
Result.Header.PayloadLength := Length(APayload);
Result.Payload := APayload;
// 根据操作码设置标志位
case AOpCode of
tfoCommand, tfoDoorLockControl, tfoIFCForward:
Result.Header.Flags := Word([tffNeedAck, tffPriorityHigh]);
tfoHeartbeat, tfoPing, tfoPong:
Result.Header.Flags := Word([tffSystem]);
tfoError:
Result.Header.Flags := Word([tffUrgent]);
end;
end;
class function TTcpFrameCodec.CreateJsonFrame(const Json: RawUtf8;
AOpCode: TTcpFrameOpCode): TTcpFrame;
begin
Result := CreateFrame(AOpCode, Json);
Result.Header.Content := Byte(tfcString);
end;
class function TTcpFrameCodec.CreateCommandFrame(const Command: RawUtf8;
const Params: RawUtf8): TTcpFrame;
var
doc: TDocVariantData;
begin
doc.InitObject([
'command', Command,
'params', Params,
'timestamp', DateTimeToIso8601(Now, True)
]);
Result := CreateJsonFrame(doc.ToJson, tfoCommand);
end;
class function TTcpFrameCodec.CreateResponseFrame(RequestId: Cardinal;
Success: Boolean; const Data: RawUtf8): TTcpFrame;
var
doc: TDocVariantData;
begin
doc.InitObject([
'requestId', RequestId,
'success', Success,
'timestamp', DateTimeToIso8601(Now, True)
]);
if Data <> '' then
doc.AddValue('data', Data);
Result := CreateJsonFrame(doc.ToJson, tfoResponse);
end;
class function TTcpFrameCodec.CreateErrorFrame(ErrorCode: Integer;
const ErrorMsg: RawUtf8): TTcpFrame;
var
doc: TDocVariantData;
begin
doc.InitObject([
'errorCode', ErrorCode,
'errorMsg', ErrorMsg,
'timestamp', DateTimeToIso8601(Now, True)
]);
Result := CreateJsonFrame(doc.ToJson, tfoError);
end;
class function TTcpFrameCodec.CreateHeartbeatFrame: TTcpFrame;
begin
Result := CreateFrame(tfoHeartbeat, '');
end;
class function TTcpFrameCodec.CreateDoorLockFrame(const HotelId, RoomNo,
Command: RawUtf8; const Data: RawUtf8): TTcpFrame;
var
doc: TDocVariantData;
begin
doc.InitObject([
'hotelId', HotelId,
'roomNo', RoomNo,
'command', Command,
'timestamp', DateTimeToIso8601(Now, True)
]);
if Data <> '' then
doc.AddValue('data', Data);
Result := CreateJsonFrame(doc.ToJson, tfoDoorLockControl);
end;
class function TTcpFrameCodec.CreateWebhookFrame(const Event, JsonData: RawUtf8): TTcpFrame;
var
doc: TDocVariantData;
begin
doc.InitObject([
'event', Event,
'data', _JsonFast(JsonData),
'timestamp', DateTimeToIso8601(Now, True)
]);
Result := CreateJsonFrame(doc.ToJson, tfoWebhookNotify);
end;
class function TTcpFrameCodec.CreateIFCForwardFrame(const HotelId, Command,
Data: RawUtf8): TTcpFrame;
var
doc: TDocVariantData;
begin
doc.InitObject([
'hotelId', HotelId,
'command', Command,
'data', Data,
'timestamp', DateTimeToIso8601(Now, True)
]);
Result := CreateJsonFrame(doc.ToJson, tfoIFCForward);
end;
class function TTcpFrameCodec.CalculateChecksum(const Header: TTcpFrameHeader): Word;
var
i: Integer;
p: PByte;
sum: Cardinal;
begin
sum := 0;
p := @Header;
// 计算所有字节的和（跳过校验和字段）
for i := 0 to SizeOf(Header) - SizeOf(Header.Checksum) - 1 do
begin
sum := sum + p^;
Inc(p);
end;
// 取16位校验和
Result := Word(sum and $FFFF);
end;
{ TTcpFrameRouter }
constructor TTcpFrameRouter.Create;
var
opCode: TTcpFrameOpCode;
begin
InitializeCriticalSection(FLock);
for opCode := Low(TTcpFrameOpCode) to High(TTcpFrameOpCode) do
FHandlers[opCode] := TList.Create;
end;
destructor TTcpFrameRouter.Destroy;
var
opCode: TTcpFrameOpCode;
begin
for opCode := Low(TTcpFrameOpCode) to High(TTcpFrameOpCode) do
FHandlers[opCode].Free;
DeleteCriticalSection(FLock);
inherited;
end;
procedure TTcpFrameRouter.RegisterHandler(AOpCode: TTcpFrameOpCode;
Handler: ITcpFrameHandler);
begin
EnterCriticalSection(FLock);
try
if FHandlers[AOpCode].IndexOf(Pointer(Handler)) < 0 then
FHandlers[AOpCode].Add(Pointer(Handler));
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TTcpFrameRouter.UnregisterHandler(AOpCode: TTcpFrameOpCode;
Handler: ITcpFrameHandler);
begin
EnterCriticalSection(FLock);
try
FHandlers[AOpCode].Remove(Pointer(Handler));
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TTcpFrameRouter.RouteFrame(const Frame: TTcpFrame);
var
handlers: TList;
i: Integer;
handler: ITcpFrameHandler;
begin
EnterCriticalSection(FLock);
try
handlers := FHandlers[Frame.OpCode];
for i := 0 to handlers.Count - 1 do
begin
handler := ITcpFrameHandler(handlers[i]);
try
handler.HandleFrame(Frame);
except
on E: Exception do
// 记录错误但不中断
;
end;
end;
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TTcpFrameRouter.Clear;
var
opCode: TTcpFrameOpCode;
begin
EnterCriticalSection(FLock);
try
for opCode := Low(TTcpFrameOpCode) to High(TTcpFrameOpCode) do
FHandlers[opCode].Clear;
finally
LeaveCriticalSection(FLock);
end;
end;
// 由于篇幅限制，TTcpFrameSender、TTcpFrameReceiver、TTcpFrameSession的实现略
// 但框架已经搭建好，可以根据需要继续实现
end.