Multi-Byte Character Support over TServerSocket Delphi

Question

While working on a multi-user chat application I've got stuck around getting the multi-byte chars to work over TServerSocket / TClientSocket.

This is the part where the client sends the message to the server:

  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;

This is how the server parses the received data:

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;

An example of how the Socket.ReceiveText looks like:

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

The structure is ACTION + SEPARATOR + USERNAME + EXTRA_DATA, thas my way of "keeping" the online users list updated. I'm new to delphi, if there's any easier way of doing that, let me know.

The problem is now, if I'm sending multibyte characters over to the users and back, those multibyte chars are received as question marks "?". - "ț or ș" becomes "? or ?"

Printscreen here:

EDIT2: Ok, after all the changes have been made, thanks to your answers, I bumped into a problem while trying to send the data received by the server from the client back to the other clients. Well this problem has 2 little bumps:

1. This is how the server sends a "global" message to the users.

   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. This is how server sends back to other active connections the data received from one client:

   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;
   

Now, if these 2 methods are correct, then the problem is the reading data on the client side, and this is how the data is parsed on the client side following the same principle as 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;

Trying to send data from client to server works flawlessly as you can see in the image (above) string is interpreted as it should be. The problem is either trying to send the data back to the clients in ServerSocketClientRead method, either in the ClientSocketRead method.

UPDATE 3: So I had launched the client on another pc and the problem seems to be at the ClientSocketRead method (if the ServerSocketClientRead -> SendString and the global SendBtn -> SendString are correct); I'll keep updating if any new details are found.

Answer 1

You need to stay away from the SendText() and ReceiveText() methods, especially if you are using non-blocking sockets. They do not handle the conditions that data may have to be sent in multiple packets, and that packets can arrive in smaller pieces or even multiple packets merged together. These are very common conditions that you have to handle in TCP programming.

SendText() simply passes the string as-is to SendBuf(). If it cannot send the entire string in a single send, it does not attempt to re-send the remaining characters. So you can (and likely will) send incomplete strings. It does return how many bytes were actually sent, so you can call SendText() in a loop until there are no more characters to send.

ReceiveText() has no way of knowing the length of the string being received. It merely reads whatever is currently in the socket buffer and returns it as a string. So this also runs the risk of reading incomplete strings, or even reading multiple (even partial) strings together.

The best way to send a string is to use SendBuf() and ReceiveBuf() directly instead. When sending a string, either send the string length (in bytes) before sending the string data, or else send a unique delimiter after the string data that does not appear in the string itself. The receiver can then read the length value and then read the specified number of bytes, or read until the delimiter is encountered. Also, when dealing with non-ASCII string data, especially with D2009+'s UnicodeString string type, you should encode the string data to a universal format during transmission, such as UTF-8.

If you are using non-blocking sockets, this gets more complicated. If a socket would enter a blocking state during a send/read operation, the operation fails with an WSAEWOULDBLOCK error code and you have to repeat the operation when the socket is out of the blocking state.

If a send operation fails with WSAEWOULDBLOCK then buffer your remaining data somewhere (and append any future outbound data to the end of that buffer if it is not empty) until the OnWrite event fires, then send whatever is in your buffer, removing successfully sent bytes, until it is emptied or the socket blocks again (in which case, you have to wait for another OnWrite event before sending the remaining buffer data).

Likewise, when a read operation fails with WSAEWOULDBLOCK but you are still expecting data, you have to wait for another OnRead event to fire before you can attempt to read again, buffering any intermediate data that has been received, until you have received all of the data that you are expecting before you can then process it.

For example:

Common code:

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;

Client code:

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;

Server code:

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;