Search code examples
delphiindy

Client/Server application

I am writing a client / server application. There is one server and several clients.

When connecting a client, the task is to add its IP address to the ListBox, and when disconnecting the client, remove it from the ListBox. Then exchange messages between the client and server.

Three questions arose: when a client connects, its IP address is added to the ListBox, but when disconnected, it is not deleted from there, here is the code:

type
  TSimpleClient = class(TObject)
    DNS,
    Name        : String;
    ListLink    : Integer;
    Thread      : Pointer;
  end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient.Create;
  Client.DNS := AContext.Connection.Socket.Binding.PeerIP;
  Client.ListLink := ListBox1.Items.Count;
  Client.Thread := AContext;
  ListBox1.Items.Add(Client.DNS);
  AContext.Data := Client;
  Clients.Add(Client);
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  sleep(2000);
  Client :=Pointer (AContext.Data);
  Clients.Delete(Client.ListLink);
  ListBox1.Items.Delete(ListBox1.Items.IndexOf(Client.DNS));
  Client.Free;
  AContext.Data := nil;
end;

The second question, when exchanging messages, the letters in Cyrillic are given as "???", all Google went through it and it was not possible to find an error.

And the third question, on the client is a timer that listens to messages from the server, when the timer is turned on, the client application hangs tight, putting all this into the stream is the same trouble, the code:

if not IdTCPClient1.Connected then
  Exit;
s := IdTCPClient1.Socket.ReadLn;
if s <> '' then
  Label1.Text := s;
Solution

  • I see quite a few problems with your code.

    On the server side, you need to get rid of the TSimpleClient.ListLink field. You are misusing it, causing bad behaviors in your code since you don't keep it updated as clients are added/removed. Think of what happens when you have 2 clients connected, where ListLink is 0 and 1 respectively, and then the 1st client disconnects. The ListLink for the 2nd client will become invalid since you don't decrement it from 1 to 0.

    Also TIdTCPServer is a multi-threaded component, its events are fired in the context of worker threads, but your event handler code is not thread-safe. You MUST synchronize with the main UI thread when accessing UI controls from worker threads, and you MUST protect your Clients list from concurrent access across thread boundaries. In this case, you don't really need your own Clients list to begin with as TIdTCPServer has its own thread-safe Contexts list that you can use to access the connected clients.

    You are also not handling Unicode at all. By default, Indy's default byte encoding for Unicode strings is US-ASCII, which is why you are getting ? for non-ASCII characters. You can use the IOHandler's DefStringEncoding property to set a different byte encoding, such as IndyTextEncoding_UTF8 (if you are using Delphi 2007 or earlier, you might need to also use the IOHandler's DefAnsiEncoding property to specify how your ANSI strings are converted to/from Unicode. By default, it is set to IndyTextEncoding_OSDefault).

    Try something more like this:

    type
  TSimpleClient = class(TObject)
    DNS,
    Name            : String;
    Thread          : Pointer;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create;
begin
  inherited;
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      TIdContext(Thread).Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient.Create;
  Client.DNS := PeerIP;
  Client.Thread := AContext;
  AContext.Data := Client;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);
  try
    TThread.Queue(nil,
      procedure
      var
        Index: Integer;
      begin
        Index := ListBox1.Items.IndexOfObject(Client);
        if Index <> -1 then
          ListBox1.Items.Delete(Index);
      end;
    );
  finally
    { The anonymous procedure being passed to TThread.Queue() above captures
      the Client variable itself, not its value.  On ARC platforms, we need to
      prevent Free() setting the variable to nil before it can be passed to
      IndexOfObject(), and also because IndexOfObject() expects a live object
      anyway. ARC will free the object when the anonymous procedure exits. On
      non-ARC platforms, it is OK to Free() the object here, the variable will
      not change value, and IndexOfObject() does not need a live object... }
    {$IFNDEF AUTOREFCOUNT}
    Client.Free;
    {$ENDIF}
    AContext.Data := nil;
  end;
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext.Data);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client.Thread)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

    Alternatively, you can derive TSimpleClient from TIdServerContext and get rid of the Thread field altogether:

    type
  TSimpleClient = class(TIdServerContext)
    DNS,
    Name            : String;
    OutgoingMsgs    : TIdThreadSafeStringList;
    HasOutgoingMsgs : Boolean;

    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;

    procedure Queue(const Msg: string);
    procedure FlushMsgs;
  end;

