delphi - TServerSocket Delphi 上的多字节字符支持

Question

在开发多用户聊天应用程序时，我一直在让多字节字符通过 TServerSocket/TClientSocket 工作。

这是客户端向服务器发送消息的部分:

  procedure TChatForm.SendBtnClick(Sender: TObject);
  var str : string;
  begin
    str := MsgLabel.Text;
    ClientSocket.Socket.SendText('message' + separator + nickname + separator + str);
    MsgLabel.Text := '';
    add_text(MsgBox,MsgLabel,nickname+': '+str,'none');
  end;

这是服务器解析接收到的数据的方式:

procedure TServerForm.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
  i,hnd : Integer;
  recv : string;
  arr : TStringArray; // type TStringArray = array of string;
begin
  recv := Socket.ReceiveText;
  hnd := Socket.Handle; //using this to avoid sending received data back to the client
  arr := SplitStr(recv,separator); 
  //SplitStr is a function i use because TStringList.DelimitedText uses only a char as delimiter 

  // sending the data to the others users / but the expeditor - async error workaround
  for i:=0 to ServerSocket.Socket.ActiveConnections-1 do begin
    if ServerSocket.Socket.Connections[i].Handle <> hnd then
      ServerSocket.Socket.Connections[i].SendText(recv);
  end;

  if arr[0] = 'connect' then begin

    // adding the connected user to the tlistbox
    Contacts.Items.Add(arr[1]);
    // adding the connected message in the trichedit
    add_text(MsgBox,SendMsg,arr[1]+' has connected !','green');

  end else if arr[0] = 'disconnect' then begin

    // removing the user from the online user list
    Contacts.Items.Delete(Contacts.Items.IndexOf(arr[1]));
    // adding the disconnected message in trichedit
    add_text(MsgBox,SendMsg,arr[1]+' has disconnected !','red');

  end else if arr[0] = 'message' then begin

    // finally adding the message that user send in the TRichEdit
    add_text(MsgBox,SendMsg,arr[1]+': '+arr[2],'none');

  end;
end;

Socket.ReceiveText 的示例:

- when user connects he sends the next message - connect^SEPARATOR^username
- when a user sends a message - message^SEPARATOR^username^SEPARATOR^message_body

结构是ACTION + SEPARATOR + USERNAME + EXTRA_DATA，这是我“保持”在线用户列表更新的方式。我是delphi新手，如果有更简单的方法，请告诉我。

现在的问题是，如果我向用户发送多字节字符并返回，这些多字节字符将以问号“？”的形式接收。-“ś 或 ř”变为“？或？”

此处打印屏幕:

EDIT2:好的，完成所有更改后，感谢您的回答，我在尝试将服务器从客户端接收到的数据发送回其他客户端时遇到了问题。这个问题有两个小问题:

1. 这就是服务器向用户发送“全局”消息的方式。

   procedure TServerForm.SendBtnClick(Sender: TObject);
   var
     i : Integer;
     str : String;
   begin
     str := SendMsg.Text;
   
     with ServerSocket.Socket do
     begin
       for i := 0 to ActiveConnections-1 do
         SendString(Connections[i], TSocketBuffers(Connections[i].Data).OutBuffer, 'global' + separator + str);
     end;
   
     add_text(MsgBox,SendMsg,str,'none');
     SendMsg.Text := '';
   end;
   

2. 这是服务器将从一个客户端接收到的数据发送回其他事件连接的方式:

   procedure TServerForm.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
   var
     Buffers: TSocketBuffers;
     i: Integer;
     RecvStr : String;
     arr : TStringArray;
   begin
     Buffers := TSocketBuffers(Socket.Data);
     if not Buffers.ReadInData(Socket) then Exit;
     Buffers.InBuffer.Position := 0;
     try
       while ReadString(Buffers.InBuffer, RecvStr) do
       begin
         arr := SplitStr(RecvStr, separator);
   
         with ServerSocket.Socket do
         begin
           for i := 0 to ActiveConnections-1 do
           begin
             if Connections[i] <> Socket then
               SendString(Connections[i], TSocketBuffers(Connections[i].Data).OutBuffer, arr[0]);
           end;
         end;
   
         // [ .. some string processing stuff .. ]
       end;
     finally
       CompactBuffer(Buffers.InBuffer);
     end;
   end;
   

