特に非ブロッキングソケットを使用している場合は、メソッドSendText()とメソッドに近づかないようにする必要があります。ReceiveText()これらは、データを複数のパケットで送信する必要がある可能性があり、パケットが小さな断片で到着したり、複数のパケットがマージされたりする可能性があるという条件を処理しません。これらは、TCPプログラミングで処理しなければならない非常に一般的な条件です。
SendText()文字列をそのまま渡すだけSendBuf()です。1回の送信で文字列全体を送信できない場合、残りの文字の再送信は試行されません。したがって、不完全な文字列を送信できます（おそらく送信します）。実際に送信されたバイト数が返されるため、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);
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;
