Question

我需要从IdTCPServer向特定连接的IdTCPClient发送一个字符串消息。一开始我使用的是Listbox，所以我在连接客户端时将主机名添加到列表框中，并在断开连接时删除。那时，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项目与Context数据相关联，我就会尝试将消息直接发送给客户端：

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未指向{{1}时，您将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');

话虽如此，根据您的通信协议的实际实现方式，您可能不应在WriteLn()事件之外调用TIdTCPServer.OnExecute，否则您可能会损坏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 引用＆＃34; object＆＃34;插槽：

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

但是在您的列表视图代码中，您存储了 TIdContext 的数据成员，然后您错误地将其强制转换为 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;

Delphi - 使用Listview管理Indy TCPServer连接

2 个答案: