TServerSocket Delphi上的多字节字符支持

在处理多用户聊天应用程序时,我一直困扰着让多字节字符在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,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,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的新手,如果有更简单的方法,请告诉我.

现在的问题是,如果我将多字节字符发送给用户并返回,则这些多字节字符作为问号“？”被接收.
– “ţ或ş”变成“？或？”

这里的Printscreen：

编辑2：好的,在完成所有更改之后,由于您的答案,我在尝试将服务器从客户端收到的数据发送回其他客户端时遇到了问题.那么这个问题有两个小问题：

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

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,str,'none');
  SendMsg.Text := '';
end;

>这是服务器将从一个客户端收到的数据发送回其他活动连接的方式：

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],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;

尝试将数据从客户端发送到服务器可以完美地工作,如图中所示(上图)字符串被解释为应该是.问题是要么尝试在ClientSocketRead方法中将数据发送回ServerSocketClientRead方法中的客户端.

更新3：所以我在另一台PC上启动了客户端,问题似乎是ClientSocketRead方法(如果ServerSocketClientRead – > SendString和全局SendBtn – > SendString是正确的);如果找到任何新的细节,我会不断更新.

解决方法

您需要远离SendText()和ReceiveText()方法,尤其是在使用非阻塞套接字时.它们不处理数据可能必须在多个数据包中发送的条件,并且数据包可以以较小的块或甚至多个数据包合并在一起.这些是您必须在TCP编程中处理的非常常见的条件.

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

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

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

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

如果发送操作失败并使用WSAEWOULDBLOCK,则将剩余数据缓冲到某处(并将任何未来的出站数据附加到该缓冲区的末尾,如果它不为空),直到OnWrite事件触发,然后发送缓冲区中的任何内容,删除成功发送的字节,直到它被清空或套接字再次阻塞(在这种情况下,你必须在发送剩余的缓冲区数据之前等待另一个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);
  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,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,arr[1] + ' has connected !','green');
      end
      else if arr[0] = 'disconnect' then
      begin
        Contacts.Items.Delete(Contacts.Items.IndexOf(arr[1]));
        add_text(MsgBox,arr[1] + ' has disconnected !','red');
      end
      else if arr[0] = 'message' then
      begin
        add_text(MsgBox,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,'none');
  SendMsg.Text := '';
end;

原文链接：https://www.f2er.com/delphi/101647.html

TServerSocket Delphi上的多字节字符支持

解决方法

猜你在找的Delphi相关文章