现在，如果这两种方法都正确，那么问题就出在客户端读取数据的问题，这就是客户端解析数据的方式，原理与 ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket )；

    procedure TChatForm.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    var
      Buffers: TSocketBuffers;
      i: Integer;
      RecvStr : String;
      arr : TStringArray;
    begin
      Buffers := TSocketBuffers(Socket.Data);
      if not Buffers.ReadInData(Socket) then Exit;
      Buffers.InBuffer.Position := 0;
      try
        while ReadString(Buffers.InBuffer, RecvStr) do begin
          ShowMessage(RecvStr); // testing if anything is received
          // [[.. some string processing code ..]]
        end;
      finally
        CompactBuffer(Buffers.InBuffer);
      end;
    end;

尝试将数据从客户端发送到服务器可以完美地工作，正如您在图像(上图)中看到的那样，字符串被解释为应有的样子。问题是尝试在 ServerSocketClientRead 方法中将数据发送回客户端，或者在 ClientSocketRead 方法中。

更新3:所以我在另一台电脑上启动了客户端，问题似乎出在 ClientSocketRead 方法上(如果 ServerSocketClientRead -> SendString 和全局 SendBtn -> SendString 正确)；如果发现任何新的详细信息，我会继续更新。

Answer 1

您需要远离 SendText() 和 ReceiveText() 方法，尤其是在使用非阻塞套接字时。它们不处理数据可能必须以多个数据包的形式发送以及数据包可以以较小的片段甚至多个数据包合并在一起到达的情况。这些是 TCP 编程中必须处理的非常常见的情况。

SendText() 只是将字符串按原样传递给 SendBuf()。如果它无法在一次发送中发送整个字符串，则它不会尝试重新发送剩余的字符。因此您可以(并且可能会)发送不完整的字符串。它确实返回实际发送的字节数，因此您可以循环调用 SendText() 直到没有更多字符要发送。

ReceiveText() 无法知道正在接收的字符串的长度。它只是读取套接字缓冲区中当前的内容并将其作为字符串返回。因此，这也存在读取不完整字符串，甚至一起读取多个(甚至部分)字符串的风险。

发送字符串的最佳方法是直接使用 SendBuf() 和 ReceiveBuf()。发送字符串时，要么在发送字符串数据之前发送字符串长度(以字节为单位)，要么在字符串数据之后发送不出现在字符串本身中的唯一分隔符。然后接收方可以读取长度值，然后读取指定的字节数，或者读取直到遇到分隔符。另外，在处理非 ASCII 字符串数据时，尤其是 D2009+ 的 UnicodeString 字符串类型时，应将字符串数据在传输过程中编码为通用格式，例如 UTF-8。

如果您使用非阻塞套接字，这会变得更加复杂。如果套接字在发送/读取操作期间进入阻塞状态，则该操作将失败并显示 WSAEWOULDBLOCK 错误代码，并且当套接字脱离阻塞状态时，您必须重复该操作。

如果发送操作因 WSAEWOULDBLOCK 失败，则将剩余数据缓冲在某处(如果该缓冲区不为空，则将 future 的出站数据附加到该缓冲区的末尾)，直到 OnWrite code> 事件触发，然后发送缓冲区中的所有内容，删除成功发送的字节，直到缓冲区被清空或套接字再次阻塞(在这种情况下，您必须等待另一个 OnWrite 事件，然后再发送剩余缓冲区数据)。

同样，当读取操作因 WSAEWOULDBLOCK 失败但您仍在等待数据时，您必须等待另一个 OnRead 事件触发，然后才能尝试再次读取，缓冲已接收到的任何中间数据，直到收到您期望的所有数据，然后才能对其进行处理。

