Delphi - Manage Indy TCPServer connections with a Listview - delphi

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;

Answer 2

In your listbox code you appear to be storing TIdContext references in your item "object" slots:
Context := TIdContext(ListBox.Items.Objects[Index]);
But in your listview code you are storing the Data member of a TIdContext, which you are then incorrectly casting as a TIdContext in your SendMessage() method:
// In TCPServerConnect():
if (LItem <> nil) then LItem.Data := AContext.Data;
...
// In SendMessage():
Ctx := TIdContext(Item.Data); // But Item.Data doesn't hold a TIdContext!!!
For direct equivalence with your listbox code, that first line in your TCPServerConnect method should be:
if (LItem <> nil) then LItem.Data := AContext;