Delphi - 使用 Listview 管理 Indy TCPServer 连接

Question

我需要从 IdTCPServer 向特定连接的 IdTCPClient 发送字符串消息。一开始我使用的是列表框，所以我在客户端连接时将主机名添加到列表框，并在断开连接时删除。当时，Remy Lebeau 给了我这个提示：

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;

但现在我使用的是 Listview，带有预先添加的主机名。所以我只是在客户端连接或断开连接时更改列表框项目图像状态。现在我正在尝试这样的事情：

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;

一旦我将 Listview 项与上下文数据链接起来，我就会尝试将消息直接发送给客户端：

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');

我可以编译这段代码，但消息永远不会到达客户端。请问，我做错了什么？

谢谢！

Answer 1

您正在将TIdContext.Data 属性的值分配给TListItem.Data 属性，但是您将TListItem.Data 转换为TIdContext，而它并没有指向TIdContext。

在您有机会更新TListView 之前，您还应该考虑到客户端可能已断开连接的情况。

试试类似的方法：

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');

话虽如此，根据您的通信协议的实际实现方式，您可能不应该在TIdTCPServer.OnExecute 事件之外调用WriteLn()，否则您可能会损坏OnExecute 可能同时写入的任何数据主线程尝试写入的时间。如果是这种情况，那么您应该实现每个客户端的出站数据队列，任何让OnExecute 事件在安全的情况下发送该数据，例如：

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

在您的列表框代码中，您似乎将 TIdContext 引用存储在您的项目“对象”插槽中：

Context := TIdContext(ListBox.Items.Objects[Index]);

但是在您的列表视图代码中，您存储了 TIdContext 的 Data 成员，然后您将其错误地转换为 TIdContext SendMessage() 方法：

  // In TCPServerConnect():

    if (LItem <> nil) then LItem.Data := AContext.Data;


  ...

  // In SendMessage():

    Ctx := TIdContext(Item.Data);    // But Item.Data doesn't hold a TIdContext!!!

为了与您的列表框代码直接等效，您的 TCPServerConnect 方法中的第一行应该是：

 if (LItem <> nil) then LItem.Data := AContext;