例如:

常用代码:

type
  TSocketData = class
  private
    Socket: TCustomSocketSocket;
    InBuffer: TMemoryStream;
    OutBuffer: TMemoryStream;
    function SendRawToSocket(Data: Pointer; DataLen: Integer): Integer;
    procedure Compact(Buffer: TMemoryStream);
  public
    constructor Create(ASocket: TCustomSocketSocket);
    destructor Destroy; override;
    function BufferInboundData: Boolean;
    procedure FlushOutboundData;
    procedure BeginReading;
    procedure EndReading;
    function SendRaw(Data: Pointer; DataLen: Integer): Boolean;
    function ReadRaw(Data: Pointer; DataLen: Integer): Boolean;
    function SendInteger(Value: Integer): Boolean;
    function ReadInteger(var Value: Integer): Boolean;
    function SendInt64(Value: Int64): Boolean;
    function ReadInt64(var Value: Int64): Boolean;
    function SendString(const Str: String): Boolean;
    function ReadString(var Str: String): Boolean;
    function SendStream(Stream: TStream): Boolean;
    function ReadStream(Stream: TStream): Boolean;
   end;

constructor TSocketData.Create(ASocket: TCustomWinSocket);
begin
  inherited;
  Socket := ASocket;
  InBuffer := TMemoryStream.Create;
  OutBuffer := TMemoryStream.Create;
end;

destructor TSocketData.Destroy;
begin
  InBuffer.Free;
  OutBuffer.Free;
  inherited;
end;

function TSocketData.SendRawToSocket(Data: Pointer; DataLen: Integer): Integer;
var
  Bytes: PByte;
  Ret: Integer;
begin
  Result := 0;
  Bytes := PByte(Data);
  while DataLen > 0 do
  begin
    Ret := Socket.SendBuf(Bytes^, DataLen);
    if Ret < 1 then
    begin
      if WSAGetLastError = WSAEWOULDBLOCK then Break;
      Result := -1;
      Exit;
    end;
    Inc(Bytes, Ret);
    Dec(DataLen, Ret);
    Inc(Result, Ret);
  end;
end;

function TSocketData.BufferInboundData: Boolean;
var
  RecvLen, OldSize: Integer;
begin
  Result := False;

  RecvLen := Socket.ReceiveLength;
  if RecvLen < 1 then Exit;

  OldSize := InBuffer.Size;
  InBuffer.Size := OldSize + RecvLen;
  try
    RecvLen := Socket.ReceiveBuf((PByte(InBuffer.Memory)+OldSize)^, RecvLen);
    if RecvLen < 1 then RecvLen := 0;
  except
    RecvLen := 0;
  end;
  InBuffer.Size := OldSize + RecvLen;
  if RecvLen = 0 then Exit;

  Result := True;
end;

procedure TSocketData.FlushOutboundData;
var
  Ret: Integer;
begin
  if OutBuffer.Size = 0 then Exit;
  Ret := SendRawToSocket(OutBuffer.Memory, OutBuffer.Size);
  if Ret < 1 then Exit;
  OutBuffer.Position := Ret;
  Compact(OutBuffer);
end;

procedure TSocketData.Compact(Buffer: TMemoryStream);
var
  Remaining: Integer;
begin
  if Buffer.Position = 0 then Exit;
  Remaining := Buffer.Size - Buffer.Position;
  if Remaining > 0 then
    Move((PByte(Buffer.Memory) + Buffer.Position)^, Buffer.Memory^, Remaining);
  Buffer.Size := Remaining;
end;

procedure TSocketData.BeginReading;
begin
  InBuffer.Position := 0;
end;

procedure TSocketData.EndReading;
begin
  Compact(InBuffer);
end;

function TSocketData.SendRaw(Data: Pointer; DataLen: Integer): Boolean;
var
  Bytes: PByte;
  Ret: Integer;