constructor TSimpleClient.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  OutgoingMsgs := TIdThreadSafeStringList.Create;
end;

destructor TSimpleClient.Destroy;
begin
  OutgoingMsgs.Free;
  inherited;
end;

procedure TSimpleClient.Queue(const Msg: string);
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    List.Add(Msg);
    HasOutgoingMsgs := True;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TSimpleClient.FlushMsgs;
var
  List: TStringList;
begin
  List := OutgoingMsgs.Lock;
  try
    while List.Count > 0 do
    begin
      Self.Connection.IOHandler.WriteLn(List[0]);
      List.Delete(0);
    end;
    HasOutgoingMsgs := False;
  finally
    OutgoingMsgs.Unlock;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.ContextClass := TSimpleClient;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  Client: TSimpleClient;
begin
  PeerIP := AContext.Binding.PeerIP;

  Client := TSimpleClient(AContext);
  Client.DNS := PeerIP;

  TThread.Queue(nil,
    procedure
    begin
      ListBox1.Items.AddObject(PeerIP, Client);
    end
  );

  AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  Client := TSimpleClient(AContext);

  TThread.Queue(nil,
    procedure
    var
      Index: Integer;
    begin
      Index := ListBox1.Items.IndexOfObject(Client);
      if Index <> -1 then
        ListBox1.Items.Delete(Index);
    end;
  );
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Client: TSimpleClient;
begin
  Client := TSimpleClient(AContext);

  if Client.HasOutgoingMsgs then
    Client.FlushMsgs
  else
    Sleep(100);
end;

procedure TForm1.SendMessageToClient(Client: TSimpleClient; const Msg: string);
var
  List: TIdContextList;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    if List.IndexOf(TIdContext(Client)) <> -1 then // still connected?
      Client.Queue(Msg);
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Index: Integer;
  Msg: string;
  Client: TSimpleClient;
begin
  Index := ListBox1.ItemIndex;
  if Index = -1 then Exit;

  Msg := Edit1.Text;
  if Msg = '' then Exit;

  Client := TSimpleClient(ListBox1.Items.Objects[Index]);
  SendMessageToClient(Client, Msg);
end;

    On the client side, you are reading from the socket in the main UI thread, but Indy uses blocking sockets, and so its reading methods will block the calling thread until the requested data arrives. DON'T block the main UI thread! Read only if there is actually something available to read, or else move the reading into a separate worker thread. For example:

    IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
...
IdTCPClient1.Disconnect;

...

procedure TForm1.Timer1Timer(Sender: TObject);
var
  s: string;
begin
  if IdTCPClient1.Connected and (not IdTCPClient1.IOHandler.InputBufferIsEmpty) then
  begin
    s := IdTCPClient1.IOHandler.ReadLn;
    if s <> '' then
      Label1.Text := s;
  end;
end;

    Alternatively:

    type
  TReadingThread = class(TThread)
  protected
    procedure Execute; override;
  end;

procedure TReadingThread.Execute;
var
  s: String;
begin
  while not Terminated do
  begin
    s := Form1.IdTCPClient1.IOHandler.ReadLn;
    if s <> '' then
    begin
      TThread.Queue(nil,
        procedure
        begin
          Form1.Label1.Text := s;
        end
      );
    end;
  end;
end;

...

var
  ReadingThread: TReadingThread = nil;

...

IdTCPClient1.Connect;
IdTCPClient1.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
ReadingThread := TReadingThread.Create(False);
...
ReadingThread.Terminate;
try
  IdTCPClient1.Disconnect;
finally
  ReadingThread.WaitFor;
  ReadingThread.Free;
end;