File not received if I free the instance of filestream anywhere? - delphi

I am trying to send a file using TServerSocket/TClientSocket. The file is sent completely as long as I do not free the filestream anywhere and by anywhere I mean form.OnCreate event too. If I do free anywhere only 1 or 2 percent is sent.
I also have to put the TFileStream.Create line of code on the server side OnCreate event. If I create a stream in TForm2.ServerSocket1ClientRead then I get an EFcreateerror: 'the process cannot access file because it is being used by another process''.
procedure TForm2.FormCreate(Sender: TObject);
begin
FStream := TFileStream.Create('c:\temp\log.txt', fmCreate or
fmShareDenyWrite);
end;
procedure TForm2.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
fs: TFileStream;
begin
fs := TFileStream.Create('c:\log.txt', fmOpenRead);
socket.SendStream(fs);
end;
procedure TForm2.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
iLen: Integer;
Bfr: Pointer;
begin
iLen := Socket.ReceiveLength;
GetMem(Bfr, iLen);
Socket.ReceiveBuf(Bfr^, iLen);
FStream.Write(Bfr^, iLen);
FreeMem(bfr);
//fstream.free
end;
Even if I put my code this way:
if fstream.Size = fstream.position then
fstream.free
Even then it gives me problem.
What is this strange phenomena? Is it a bug in Delphi? If yes is there a
work-around? If it matters: I am using Delphi 2010.
Update: sorry I meant if I put my code this way:
if fileSize = fstream.position then
fstream.free
Sorry, not fstream.size but filesize. I have already initialised file size as 300000 (size of file to be received).
Solved: Solved by replacing
FStream := TFileStream.Create('c:\temp\log.txt',
fmCreate or fmShareDenyWrite);
with
if not FileExists('c:\temp\log.txt') then
FStream := TFileStream.Create('c:\temp\log.txt',
fmCreate or fmShareDenyWrite);