begin
  Bytes := PByte(Data);
  if OutBuffer.Size = 0 then
  begin
    Ret := SendRawToSocket(Bytes, DataLen);
    if Ret = -1 then
    begin
      Result := False;
      Exit;
    end;
    Inc(Bytes, Ret);
    Dec(DataLen, Ret);
  end;
  if DataLen > 0 then
  begin
    OutBuffer.Seek(0, soEnd);
    OutBuffer.WriteBuffer(Bytes^, DataLen);
  end;
  Result := True;
end;

function TSocketData.ReadRaw(Data: Pointer; DataLen: Integer): Boolean;
begin
  Result := False;
  if (InBuffer.Size - InBuffer.Position) < DataLen then Exit;
  InBuffer.ReadBuffer(Data^, DataLen);
  Result := True;
end;

function TSocketData.SendInteger(Value: Integer): Boolean;
begin
  Value := htonl(Value);
  Result := SendRaw(@Value, SizeOf(Value));
end;

function TSocketData.ReadInteger(var Value: Integer): Boolean;
begin
  Result := ReadRaw(@Value, SizeOf(Value));
  if Result then Value := ntohl(Value);
end;

type
  TInt64Parts = packed record
    case Integer of
    0: (
      LowPart: LongWord;
      HighPart: LongWord);
    1: (
      QuadPart: Int64);
  end;

function hton64(AValue: Int64): Int64;
var
  LParts: TInt64Parts;
  L: LongWord;
begin
  LParts.QuadPart := AValue;
  L := htonl(LParts.HighPart);
  LParts.HighPart := htonl(LParts.LowPart);
  LParts.LowPart := L;
  Result := LParts.QuadPart;
end;

function ntoh64(AValue: Int64): Int64;
var
  LParts: TInt64Parts;
  L: LongWord;
begin
  LParts.QuadPart := AValue;
  L := ntohl(LParts.HighPart);
  LParts.HighPart := ntohl(LParts.LowPart);
  LParts.LowPart := L;
  Result := LParts.QuadPart;
end;

function TSocketData.SendInt64(Value: Int64): Boolean;
begin
  Value := hton64(Value);
  Result := SendRaw(@Value, SizeOf(Value));
end;

function TSocketData.ReadInt64(var Value: Int64): Boolean;
begin
  Result := ReadRaw(@Value, SizeOf(Value));
  if Result then Value := ntoh64(Value);
end;

function TSocketData.SendString(const Str: String): Boolean;
var
  S: UTF8String;
  Len: Integer;
begin
  S := UTF8String(Str);
  Len := Length(S);
  Result := SendInteger(Len);
  if Result and (Len > 0) then
    Result := SendRaw(PAnsiChar(S), Len);
end;

function TSocketData.ReadString(var Str: String): Boolean;
var
  S: UTF8String;
  Len: Integer;
begin
  Result := False;
  Str := '';
  if not ReadInteger(Len) then Exit;
  if (InBuffer.Size - InBuffer.Position) < Len then
  begin
    InBuffer.Seek(-SizeOf(Len), soCurrent);
    Exit;
  end;
  if Len > 0 then
  begin
    SetLength(S, Len);
    ReadRaw(PAnsiChar(S), Len);
    Str := String(S);
  end;
  Result := True;
end;

function TSocketData.SendStream(Stream: TStream): Boolean;
var
  Buf: array[0..1023] of Byte;
  Len: Int64;
  NumToSend: Integer;
begin
  Len := Stream.Size - Stream.Position;
  Result := SendInt64(Len);
  if Result and (Len > 0) then
  begin
    repeat
      if Len > SizeOf(Buf) then
        NumToSend := SizeOf(Buf)
      else
        NumToSend := Integer(Len);
      Stream.ReadBuffer(Buf[0], NumToSend);
      Dec(Len, NumToSend);
      Result := SendRaw(@Buf[0], NumToSend);
    until (Len = 0) or (not Result);
  end;
