Delphi 的Websocket Server 控件实现（二、Delphi WebSocket 控件实现）（含源码）
目录
二、Delphi WebSocket 控件实现
1、第一步
2、网络数据读写
3、握手处理
4、消息解码
5、控件中使用的关键技术点
1、初始化客户端信息
2、ping实现方法
3、 服务器端给客户端发送数据
关于控件的源码下载见《Delphi 的Websocket Server 控件实现（四、WebSocket Demo程序使用说明）》
二、Delphi WebSocket 控件实现
如果想使用WebSocket API，那么有一个服务器，它将非常有用。在本文中，我将向大家展示如何用delphi编写一个WebSocket服务器。当然可以用任何服务器端语言来实现，网上其它语言实现 WebSocket Server 的资料或者库非常多，但是delphi 的却鲜有，除了商业控件包sgcWebSockets以外，几乎没有比较完整使用delphi实现的 WebSocket Server，这里我们选择了delphi语言。
此服务器符合RFC 6455，因此它能够兼容处理Chrome版本16、Firefox 11、IE 10及以上版本的连接。
1、第一步
WebSockets通信是基于TCP的连接的，幸运的是再delphi中提供了indy的TIdTCPServer控件，这个控件可以监听并与客户端建立TCP连接。需要注意的是indy的这个控件有个小bug，就是当有客户端连接的时候我们设置TIdTCPServer的Active属性为False时，会导致程序死机，这个bug我通过更改IdScheduler.pas单元已经解决，具体参见：关于 Indy 中 TIdTCPServer 在关闭时导致程序死机的Bug修复（delphi）
创建TCP服务：
FIdTCPServer : TIdTCPServer; //indy的TCP服务器
FIdTCPServer := TIdTCPServer.Create(nil);设置需要打开的端口DefaultPort和需要执行的逻辑OnExecute事件，每个客户端连接通信都需要通过OnExecute事件进行处理。
这样就可以打开服务，进行监听并处理客户端数据。
基本的程序代码如下：
//创建TCP服务器
FIdTCPServer := TIdTCPServer.Create(nil);
//个性化创建，包含客户端信息
FIdTCPServer.ContextClass:= TMyContext;
FIdTCPServer.MaxConnections := FMaxConnections;
FIdTCPServer.DefaultPort := FWebPort;
FIdTCPServer.Active := False;
FIdTCPServer.OnConnect := IdTCPServer_Connect;
FIdTCPServer.OnDisconnect := IdTCPServer_Disconnect;
FIdTCPServer.OnContextCreated := IdTCPServer_ContextCreated;
FIdTCPServer.OnExecute := IdTCPServer_Execute;
FIdTCPServer.OnException := IdTCPServer_Exception;
FIdTCPServer.OnStatus := IdTCPServer_Status;2、网络数据读写
- 接收客户端数据：AContext.Connection.IOHandler.ReadBytes(TidBytes(inBytes),len ,False);
- 发送给客户端数据： AContext.Connection.IOHandler.Write(TidBytes(outBytes));
3、握手处理
当客户端连接到服务器时，它会发送一个GET请求，以便从一个简单的HTTP请求升级到WebSocket的连接。这就是所谓的握手。此示例代码可以检测来自客户端的GET。请注意，在消息的前50个字节可用之前，此操作将被阻。
握手返回数据容的构建不难，但是理解上需要过程。完整的返回内容是需要按照 RFC 6455标准构建的。我们就简单的构建一个精简的Response返回。
我们必须：
- 从客户端的请求中解析出"Sec-WebSocket-Key" ，前后不允许有任何空格之类；
- 和"258EAFA5-E914-47DA-95CA-C5AB0DC85B11"字符串拼接（RFC 6455 指定的一个特殊固定的GUID）。
- 对以上字符串进行SHA-1签名并Base64出一个字符串；
- 将生成的字符串放置在"Sec-WebSocket-Accept"字段中返回给客户端。
function TWebSocket.Process_Handshake(Context: TIdContext;
var ErrorMsg: string): Boolean;
var
inBytes : TBytes;
inString : string;
inLen : integer;
tStart : TDateTime;
ClientID : string;
WebSocket_Key : string;
WebSocket_Version : string;
User_Agent : string;
Upgrade : string;
Connection : string;
sResponse : string;
outBytes : TBytes;
S : string;
begin
//如果握手成功，则返回True,否则返回握手失败 False
//1. 首先检查接收到的数据，数据长度必须至少50
ClientID := Context.Connection.Socket.Binding.PeerIP + ':' + Context.Connection.Socket.Binding.PeerPort.ToString;
tStart := Now; //当前时间
while true do
begin
//如果超时，则直接返回错误
if SecondsBetween(Now,tStart) > FHandShakeTimeout then
begin
Result := False;
ErrorMsg := '握手信号超时！';
if Assigned(FOnError) then
FOnError(ClientID,ErrorMsg);
Exit;
end;
if Context.Connection.IOHandler.InputBufferIsEmpty then
begin
Context.Connection.IOHandler.CheckForDataOnSource(0);
Context.Connection.IOHandler.CheckForDisconnect;
if Context.Connection.IOHandler.InputBufferIsEmpty then Exit;
end;
inLen := Context.Connection.IOHandler.InputBuffer.Size;
if inLen <= 50 then Continue;
SetLength(inBytes,0);
//读取到实际的数据
Context.Connection.IOHandler.ReadBytes(TidBytes(inBytes),inlen ,False);
try
inString := TEncoding.UTF8.GetString(inBytes);
//1.进行数据解析
Upgrade := TRegEx.Match(inString,'Upgrade: (.*)').Groups.Item[1].Value;
Connection := TRegEx.Match(inString,'Connection: (.*)').Groups.Item[1].Value;
WebSocket_Key := TRegEx.Match(inString,'Sec-WebSocket-Key: (.*)').Groups.Item[1].Value;
WebSocket_Version := TRegEx.Match(inString,'Sec-WebSocket-Version: (.*)').Groups.Item[1].Value;
User_Agent := TRegEx.Match(inString,'User-Agent: (.*)').Groups.Item[1].Value;
if (Upgrade <> 'websocket') or (Connection <> 'Upgrade') or (WebSocket_Key = '') then //说明不是WebSocket协议，退出
begin
Result := False;
ErrorMsg := '收到的握手数据流不正确(未包含 WebSocket_Key 字段)！';
if Assigned(FOnError) then
FOnError(ClientID,ErrorMsg);
Exit;
end;
//2.构造返回数据
sResponse := 'HTTP/1.1 101 Switching Protocols' + #13#10;
sResponse := sResponse + 'Connection: Upgrade' + #13#10;
sResponse := sResponse + 'Upgrade: websocket' + #13#10;
outBytes := THashSHA1.GetHashBytes(UTF8String( Trim(WebSocket_Key) + CWebSocket_KEY ));
S := TNetEncoding.Base64.EncodeBytesToString(outBytes);
sResponse := sResponse + 'Sec-WebSocket-Accept: ' + S +#13#10#13#10;
outBytes := TEncoding.UTF8.GetBytes(sResponse);
Context.Connection.IOHandler.Write(TidBytes(outBytes),Length(outBytes));
//客户端信息
TMyContext(Context).ClientInfo.User_Agent := User_Agent;
if Assigned(FOnHandhake) then
FOnHandhake(ClientID,WebSocket_Key,WebSocket_Version,User_Agent);
//写入握手成功时间
Result := True;
Break;
except on E: Exception do
begin
Result := False;
ErrorMsg := '收到的握手数据流不正确(不是UTF8字符串)！';
if Assigned(FOnError) then
FOnError(ClientID,ErrorMsg);
Exit;
end;
end;
end;
end;4、消息解码
握手成功以后，客户端和服务器端就可以互相发送数据了，首先假定客户端给服务器端发送数据。服务器端收到数据后就会进行反掩码计算。具体参见 Delphi 的Websocket Server 控件实现（一、WebSocket 原理）（含源码）中的2、数据通信。
解码算法：
Di = Ei XOR M(i mod 4)
其中D表示接开的数据，E表示接收到的数据，M表示的是掩码数组（4字节），i表示的是实际内容的索引。
程序实现代码如下：
function TWebSocket.Get_ClientData(ClientData: TBytes): TBytes;
var
MaskKEY : TBytes; //掩码密钥，应该是4个字节
Payload_Length,i : Int64; //实际的数据长度
M : Byte;
B : Byte;
Payload_Len : Byte;
dataPosition : Byte;
begin
//1. 首先判断段M位是否为1，不是则错误
if Length(ClientData) <= 3 then
raise Exception.Create('Err04,数据长度不足');
B := ClientData[1];
M := B shr 7;
if M <> 1 then //说明从客户端发来的数据没有加密，是不正确的
raise Exception.Create('Err05,客户端数据格式不正确(没有掩码位)');
//2. 数据长度
Payload_Len := B - $80;
SetLength(MaskKEY,4);
case Payload_Len of
126 :
begin
//获取数据长度
Payload_Length := 0;
Payload_Length := ((Payload_Length or ClientData[2]) shl 8) or ClientData[3];
move(ClientData[4],MaskKEY[0],4); //MaskKEY
dataPosition := 8;
end;
127 :
begin
//获取数据长度
Payload_Length := 0;
for i := 2 to 8 do
Payload_Length := (Payload_Length or ClientData[i]) shl 8;
Payload_Length := Payload_Length or ClientData[9];
move(ClientData[2],Payload_Length,8);
move(ClientData[10],MaskKEY[0],4);
dataPosition := 14;
end
else //0-125
Payload_Length := Payload_Len;
move(ClientData[2],MaskKEY[0],4);
dataPosition := 6;
end;
//解密数据
SetLength(Result,Payload_Length);
for i := 0 to Payload_Length - 1 do
Result[i] := ClientData[i + dataPosition] xor MaskKEY[i mod 4];
end;5、控件中使用的关键技术点
1、初始化客户端信息
需要记录每个客户端的相关信息，这样可以通过增加一个结构体，同时给TIdTCPServer设置一个新的Context类：
TClientInfo = record
ClientIP : string;
ClientPort : Word;
ConnectTime : TDateTime; //连接成功时间
HandshakeTime : TDateTime; //握手成功时间
ping_Timeout : TDateTime; //发送ping命令之后，需要在这个时间之前得到回复，如果没有得到回复，则需要挂断客户端 0:表示没有发送ping命令
R_Last_Text : string; //最后一次接收到的文本数据
S_Last_Text : string; //最后一次发送的数据
R_Count : integer; //接收的消息次数
S_Count : integer; //发送的消息次数
ID : string; //唯一的索引 是 ClientIP + ':' + ClientPort
DisConnect : Boolean; //断开客户端连接
User_Agent : string;
end;
//创建一个包含客户端连接信息的ContextClass
TMyContext = class(TIdServerContext)
ClientInfo: TClientInfo;
end;
//创建TCP服务器
FIdTCPServer := TIdTCPServer.Create(nil);
//个性化创建，包含客户端信息
FIdTCPServer.ContextClass:= TMyContext;每个客户端信息在TIdTCPServer.OnContextCreated事件中进行初始化。
procedure TWebSocket.IdTCPServer_ContextCreated(AContext: TIdContext);
begin
//初始化客户端记录结构数据
with TMyContext(AContext).ClientInfo do
begin
ClientIP := AContext.Connection.Socket.Binding.PeerIP;
ClientPort := AContext.Connection.Socket.Binding.PeerPort;
ID := ClientIP + ':' + ClientPort.ToString;
ConnectTime:= Now;
HandshakeTime := 0; //没有握手成功,如果成功，这里表示的是握手成功的时间
ping_Timeout := 0; //不是ping 状态
R_Last_Text := '';
S_Last_Text := '';
R_Count := 0;
S_Count := 0;
DisConnect := False;
end;
end;2、ping实现方法
通过一个定时器来实现定时ping,如果ping失败，则直接挂断客户端。ping是异步的，操作的原理是通过定时器发送一个ping给客户端，然后设置 客户端结构体TClientInfo.Ping_TimeOut参数，表示再这个时间之前必须收到ping的结果pong,如果没有收到，则直接认为客户端已经断开，直接挂断。系统会在OnExecute事件中检测这个参数，从而实现ping流程。
//2. 判断是否有ping 在执行
if TMyContext(AContext).ClientInfo.ping_Timeout <> 0 then
if Now > TMyContext(AContext).ClientInfo.ping_Timeout then
begin
//超时未收到ping的回复，挂断客户端
AContext.Connection.Disconnect;
Exit;
end;3、 服务器端给客户端发送数据
服务器端给客户端发送数据：如果服务器端希望给客户端发送数据，每个客户端需要有一个ID，用来唯一标识客户端，再本控件的设计中，我们使用的是客户端的IP + 冒号 + 服务器端端口号。例如：127.0.0.1：57109，其中客户端IP是127.0.0.1，客户端和服务器连接的端口是57109。需要注意的是TIdTCPServer的DefaultPort是服务器的监听端口，是不变的，客户端只要和服务器端连接好，就会创建唯一的一个端口号。我们使用ID通过遍历TIdTCPServer.Contexts，查找到对应的客户端Context，然后使用这个Context就可以给客户端发送消息了。注意由于是多线程操作，需要加锁。
function TWebSocket.WriteTexts(const ClientID: string; Text_Message: string;
var ErrorMsg: string): Boolean;
var
LContext: TIdContext;
LList: TIdContextList;
i : integer;
B : TBytes;
begin
ErrorMsg := '当前没有连接的客户端！';
if FIdTCPServer.Contexts = nil then Exit(False);
LList := FIdTCPServer.Contexts.LockList;
try
for i := 0 to LList.Count - 1 do
begin
LContext := {$IFDEF HAS_GENERICS_TList}LList.Items[i]{$ELSE}TIdContext(LList.Items[i]){$ENDIF};
if (TMyContext(LContext).ClientInfo.ID = ClientID) then
begin
//判断是否握手成功
if TMyContext(LContext).ClientInfo.HandshakeTime = 0 then
begin
ErrorMsg := '当前连接尚未进行握手！';
Exit(False);
end;
B := TEncoding.UTF8.GetBytes(Text_Message);
B := Build_WebSocketBytes(B);
LContext.Connection.IOHandler.Write(TidBytes(B));
//更新发送计数
TMyContext(LContext).ClientInfo.S_Last_Text := Text_Message;
TMyContext(LContext).ClientInfo.S_Count := TMyContext(LContext).ClientInfo.S_Count + 1;
Exit(True);
end;
end;
ErrorMsg := '未查询到客户端: ' + ClientID;
Exit(False);
finally
FIdTCPServer.Contexts.UnLockList;
end;
end;