You are trying to free your FStream object as soon as you receive the first block of data. Do not do that. That block will usually be smaller than the full file, especially if you are sending a large file. Also, checking for Position = Size on the receiving end is useless as well, as it will always evaluate be true since the current Position will always be at the end of the stream. As I already told you in the other discussion, you are not using the SendStream() and ReceiveBuf() methods effectively, and the sender needs to send the file size before sending the file data (or alternatively disconnect at the end of the file) so the receiver knows exactly when to stop its reading.
Edit:
Try something like this:
type
TSocketBuffer = class
public
Stream: TStream;
ExpectedSize: Int64;
Data: array[0..1023] of Byte;
DataOffset, DataSize: Integer;
destructor Destroy; override;
end;
TServerSocketBuffer = class(TSocketBuffer)
public
FileName: String;
destructor Destroy; override;
end;
destructor TSocketBuffer.Destroy;
begin
if Stream <> nil then Stream.Free;
inherited;
end;
destructor TServerSocketBuffer.Destroy;
begin
if Stream <> nil then FreeAndNil(Stream);
if FileName <> '' then DeleteFile(FileName);
inherited;
end;
procedure TForm2.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TSocketBuffer;
begin
Buffer := TSocketBuffer.Create;
Socket.Data := Buffer;
// open the file to send...
Buffer.Stream := TFileStream.Create('c:\log.txt', fmOpenRead or fmShareDenyWrite);
Buffer.ExpectedSize := Buffer.Stream.Size;
// buffer the stream size...
Move(Buffer.Data[0], Buffer.ExpectedSize, Sizeof(Int64));
Buffer.DataOffset := 0;
Buffer.DataSize := SizeOf(Int64);
// begin sending...
ClientSocket1Write(Sender, Socket);
end;
procedure TForm2.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TSocketBuffer(Socket.Data).Free;
end;
procedure TForm2.ClientSocket1Write(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TSocketBuffer;
NumBytes: Integer;
begin
// in case OnWrite is fired before OnConnect...
if Socket.Data = nil then Exit;
Buffer := TSocketBuffer(Socket.Data);
if Buffer.Stream = nil then Exit;
// keep sending until EOF is reached, or until the socket blocks/errors...
repeat
// if there is pending data buffered, send it now...
while Buffer.DataOffset < Buffer.DataSize do
begin
NumBytes := Socket.SendBuf(Buffer.Data[Buffer.DataOffset], Buffer.DataSize-Buffer.DataOffset);
if NumBytes <= 0 then Exit; // wait for next event...
Inc(Buffer.DataOffset, NumBytes);
end;
// has EOF been reached?
if Buffer.ExpectedSize <= 0 then Break;
// read the next block of data from the stream...
Buffer.DataOffset := 0;
Buffer.DataSize := 0;
NumBytes := Buffer.Stream.Read(Buffer.Data[0], Min(Buffer.ExpectedSize, SizeOf(Buffer.Data)));
if NumBytes <= 0 then Break; // stream error, stop sending...
Buffer.DataSize := NumBytes;
Dec(Buffer.ExpectedSize, NumBytes);
// the next loop iteration will start sending it...
until False;
// all done...
FreeAndNil(Buffer.Stream);
Socket.Close;
end;
procedure TForm2.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TServerSocketBuffer.Create;
end;
procedure TForm2.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TServerSocketBuffer(Socket.Data).Free;
end;
procedure TForm2.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buffer: TServerSocketBuffer;
FileName: String;
NumBytes: Integer;
begin
Buffer := TServerSocketBuffer(Socket.Data);
if Buffer.Stream = nil then
begin
// keep reading until stream size has been received in full...
while Buffer.DataSize < SizeOf(Int64) do
begin
NumBytes := Socket.ReceiveBuf(Buffer.Data[Buffer.DataOffset], SizeOf(Int64)-Buffer.DataOffset);
if NumBytes <= 0 then Exit; // wait for next event...
Inc(Buffer.DataSize, NumBytes);
Inc(Buffer.DataOffset, NumBytes);
end;
Move(Buffer.ExpectedSize, Buffer.Data[0], SizeOf(Int64));
// create the file to store in...
FileName := 'c:\temp\log.txt';
Buffer.Stream := TFileStream.Create(FileName, fmCreate);
Buffer.FileName := FileName;
// (optional) pre-size the file...
Buffer.Stream.Size := Buffer.ExpectedSize;
end;
// keep reading until EOF is reached, or until the socket blocks/errors...
while Buffer.ExpectedSize > 0 do
begin
// read the next block of data from the socket...
Buffer.DataOffset := 0;
Buffer.DataSize := 0;
NumBytes := Socket.ReceiveBuf(Buffer.Data[0], Min(Buffer.ExpectedSize, SizeOf(Buffer.Data)));
if NumBytes <= 0 then Exit; // wait for next event...
Buffer.DataSize := NumBytes;
// save the data to the stream....
repeat
NumBytes := Buffer.Stream.Write(Buffer.Data[Buffer.DataOffset], Buffer.DataSize-Buffer.DataOffset);
if NumBytes <= 0 then
// stream error, stop reading...
Socket.Close;
Exit;
end;
Inc(Buffer.DataOffset, NumBytes);
Dec(Buffer.ExpectedSize, NumBytes);
until Buffer.DataOffset >= Buffer.DataSize;
end;
// all done...
FreeAndNil(Buffer.Stream);
Buffer.FileName := '';
end;

Related

TmemoryStream Server Out Of Memory On receiving stream

All I'm trying to do is send a stream with TSockets, but I'm having an "out of memory" error. I managed to send files, just not images. In the server Form's OnCreate event, I'm creating the stream. For the client, in the Form's OnCreate I'm creating the stream, also a bmp.
I've tried to see if it's not sending, but it's sending something, only I can't tell what. On the server side, I've tested sending commands to the client, and I know they send, also I've tested with booleans, but still get a memory error.
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
BytesReceived: Longint;
CopyBuffer: Pointer;
ChunkSize: Integer;
TempSize: Integer;
FSize: Integer;
writing: Boolean;
bmp: tbitmap;
const
MaxChunkSize: Longint = 8192;
begin
If FSize = 0 then
begin
If Socket.ReceiveLength > SizeOf(TempSize) then
begin
Socket.ReceiveBuf(TempSize, SizeOf(TempSize));
stream.SetSize(TempSize);
FSize := TempSize;
End;
End;
If (FSize > 0) and (writing) then //receiving the image
begin
GetMem(CopyBuffer, MaxChunkSize);
writing := true;
While Socket.ReceiveLength > 0 do
Begin
ChunkSize := Socket.ReceiveLength;
If ChunkSize > MaxChunkSize then
ChunkSize := MaxChunkSize;
BytesReceived := Socket.ReceiveBuf(CopyBuffer^, ChunkSize);
stream.Write(CopyBuffer^, BytesReceived);
Dec(FSize, BytesReceived);
End;
If FSize = 0 then
begin
bmp.LoadFromStream(stream);
self.Image1.Picture.Bitmap.LoadFromStream(stream);
stream.SetSize(0);
FSize := 0;
End;
FreeMem(CopyBuffer, MaxChunkSize);
writing := false;
stream.Free;
exit;
End;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
size: Integer;
Data: string;
begin
try
CaptureImage(bmp); //i have a procedure for this & know it works
bmp.SaveToStream(stream);
size := stream.size; //sending the tbitmap image
stream.Position := 0;
Socket.SendBuf(size, sizeof(size));
Socket.SendStream(stream);
except
stream.Free;
end;
You are not taking FSize into account when reading data from the client. You are reading as much as the client sends, and not stopping when the stream size has been reached. And you are not taking into account that it may (and likely will) take multiple OnRead events to receive the entire image, so you may end up freeing your stream prematurely.
Also, TCustomWinSocket.SendStream() is not very stable, especially if you are using the socket in non-blocking mode. You should instead use TCustomWinSocket.SendBuf() directly in a loop and handle any socket errors as needed.
Try something more like this:
uses
..., System.Math;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := nil;
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
if Socket.Data <> nil then
TMemoryStream(Socket.Data).Free;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Stream: TMemoryStream;
BytesReceived: Integer;
StreamSize, TempSize: Int32;
BytesRemaining: Int64;
P: PByte;
ChunkSize: Integer;
bmp: TBitmap;
const
MaxChunkSize: Int64 = 8192;
begin
Stream := TMemoryStream(Socket.Data);
// receiving the image size
if Stream = nil then
begin
if Socket.ReceiveLength < SizeOf(TempSize) then Exit;
BytesReceived := Socket.ReceiveBuf(TempSize, SizeOf(TempSize));
if BytesReceived <= 0 then Exit;
StreamSize := ntohl(TempSize);
Stream := TMemoryStream.Create;
Socket.Data := Stream;
Stream.Size := StreamSize;
BytesRemaining := StreamSize;
end else
BytesRemaining := Stream.Size - Stream.Position;
// receiving the image
if BytesRemaining > 0 then
begin
P := PByte(Stream.Memory);
if Stream.Position > 0 then
Inc(P, Stream.Position);
repeat
ChunkSize := Integer(Math.Min(BytesRemaining, MaxChunkSize));
BytesReceived := Socket.ReceiveBuf(P^, ChunkSize);
if BytesReceived <= 0 then Exit;
Inc(P, BytesReceived);
Dec(BytesRemaining, BytesReceived);
Stream.Seek(soCurrent, BytesReceived);
until BytesRemaining = 0;
end;
// loading the image
try
bmp := TBitmap.Create;
try
Stream.Position := 0;
bmp.LoadFromStream(Stream);
Image1.Picture.Bitmap.Assign(bmp);
finally
bmp.Free;
end;
finally
Socket.Data := nil;
Stream.Free;
end;
end;
uses
..., System.Math, Winapi.WinSock;
function SendRaw(Sckt: TSocket; const Data; Size: Integer);
var
P: PByte;
BytesSent: Integer;
begin
Result := 0;
P := PByte(#Data);
while Size > 0 do
begin
BytesSent := send(Sckt, P^, Size, 0);
if BytesSent = -1 then Exit;
Inc(P, BytesSent);
Dec(Size, BytesSent);
Inc(Result, BytesSent);
end;
end;
procedure WriteToSocket(Socket: TCustomWinSocket; const Data; Size: Integer);
var
Stream: TMemoryStream;
P: PByte;
BytesSent: Integer;
begin
if Size <= 0 then Exit;
Stream := TMemoryStream(Socket.Data);
P := PByte(#Data);
if not ((Stream <> nil) and (Stream.Size > 0)) then
begin
BytesSent := SendRaw(Socket.SocketHandle, P^, Size);
if BytesSent > 0 then
begin
Dec(Size, BytesSent);
if Size = 0 then Exit;
Inc(P, BytesSent);
end;
end;
if Stream = nil then
begin
Stream := TMemoryStream.Create;
Socket.Data := Stream;
end else
Stream.Seek(soEnd, 0);
Stream.WriteBuffer(P^, Size);
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := nil;
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
if Socket.Data <> nil then
TMemoryStream(Socket.Data).Free;
end;
procedure TForm1.ClientSocket1Write(Sender: TObject; Socket: TCustomWinSocket);
var
Stream: TMemoryStream;
BytesRemaining: Int64;
ChunkSize: Integer;
P: PByte;
begin
Stream := TMemoryStream(Socket.Data);
if Stream = nil then Exit;
BytesRemaining := Stream.Size;
if BytesRemaining = 0 then Exit;
P := PByte(Stream.Memory);
repeat
ChunkSize := Integer(Math.Min(BytesRemaining, MaxInt));
BytesSent := SendRaw(Socket.SocketHandle, P^, ChunkSize);
if BytesSent > 0 then
begin
Inc(P, BytesSent);
Dec(BytesRemaining, BytesSent);
end;
until (BytesSent < ChunkSize) or (BytesRemaining = 0);
if BytesRemaining = 0 then
Stream.Clear
else if P > Stream.Memory then
begin
MoveMemory(Stream.Memory, P, BytesRemaining);
Stream.Size := BytesRemaining;
end;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
Stream: TMemoryStream;
bmp: TBitmap;
StreamSize, TempSize: Int32;
begin
...
Stream := TMemoryStream.Create;
try
// saving the bitmap image
bmp := TBitmap.Create;
try
CaptureImage(bmp);
bmp.SaveToStream(Stream);
finally
bmp.Free;
end;
// sending the TBitmap image
StreamSize := Stream.Size;
TempSize := htonl(StreamSize);
WriteToSocket(Socket, TempSize, sizeof(TempSize));
WriteToSocket(Socket, Stream.Memory^, StreamSize);
finally
Stream.Free;
end;
end;

how do I disconnect inactive clients with TIdTCPServer?

I am trying to disconnect inactive clients that are connected to TIdTCPServer, whether those clients are disconnected from their Internet or for a period of inactive time.
I tried to set timeouts in the OnConnect event like the following:
procedure TservForm.TcpServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.ReadTimeout := 26000;
AContext.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 15000);
end;
But it seems a disconnect is not triggered after the client connection is lost.
I tried to use SetKeepAliveValues(), but it takes too much time to get an inactive client disconnected.
Is there a more helpful way to disconnect inactive clients? So if the client did not receive or send anything, for example in 30 seconds, the server will disconnect it?
on execute event
procedure TservForm.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
cmd: String;
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
S: String;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
IndyTextEncoding_UTF8);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := true;
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
end;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
OutboundCmds.Objects[I].Free;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
Exit;
end;
end;
cmd := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);
...............
...............
The client does not disconnect because the ReadLn() is not reached during idle times, so the ReadTimeout does not have effect, and if you are not sending a lot of commands then the socket buffer is not filling up so SO_SNDTIMEO does not have an effect, either.
Since you are already doing some manual timeout handling, you can expand on it to handle an idle timeout as well, eg:
type
TConnection = class(TIdServerContext)
...
public
LastSendRecv: LongWord;
...
end;
...
procedure TservForm.TcpServerConnect(AContext: TIdContext);
var
Connection: TConnection;
begin
Connection := AContext as TConnection;
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := True;
AContext.Connection.IOHandler.ReadTimeout := 30000;
AContext.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDTIMEO, 15000);
Connection.LastSendRecv := Ticks;
end;
procedure TservForm.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
cmd: String;
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
S: String;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
Connection.LastSendRecv := Ticks;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
OutboundCmds.Objects[I].Free;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if GetTickDiff(Connection.LastSendRecv, Ticks) >= 30000 then
AContext.Connection.Disconnect;
Exit;
end;
end;
cmd := AContext.Connection.Socket.ReadLn;
Connection.LastSendRecv := Ticks;
...
end;