end;

function TSocketData.ReadStream(Stream: TStream): Boolean;
var
  Len: Int64;
begin
  Result := False;
  if not ReadInt64(Len) then Exit;
  if (InBuffer.Size - InBuffer.Position) < Len then
  begin
    InBuffer.Seek(-SizeOf(Len), soCurrent);
    Exit;
  end;
  if Len > 0 then
    Stream.CopyFrom(InBuffer, Len);
  Result := True;
end;

客户端代码:

procedure TChatForm.ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Socket.Data := TSocketData.Create(Socket);
end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  TSocketData(Socket.Data).Free;
  Socket.Data := nil;
end;

procedure TChatForm.ClientSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
  TSocketData(Socket.Data).FlushOutboundData;
end;

procedure TChatForm.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
var
  SocketData: TSocketData;
  i: Integer;
  RecvStr : String;
  arr : TStringArray;
begin
  SocketData := TSocketData(Socket.Data);
  if not SocketData.BufferInboundData then Exit;
  SocketData.BeginReading;
  try
    while SocketData.ReadString(RecvStr) do begin
      ShowMessage(RecvStr); // testing if anything is received
      // [[.. some string processing code ..]]
    end;
  finally
    SocketData.EndReading;
  end;
end;

procedure TChatForm.SendBtnClick(Sender: TObject);
var
  SocketData: TSocketData;
begin
  if ClientSocket1.Socket = nil then Exit;
  SocketData := TSocketData(ClientSocket1.Socket.Data);
  if SocketData = nil then Exit;
  str := MsgLabel.Text;
  if SocketData.SendString('message' + separator + nickname + separator + str) then
  begin
    MsgLabel.Text := '';
    add_text(MsgBox, MsgLabel, nickname + ': ' + str, 'none');
  end;
end;

服务器代码:

procedure TServerForm.ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Socket.Data := TSocketData.Create(Socket);
end;

procedure TServerForm.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  TSocketData(Socket.Data).Free;
  Socket.Data := nil;
end;

procedure TServerForm.ServerSocketClientRead(Sender: TObject;Socket: TCustomWinSocket);
var
  SocketData: TSocketData;
  i: Integer;
  RecvStr : String;
  arr : TStringArray;
begin
  SocketData := TSocketData(Socket.Data);
  if not SocketData.BufferInboundData then Exit;
  SocketData.BeginReading;
  try
    while SocketData.ReadString(RecvStr) do
    begin
      arr := SplitStr(RecvStr, separator); 

      with ServerSocket.Socket do
      begin
        for i := 0 to ActiveConnections-1 do
        begin
          if Connections[i] <> Socket then
            TSocketData(Connections[i].Data).SendString(RecvStr);
        end;
      end;

      if arr[0] = 'connect' then
      begin
        Contacts.Items.Add(arr[1]);
        add_text(MsgBox, SendMsg, arr[1] + ' has connected !', 'green');
      end
      else if arr[0] = 'disconnect' then
      begin
        Contacts.Items.Delete(Contacts.Items.IndexOf(arr[1]));
        add_text(MsgBox, SendMsg, arr[1] + ' has disconnected !', 'red');
      end
      else if arr[0] = 'message' then
      begin
        add_text(MsgBox, SendMsg, arr[1] + ': ' + arr[2], 'none');
      end;
    end;
  finally
    SocketData.EndReading;
  end;
end;

procedure TServerForm.ServerSocketClientWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
  TSocketData(Socket.Data).FlushOutboundData;
end;

procedure TServerForm.SendBtnClick(Sender: TObject);
var
  i : Integer;
  str : String;
begin
  str := SendMsg.Text;

  with ServerSocket.Socket do
  begin
    for i := 0 to ActiveConnections-1 do
      TSocketData(Connections[i].Data).SendString('global' + separator + str);
  end;

  add_text(MsgBox, SendMsg, str, 'none');
  SendMsg.Text := '';
end;