Safe approach to achieve two-way communication with TIdTCPServer and TIdTCPClient
I am creating a client / server application where clients will only talk to one server (there is no communication between clients).
When I need to send a file from the server to the client, I will first send a string command to give the client a server request for the file.
Considering that the server will only talk to one client at a time, there is no communication between the clients and I have multiple clients connected (less than 50), the questions are:
- Is it possible to send a string message from server to client outside of the OnExecute event?
- Is my approach safe?
Server
//==============================================================================
// Server Execute procedure
//==============================================================================
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
Cmd: string;
Date: TDateTime;
Timestamp: string;
Stream: TMemoryStream;
begin
Cmd := AContext.Connection.IOHandler.ReadLn;
Date := Now;
Timestamp := FormatDateTime('yyyymmdd_hhmmss', Date);
if Cmd = 'send_file' then
begin
try
Stream := TMemoryStream.Create;
try
AContext.Connection.IOHandler.ReadStream(Stream, -1, False);
Stream.Position := 0;
Stream.SaveToFile(ExtractFilePath(Application.ExeName) +
'\recv_test' + Timestamp + '.dat');
except on E: Exception do
Log('Error loading file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end else if Cmd = 'recv_file' then
begin
try
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
AContext.Connection.IOHandler.WriteLn('send_file');
AContext.Connection.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end;
end;
//==============================================================================
// Server send file button
//==============================================================================
procedure TfrmMain.btnSendFileClick(Sender: TObject);
var
List: TList;
ip: string;
I: Integer;
Context: TIdContext;
Stream: TMemoryStream;
begin
// lvwPCList is a ListView on my form...
// Do I need to use TThread.Queue to safety access this component?
ip := GStack.ResolveHost(lvwPCList.Selected.Caption);
try
List := TCPServer.Contexts.LockList;
for I := 0 to List.Count - 1 do
begin
Context := TIdContext(List[I]);
if Context.Connection.Socket.Binding.PeerIP = ip then
begin
Context.Connection.IOHandler.WriteLn('send_file');
try
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
Context.Connection.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
Break;
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
//==============================================================================
// Server get file button
//==============================================================================
procedure TfrmMain.btnGetFileClick(Sender: TObject);
var
List: TList;
IP: string;
I: Integer;
Context: TIdContext;
begin
IP := GStack.ResolveHost(lvwPCList.Selected.Caption);
try
List := TCPServer.Contexts.LockList;
for I := 0 to List.Count - 1 do
begin
Context := TIdContext(List[I]);
if Context.Connection.Socket.Binding.PeerIP = IP then
begin
Context.Connection.IOHandler.WriteLn('recv_file');
// After send the string command 'recv_file', the server
// will receive the actual file sending by client on the execute event...
Break;
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
//==============================================================================
Client
//==============================================================================
procedure ThreadActionStart;
var
ThreadAction: TThreadAction;
begin
ThreadAction := TThreadAction.Create(True);
ThreadAction.FreeOnTerminate := True;
ThreadAction.Priority := tpNormal;
ThreadAction.Start;
end;
//==============================================================================
procedure TThreadAction.Execute;
var
Cmd: string;
Date: TDateTime;
Timestamp: string;
Stream: TMemoryStream;
begin
while frmMain.IdTCPClient.Connected do
begin
try
cmd := frmMain.IdTCPClient.IOHandler.ReadLn;
TThread.Queue( nil,
procedure
begin
frmMain.lstMessages.Items.Add(cmd);
end
);
Date := Now;
Timestamp := FormatDateTime('yyyymmdd_hhmmss', Date);
if Cmd = 'send_file' then
begin
try
Stream := TMemoryStream.Create;
try
frmMain.IdTCPClient.IOHandler.ReadStream(Stream, -1);
Stream.Position := 0;
Stream.SaveToFile(ExtractFilePath(Application.ExeName) +
'\recv_test' + Timestamp + '.dat');
except on E: Exception do
Log('Error loading file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end else if Cmd = 'recv_file' then
begin
try
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
frmMain.IdTCPClient.IOHandler.WriteLn('send_file');
frmMain.IdTCPClient.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end;
except
Log('Error reading from server');
end;
end;
end;
//==============================================================================
procedure TfrmMain.btnGetFileClick(Sender: TObject);
begin
frmMain.IdTCPClient.IOHandler.WriteLn('recv_file');
end;
//==============================================================================
procedure TfrmMain.btnSendFileClick(Sender: TObject);
var
Stream: TMemoryStream;
begin
try
frmMain.IdTCPClient.IOHandler.WriteLn('send_file');
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.dat');
Stream.Position := 0;
frmMain.IdTCPClient.IOHandler.Write(Stream, 0, True);
except on E: Exception do
Log('Error sending file: ' + E.ClassName + ' - ' + E.Message);
end;
finally
Stream.Free;
end;
end;
//==============================================================================
procedure TfrmMain.FormCreate(Sender: TObject);
begin
try
IdTCPClient.Host := '192.168.0.20';
IdTCPClient.Port := 4545;
IdTCPClient.Connect;
except
Log('Connection error');
end;
end;
//==============================================================================
procedure TfrmMain.IdTCPClientConnected(Sender: TObject);
begin
try
ThreadActionStart;
except
Log('Error - Thread not started');
end;
end;
//==============================================================================
Thanks in advance!
+3
source to share
No one has answered this question yet
Check out similar questions: