Delphi-使用Listview管理Indy TCPServer连接

我需要将字符串消息从IdTCPServer发送到特定连接的IdTCPClient。起初我使用的是一个列表框，所以我在客户端连接时将主机名添加到列表框中，在断开连接时将其删除。当时，雷米·勒博给了我这个提示：

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;

但是现在我使用的是一个列表视图，带有预先添加的主机名。因此，当客户端连接或断开连接时，我只需更改listbox项映像状态。现在我正在尝试这样的方法：

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;

我可以编译这段代码，但消息从未到达客户端。拜托，我做错了什么

---

谢谢

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

但在listview代码中，您正在存储TIdContext的数据成员，然后在SendMessage（）方法中将其错误地转换为TIdContext：

//在TCPServerConnect（）中：
如果为（LItem nil），则LItem.Data:=AContext.Data；
...
//在SendMessage（）中：
Ctx:=TIdContext（Item.Data）；//但是Item.Data不包含上下文！！！

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

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

if（LItem nil）那么LItem.Data:=AContext；

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

但在listview代码中，您正在存储TIdContext的数据成员，然后在SendMessage（）方法中将其错误地转换为TIdContext：

//在TCPServerConnect（）中：
如果为（LItem nil），则LItem.Data:=AContext.Data；
...
//在SendMessage（）中：
Ctx:=TIdContext（Item.Data）；//但是Item.Data不包含上下文！！！

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

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

if（LItem nil）那么LItem.Data:=AContext；

您正在将

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;

这就是说，根据通信协议的实际实现方式，您可能不应该在

TIdTCPServer.OnExecute

事件之外调用

WriteLn（）

，否则可能会损坏主线程尝试写入时正在写入的任何数据。如果是这种情况，则应实现每个客户端的出站数据队列，以便在安全的情况下让

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;

过程TfrmMain.FormCreate（发送方：TObject）；
开始
TCPServer.ContextClass:=TMyContext；
结束；
过程TfrmMain.TCPServerConnect（AContext:TIdContext）；
变量
LHost：字符串；
开始
LHost:=大写（GStack.HostByAddress（AContext.Binding.PeerIP））；
TThread.Queue（nil，
程序
变量
LItem:TListItem；
开始
LItem:=lvwPCList.FindCaption（0，LHost，False，True，False）；
如果为（LItem nil），则LItem.Data:=AContext；
结束
);
结束；
过程TfrmMain.TCPServerDisconnect（AContext:TIdContext）；
开始
TThread.Queue（nil，
程序
变量
LItem:TListItem；
开始
LItem:=lvwPCList.FindData（0，AContext，True，False）；
如果为（LItem nil），则LItem.Data:=nil；
结束
);
结束；
过程TfrmMain.TCPServerExecute（AContext:TIdContext）；
变量
Ctx:TMyContext；
队列：TStringList；
列表：TStringList；
开始
...
Ctx:=TMyContext（AContext）；
列表：=零；
尝试
队列：=Ctx.Queue.Lock；
尝试
如果Queue.Count>0，则
开始
列表：=TStringList.Create；
列表。分配（队列）；
排队，清除；
结束；
最后
Ctx.Queue.Unlock；
结束；
如果列表为零，则
AContext.Connection.IOHandler.Write（列表）；
最后
列表。免费；
结束；
...
结束；
过程TfrmMain.SendMessage（常量项：TListItem；常量消息：String）；
变量
Ctx:TIdContext；
列表：TIdContextList；
开始
如果（项目=无），则退出；
Ctx:=TIdContext（Item.Data）；
如果（Ctx=nil），则退出；
如果（微调（味精）=''，则退出；
尝试
列表：=TCPServer.Contexts.LockList；
尝试
如果List.IndexOf（Ctx）-1，则
TMyContext（Ctx）.Queue.Add（Msg）；
最后
TCPServer.Contexts.UnlockList；
结束；
除了
结束；
结束；

您正在将

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;

这就是说，根据通信协议的实际实现方式，您可能不应该在

TIdTCPServer.OnExecute

事件之外调用

WriteLn（）

，否则可能会损坏主线程尝试写入时正在写入的任何数据。如果是这种情况，则应实现每个客户端的出站数据队列，以便在安全的情况下让

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;

过程TfrmMain.FormCreate（发送方：TObject）；
开始
TCPServer.ContextClass:=TMyContext；
结束；
过程TfrmMain.TCPServerConnect（AContext:TIdContext）；
变量
主持人：斯特林
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;