VirtualTreeView add roots with Threads

问题

I would like to add roots to a VirtualTreeView http://www.delphi-gems.com/index.php/controls/virtual-treeview with a thread like this:

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;

The reason for this is that I want to add all connections from my INDY Server to the TreeView. Indy's onexecute/onconnect get's called as a thread. So if 3+ connections come in at the same time the app crashes due to the TreeView. Same is if a client gets disconnected and I want to delete the Node.

I am using Delphi7 and Indy9

Any Idea how to fix that?

EDIT:

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;

It works fine with ListView (at least better).

EDIT: Here is my full code:

Server:

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.

Client (Stresser):

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.

回答1:

As you commented, TIdTCPServer is a multithreaded component. You must synchronize with the main thread in order to access the UI safely from the TIdTCPServer events. You can use Indy's own TIdSync (synchronous) or TIdNotify (asynchronous) class for that purpose, eg:

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; 

Update: Based on new info, I would do something more like this instead:

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; 

回答2:

Since the GUI runs on the main thread you can (should) not directly access it from your own thread. You should write your own TThread class and then use Sycnhronize to handle UI calls.

来源：https://stackoverflow.com/questions/11285593/virtualtreeview-add-roots-with-threads