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





All Articles