delphi - VirtualTreeView 使用线程添加根

Question

我想将根添加到 VirtualTreeView http://www.delphi-gems.com/index.php/controls/virtual-treeview像这样的线程:

function AddRoot ( p : TForm1 ) : Integer; stdcall;
begin
 p.VirtualStringTree1.AddChild(NIL);
end;    

var
 Dummy : DWORD;
 i     : Integer;
begin
 for i := 0 to 2000 do begin
  CloseHandle(CreateThread(NIL,0, @ADDROOT, Self,0, Dummy));
 end;
end;

这样做的原因是我想将 INDY 服务器的所有连接添加到 TreeView。 Indy 的 onexecute/onconnect get 被作为线程调用。因此，如果同时出现 3 个以上的连接，应用程序会因 TreeView 而崩溃。同样的情况是，如果客户端断开连接并且我想删除节点。

我使用的是Delphi7和Indy9

知道如何解决这个问题吗？

编辑:

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin 
 VirtualStringTree1.DeleteNode(PVirtualNode(Athread.Data)); // For Disconnection(s)
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
 Athread.Data := TObject(VirtualStringTree1.AddChild(NIL)); // For Connection(s);
end;

它与 ListView 配合得很好(至少更好)。

编辑:这是我的完整代码:

服务器:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ComCtrls, IDSync, IdBaseComponent, IdComponent, IdTCPServer,
 VirtualTrees;

type
 TForm1 = class(TForm)
 IdTCPServer1: TIdTCPServer;
 VirtualStringTree1: TVirtualStringTree;
 procedure FormShow(Sender: TObject);
 procedure IdTCPServer1Connect(AThread: TIdPeerThread);
 procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
private
 { Private declarations }
public
 { Public declarations }
end;

type
 TAddRemoveNodeSync = class(TIdSync)
protected
 procedure DoSynchronize; override;
public
 Node   : PVirtualNode;
 Adding : Boolean;
end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TAddRemoveNodeSync.DoSynchronize;
begin
 if Adding then
  Node := Form1.VirtualStringTree1.AddChild(nil)
 else
  Form1.VirtualStringTree1.DeleteNode(Node);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 IDTCPServer1.DefaultPort := 8080;
 IDTCPServer1.Active      := TRUE;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
 with TAddRemoveNodeSync.Create do
  try
   Adding := True;
   Synchronize;
   AThread.Data := TObject(Node);
  finally
   Free;
 end;
end;

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
 with TAddRemoveNodeSync.Create do
  try
   Adding := False;
   Node := PVirtualNode(AThread.Data);
   Synchronize;
  finally
   Free;
   AThread.Data := nil;
  end;
end;

end.

客户(压力者):

program Project1;

{$APPTYPE CONSOLE}

uses
 SysUtils,
 Windows,
 Winsock;

Const
 // Connection Vars
 Port         = 8080;
 Host         = '127.0.0.1';
 StressDelay  = 1; // Miliseconds!

var 
 WSA          : TWSADATA;
 MainSocket   : TSocket;
 Addr         : TSockAddrIn;

begin
 if WSAStartup($0202, WSA) <> 0 then exit;
 Addr.sin_family      := AF_INET;
 Addr.sin_port        := htons(Port);
 Addr.sin_addr.S_addr := INET_ADDR(Host);
 while true do begin
  MainSocket           := Socket(AF_INET, SOCK_STREAM, 0);
  Connect(MainSocket, Addr, SizeOf(Addr));
  CloseSocket(MainSocket); // Disconnect!
  sleep (StressDelay); 
 end;
end.

Answer 1

正如您所评论的，TIdTCPServer 是一个多线程组件。您必须与主线程同步才能从 TIdTCPServer 事件安全地访问 UI。您可以使用 Indy 自己的 TIdSync (同步)或 TIdNotify (异步)类来实现此目的，例如:

type
  TAddRemoveNodeSync = class(TIdSync)
  protected
    procedure DoSynchronize; override;
  public
    Node: PVirtualNode; 
    Adding: Boolean;
  end;

procedure TAddRemoveNodeSync.DoSynchronize;
begin
  if Adding then
    Node := Form1.VirtualStringTree1.AddChild(nil)
  else
    Form1.VirtualStringTree1.DeleteNode(Node);
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread); 
begin 
  with TAddRemoveNodeSync.Create do
  try
    Adding := True;
    Synchronize;
    AThread.Data := TObject(Node);
  finally
    Free;
  end;
end; 

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread); 
begin 
  with TAddRemoveNodeSync.Create do
  try
    Adding := False;
    Node := PVirtualNode(AThread.Data);
    Synchronize;
  finally
    Free;
    AThread.Data := nil;
  end;
end; 

更新:根据新信息，我会做更多类似这样的事情:

type
  TAddRemoveClientNotify = class(TIdNotify)
  protected
    fAdding: Boolean;
    fIP, fPeerIP: string;
    fPort, fPeerPort: Integer;
    ...
  public
    constructor Create(AThread: TIdPeerThread; AAdding: Boolean); reintroduce;
    procedure DoNotify; override;
  end;

constructor TAddRemoveClientNotify.Create(AThread: TIdPeerThread; AAdding: Boolean);
begin
  inherited Create;
  fAdding := AAdding;
  with AThread.Connection.Socket.Binding do
  begin
    Self.fIP := IP;
    Self.fPeerIP := PeerIP;
    Self.fPort := Port;
    Self.fPeerPort := PeerPort;
  end;
end;

procedure TAddRemoveClientNotify.DoNotify;
var
  Node: PVirtualNode;
begin
  if fAdding then
  begin
    Node := Form1.VirtualStringTree1.AddChild(nil);
    // associate fIP, fPeerIP, fPort, fPeerPort with Node as needed...
  end else
  begin
    // find the Node that is associated with fIP, fPeerIP, fPort, fPeerPort as needed...
    Node := ...;
    if Node <> nil then
      Form1.VirtualStringTree1.DeleteNode(Node);
  end;
end;

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread); 
begin 
  TAddRemoveClientNotify.Create(AThread, True).Notify;
end; 

procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread); 
begin 
  TAddRemoveClientNotify.Create(AThread, False).Notify;
end;