Search code examples
delphidelphi-7indyvirtualtreeviewindy-9

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.

Solution

  • 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;