Delphi - 使用Listview管理Indy TCPServer连接

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属性,但是当它未指向a 开始时,您将转换TListItem.Data为.TIdContextTIdContext

在有机会更新之前,您还应考虑客户端可能已断开连接的情况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;