Delphi - Manage Indy TCPServer connections with a Listview

Question

I need to send a string message from IdTCPServer to a specific connected IdTCPClient. In the beginning I was using a Listbox, so I added the hostname to the listbox when client connected and remove when disconnect. At that time, Remy Lebeau give me this tip:

procedure TfrmMain.sendButtonClick(Sender: TObject);
var
  Index: Integer;
  Ctx: TIdContext;
begin
  Index := ListBox.ItemIndex;
  if Index = -1 then Exit;
  Context := TIdContext(ListBox.Items.Objects[Index]);
  // use Context as needed...
end;

But now I am using a Listview, with pre-added hostnames. So I just change the listbox item image status when clients connect or disconnect. Now I am trying something like this:

procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    var
      Host: String;
      LItem: TListItem;
    begin
      Host := UpperCase(GStack.HostByAddress(Ctxt.Binding.PeerIP));
      LItem := lvwPCList.FindCaption(0, Host, False, True, False);
      if (LItem <> nil) then LItem.Data := AContext.Data;
    end
  );
end;

And once I linked the Listview Item with the Context data, I am trying to send the message direct to client:

procedure TfrmMain.SendMessage(const Item: TListItem; const Msg: String);
var
  Ctx: TIdContext;
begin
  if (Trim(Msg) = '') then Exit;
  Ctx := TIdContext(Item.Data);
  try
    Ctx.Connection.IOHandler.WriteLn(Msg);
  except
  end;
end;

SendMessage(Listview.Selected, 'test');

I can compile this code, but the message never reachs client. Please, what I am doing wrong?

Thanks!

Answer 1

You are assigning the value of the TIdContext.Data property to the TListItem.Data property, but you are casting TListItem.Data to TIdContext when it is not pointing at a TIdContext to begin with.

You should also take into account the condition that a client may have disconnected before you have a chance to update the TListView.

Try something more like this instead:

procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
  LHost: string;
begin
  LHost := UpperCase(GStack.HostByAddress(AContext.Binding.PeerIP));
  TThread.Queue(nil,
    procedure
    var
      LItem: TListItem;
    begin
      LItem := lvwPCList.FindCaption(0, LHost, False, True, False);
      if (LItem <> nil) then LItem.Data := AContext;
    end
  );
end;

procedure TfrmMain.TCPServerDisconnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    var
      LItem: TListItem;
    begin
      LItem := lvwPCList.FindData(0, AContext, True, False);
      if (LItem <> nil) then LItem.Data := nil;
    end
  );
end;

procedure TfrmMain.SendMessage(const Item: TListItem; const Msg: String);
var
  Ctx: TIdContext;
  List: TIdContextList;
begin
  if (Item = nil) then Exit;
  Ctx := TIdContext(Item.Data);
  if (Ctx = nil) then Exit;
  if (Trim(Msg) = '') then Exit;
  try
    List := TCPServer.Contexts.LockList;
    try
      if List.IndexOf(Ctx) <> -1 then
        Ctx.Connection.IOHandler.WriteLn(Msg);
    finally
      TCPServer.Contexts.UnlockList;
    end;
  except
  end;
end;

SendMessage(Listview.Selected, 'test');

That being said, depending on how your communication protocol is actually implemented, you probably should not be calling WriteLn() outside of the TIdTCPServer.OnExecute event, otherwise you risk corrupting any data that OnExecute may be writing at the same time that the main thread is trying to write. If this is the case, then you should implement a per-client queue of outbound data any have the OnExecute event send that data when it is safe to do so, eg:

uses
  ..., IdThreadSafe;

type
  TMyContext = class(TIdServerContext)
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
    Queue: TIdThreadSafeStringList;
  end;

constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  Queue := TIdThreadSafeStringList.Create;
end;

destructor TMyContext.Destroy;
begin
  Queue.Free;
  inherited;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  TCPServer.ContextClass := TMyContext;
end;

procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
  LHost: string;
begin
  LHost := UpperCase(GStack.HostByAddress(AContext.Binding.PeerIP));
  TThread.Queue(nil,
    procedure
    var
      LItem: TListItem;
    begin
      LItem := lvwPCList.FindCaption(0, LHost, False, True, False);
      if (LItem <> nil) then LItem.Data := AContext;
    end
  );
end;

procedure TfrmMain.TCPServerDisconnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    var
      LItem: TListItem;
    begin
      LItem := lvwPCList.FindData(0, AContext, True, False);
      if (LItem <> nil) then LItem.Data := nil;
    end
  );
end;

procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
  Ctx: TMyContext;
  Queue: TStringList;
  List: TStringList;
begin
  ...
  Ctx := TMyContext(AContext);
  List := nil;
  try
    Queue := Ctx.Queue.Lock;
    try
      if Queue.Count > 0 then
      begin
        List := TStringList.Create;
        List.Assign(Queue);
        Queue.Clear;
      end;
    finally
      Ctx.Queue.Unlock;
    end;
    if List <> nil then
    AContext.Connection.IOHandler.Write(List);
  finally
    List.Free;
  end;
  ...
end;

procedure TfrmMain.SendMessage(const Item: TListItem; const Msg: String);
var
  Ctx: TIdContext;
  List: TIdContextList;
begin
  if (Item = nil) then Exit;
  Ctx := TIdContext(Item.Data);
  if (Ctx = nil) then Exit;
  if (Trim(Msg) = '') then Exit;
  try
    List := TCPServer.Contexts.LockList;
    try
      if List.IndexOf(Ctx) <> -1 then
        TMyContext(Ctx).Queue.Add(Msg);
    finally
      TCPServer.Contexts.UnlockList;
    end;
  except
  end;
end;