Multi-Byte Character Support over TServerSocket Delphi

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:
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;
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.
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;

Sending a Dynamic array (Inside a record) through Socket?

i'm trying to transfer a record from server to client, directly using .SendBuf().
however, this record has a member which is a dynamic array, and i have read somewhere (here in SOF) that when sending records, the members must be STATIC (fixed-length), but the problem is... i cannot determine how many arguments i would send (in the future).
how can i solve this problem ?
procedure TServerClass.SendBufToSocket(const vmName: TVMNames; const vmArgs: Array of TValue);
var
// this record is sent to client
// vmName = method to be called [in]
// vmArgs = Argument for the method [in, optional]
BufRec: packed record
vmName: array[0..49] of char;
vmArgs: Array of TValue;
end;
s: string;
i: integer;
begin
// convert enum method name to string
s:= GetEnumName(TypeInfo(TVMNames), Integer(vmName));
// copy method name to record
lstrcpy(BufRec.vmName, pChar(s));
// copy arg array to record
SetLength(BufRec.vmArgs, length(vmArgs));
for i:=0 to high(vmArgs)
do BufRec.vmArgs[i] := vmArgs[i];
// send record
ServerSocket.Socket.Connections[idxSocket].SendBuf(PByte(#BufRec)^, SizeOf(BufRec));
end;
I found out from where i've read it, here:
ReceiveBuf from TCustomWinSocket won't work with dynamic arrays for the buffer
You will not be able to send the record as-is, so in fact you don't even need to use a record at all. You must serialize your data into a flat format that is suitable for transmission over a network. For example, when sending a string, send the string length before sending the string data. Likewise, when sending an array, send the array length before sending the array items. As for the items themselves, since TValue is dynamic, you have to serialize it into a flat format as well.
Try something like this on the sending side:
procedure TServerClass.SendBufToSocket(const vmName: TVMNames; const vmArgs: Array of TValue);
var
I: integer;
procedure SendRaw(Data: Pointer; DataLen: Integer);
var
DataPtr: PByte;
Socket: TCustomWinSocket;
Sent, Err: Integer;
begin
DataPtr := PByte(Data);
Socket := ServerSocket.Socket.Connections[idxSocket];
while DataLen > 0 do
begin
Sent := Socket.SendBuf(DataPtr^, DataLen);
if Sent > 0 then
begin
Inc(DataPtr, Sent);
Dec(DataLen, Sent)
end else
begin
Err := WSAGetLastError();
if Err <> WSAEWOULDBLOCK then
raise Exception.CreateFmt('Unable to sent data. Error: %d', [Err]);
Sleep(10);
end;
end;
end;
procedure SendInteger(Value: Integer);
begin
Value := htonl(Value);
SendRaw(#Value, SizeOf(Value));
end;
procedure SendString(const Value: String);
var
S: UTF8string;
Len: Integer;
begin
S := Value;
Len := Length(S);
SendInteger(Len);
SendRaw(PAnsiChar(S), Len);
end;
begin
SendString(GetEnumName(TypeInfo(TVMNames), Integer(vmName)));
SendInteger(Length(vmArgs));
for I := Low(vmArgs) to High(vmArgs) do
SendString(vmArgs[I].ToString);
end;
And then on the receiving side:
type
TValueArray := array of TValue;
procedure TServerClass.ReadBufFromSocket(var vmName: TVMNames; var vmArgs: TValueArray);
var
Cnt, I: integer;
Tmp: String;
procedure ReadRaw(Data: Pointer; DataLen: Integer);
var
DataPtr: PByte;
Socket: TCustomWinSocket;
Read, Err: Integer;
begin
DataPtr := PByte(Data);
Socket := ClientSocket.Socket;
while DataLen > 0 do
begin
Read := Socket.ReceiveBuf(DataPtr^, DataLen);
if Read > 0 then
begin
Inc(DataPtr, Read);
Dec(DataLen, Read);
end
else if Read = 0 then
begin
raise Exception.Create('Disconnected');
end else
begin
Err := WSAGetLastError();
if Err <> WSAEWOULDBLOCK then
raise Exception.CreateFmt('Unable to read data. Error: %d', [Err]);
Sleep(10);
end;
end;
end;
function ReadInteger: Integer;
begin
ReadRaw(#Result, SizeOf(Result));
Result := ntohl(Result);
end;
function ReadString: String;
var
S: UTF8String;
Len: Integer;
begin
Len := ReadInteger;
SetLength(S, Len);
ReadRaw(PAnsiChar(S), Len);
Result := S;
end;
begin
vmName := TVMNames(GetEnumValue(TypeInfo(TVMNames), ReadString));
Cnt := ReadInteger;
SetLength(vmArgs, Cnt);
for I := 0 to Cnt-1 do
begin
Tmp := ReadString;
// convert to TValue as needed...
vmArgs[I] := ...;
end;
end;
With that said, note that socket programming is more complex than this simple example shows. You have to do proper error handling. You have to account for partial data sends and receives. And if you are using non-blocking sockets, if the socket enters a blocking state then you have to wait for it to enter a readable/writable state again before you can attempt to read/write data that is still pending. You are not doing any of that yet. You need to get yourself a good book on effective socket programming.
Update: if you are trying to utilize the OnRead and OnWrite events of the socket components, you have to take a different approach:
procedure TServerClass.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TMemoryStream.Create;
end;
procedure TServerClass.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TMemoryStream(Socket.Data).Free;
Socket.Data := nil;
end;
procedure TServerClass.ClientWrite(Sender: TObject; Socket: TCustomWinSocket);
var
OutBuffer: TMemoryStream;
Ptr: PByte;
Sent, Len: Integer;
begin
OutBufer := TMemoryStream(Socket.Data);
if OutBuffer.Size = 0 then Exit;
OutBuffer.Position := 0;
Ptr := PByte(OutBuffer.Memory);
Len := OutBuffer.Size - OutBuffer.Position;
while Len > 0 do
begin
Sent := Socket.SendBuf(Ptr^, Len);
if Sent <= 0 then Break;
Inc(Ptr, Sent);
Dec(Len, Sent)
end;
if OutBuffer.Position > 0 then
begin
if OutBuffer.Position >= OutBuffer.Size then
OutBuffer.Clear
else
begin
Move(Ptr^, OutBuffer.Memory^, Len);
OutBuffer.Size := Len;
end;
end;
end;
procedure TServerClass.SendBufToSocket(const vmName: TVMNames; const vmArgs: Array of TValue);
var
I: integer;
Socket: TCustomWinSocket;
OutBuffer: TMemoryStream;
procedure SendRaw(Data: Pointer; DataLen: Integer);
var
DataPtr: PByte;
Sent: Integer;
begin
if DataLen < 1 then Exit;
DataPtr := PByte(Data);
if OutBuffer.Size = 0 then
begin
repeat
Sent := Socket.SendBuf(DataPtr^, DataLen);
if Sent < 1 then Break;
Inc(DataPtr, Sent);
Dec(DataLen, Sent)
until DataLen < 1;
end;
if DataLen > 0 then
begin
OutBuffer.Seek(0, soEnd);
OutBuffer.WriteBuffer(DataPtr^, DataLen);
end;
end;
procedure SendInteger(Value: Integer);
begin
Value := htonl(Value);
SendRaw(#Value, SizeOf(Value));
end;
procedure SendString(const Value: String);
var
S: UTF8string;
Len: Integer;
begin
S := Value;
Len := Length(S);
SendInteger(Len);
SendRaw(PAnsiChar(S), Len);
end;
begin
Socket := ServerSocket.Socket.Connections[idxSocket];
OutBuffer := TMemoryStream(Socket.Data);
SendString(GetEnumName(TypeInfo(TVMNames), Integer(vmName)));
SendInteger(Length(vmArgs));
for I := Low(vmArgs) to High(vmArgs) do
SendString(vmArgs[I].ToString);
end;
And then on the receiving side:
procedure TServerClass.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.Data := TMemoryStream.Create;
end;
procedure TServerClass.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
TMemoryStream(Socket.Data).Free;
Socket.Data := nil;
end;
procedure TServerClass.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
InBuffer: TMemoryStream;
Ptr: PByte;
OldSize, Pos, Read: Integer;
function HasAvailable(DataLen: Integer): Boolean;
being
Result := (InBuffer.Size - InBuffer.Position) >= DataLen;
end;
function ReadInteger(var Value: Integer);
begin
Result := False;
if HasAvailable(SizeOf(Integer)) then
begin
InBuffer.ReadBuffer(Value, SizeOf(Integer));
Value := ntohl(Value);
Result := True;
end;
end;
function ReadString(var Value: String);
var
S: UTF8String;
Len: Integer;
begin
Result := False;
if not ReadInteger(Len) then Exit;
if not HasAvailable(Len) then Exit;
SetLength(S, Len);
InBuffer.ReadBuffer(PAnsiChar(S)^, Len);
Value := S;
Result := True;
end;
function ReadNames: Boolean;
var
S: String;
vmName: TVMNames;
vmArgs: TValueArray;
begin
Result := False;
if not ReadString(S) then Exit;
vmName := TVMNames(GetEnumValue(TypeInfo(TVMNames), S));
if not ReadInteger(Cnt) then Exit;
SetLength(vmArgs, Cnt);
for I := 0 to Cnt-1 do
begin
if not ReadString(S) then Exit;
// convert to TValue as needed...
vmArgs[I] := ...;
end;
// use vmArgs as needed...
Result := True;
end;
begin
InBuffer := TMemoryStream(Socket.Data);
Read := Socket.ReceiveLength;
if Read <= 0 then Exit;
OldSize := InBuffer.Size;
InBuffer.Size := OldSize + Read;
try
Ptr := PByte(InBuffer.Memory);
Inc(Ptr, OldSize);
Read := Socket.ReceiveBuf(Ptr^, Read);
except
Read := -1;
end;
if Read < 0 then Read := 0;
InBuffer.Size := OldSize + Read;
if Read = 0 then Exit;
InBuffer.Position := 0;
repeat
Pos := InBuffer.Position;
until not ReadNames;
InBuffer.Position := Pos;
Read := InBuffer.Size - InBuffer.Position;
if Read < 1 then
InBuffer.Clear
else
begin
Ptr := PByte(InBuffer.Memory);
Inc(Ptr, InBuffer.Position);
Move(Ptr^, InBuffer.Memory^, Read);
InBuffer.Size := Read;
end;
end;
As mentioned in some comments, serialize your record to a stream and then send the stream contents over the wire. I use kbLib in some of my projects and it works really good.
You can use any dynamic type like strings, arrays in your record.
Small example:
type
TMyRecord = record
str : string;
end;
procedure Test;
var
FStream : TMemoryStream;
MYrecord : TMyRecord;
MYrecord1 : TMyRecord;
begin
FStream := TMemoryStream.Create;
try
MyRecord.Str := 'hello world';
// save record to stream
TKBDynamic.WriteTo(FStream, MyRecord, TypeInfo(TMyRecord));
FStream.Position := 0;
// read record from stream
TKBDynamic.ReadFrom(FStream, MyRecord1, TypeInfo(TMyRecord));
If MyRecord1.Str <> MyRecord.Str then
ShowMessage('this should not happen!');
finally
FStream.Free;
end;
end;

Why doesn't TCusomWinSocket.ReceiveBuf ever return 0?

When it comes to sockets, TClientSocket and TServerSockets are my favourite because of their simple usage.
My task is very simple. I need to send a file (RAW) through these 2 components, so I have 2 routines like the ones below:
procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
var
MSCli : TMemoryStream;
cnt : Integer;
buf : array [0..1023] of byte;
begin
MSCli := TMemoryStream.Create;
try
repeat
cnt := Socket.ReceiveBuf(buf[0], 1024); //This loop repeats endlesly
MSCli.Write(buf[0], cnt)
until cnt = 0;
finally
MSCli.SaveToFile('somefile.dmp');
MSCli.Free;
end;
end;
And of course the sender :
//...some code
MSSErv.LoadFromFile('some file');
MSServ.Position := 0;
Socket.SendStream(MSServ);
end;
The loop in the reader is repeating endelessly and I don't know why. What could be the source of the problem?
SendStream() is not a particularly good choice to use - EVER. It is intended to send the entire TStream and then free it when finished. However, if the socket is set to non-blocking mode and the socket blocks during sending, SendStream() exits immediately and DOES NOT free the TStream. You have to call SendStream() again to continue sending the TStream from where SendStream() left off. But there are other conditions that can cause SendStream() to exit AND free the TStream, and you don't really know when it did or did not free the TStream, so it becomes very dangerous to try to call SendStream() again with the same TStream object. A much safer approach is to avoid SendStream() at all costs and call SendBuf() directly in your own loop instead.
With that said, SendStream() does not inform the receiver how many bytes will be sent, so the receiver does not know when to stop reading (unless you close the connection after sending the TStream). A better choice is to send the intended byte count before then sending the TStream data. That way, the receiver can read the byte count first, then stop reading when the specified number of bytes have been received. For example:
procedure ReadRawFromSocket(Socket: TCustomWinSocket; Buffer: Pointer; BufSize: Integer);
var
buf: PByte;
cnt: Integer;
begin
buf := PByte(Buffer);
while BufSize > 0 do
begin
cnt := Socket.ReceiveBuf(buf^, BufSize);
if cnt < 1 then begin
if (cnt = -1) and (WSAGetLastError() = WSAEWOULDBLOCK) then
begin
Application.ProcessMessages;
Continue;
end;
Abort;
end;
Inc(buf, cnt);
Dec(BufSize, cnt);
end;
end;
function ReadInt64FromSocket(Socket: TCustomWinSocket): Int64;
begin
ReadRawFromSocket(Socket, #Result, SizeOf(Int64));
end;
procedure ReadMemStreamFromSocket(Socket: TCustomWinSocket: Stream: TMemoryStream);
var
cnt: Int64;
begin
cnt := ReadInt64FromSocket(Socket);
if cnt > 0 then
begin
Stream.Size := cnt;
ReadRawFromSocket(Socket, Stream.Memory, cnt);
end;
end;
procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
var
MSCli : TMemoryStream;
begin
MSCli := TMemoryStream.Create;
try
ReadMemStreamFromSocket(Socket, MSCli);
MSCli.SaveToFile('somefile.dmp');
finally
MSCli.Free;
end;
end;
procedure SendRawToSocket(Socket: TCustomWinSocket; Buffer: Pointer; BufSize: Integer);
var
buf: PByte;
cnt: Integer;
begin
buf := PByte(Buffer);
while BufSize > 0 do
begin
cnt := Socket.SendBuf(buf^, BufSize);
if cnt < 1 then begin
if (cnt = -1) and (WSAGetLastError() = WSAEWOULDBLOCK) then
begin
Application.ProcessMessages;
Continue;
end;
Abort;
end;
Inc(buf, cnt);
Dec(BufSize, cnt);
end;
end;
procedure SendInt64ToSocket(Socket: TCustomWinSocket; Value: Int64);
begin
SendRawToSocket(Socket, #Value, SizeOf(Int64));
end;
procedure SendMemStreamToSocket(Socket: TCustomWinSocket: Stream: TMemoryStream);
begin
SendInt64FromSocket(Socket, Stream.Size);
SendRawToSocket(Socket, Stream.Memory, Stream.Size);
end;
begin
...
MSSErv.LoadFromFile('some file');
MSServ.Position := 0;
SendMemStreamToSocket(Socket, MSServ);
...
end;

Resources