VirtualTreeView 使用 Threads 添加根



我想用这样的线程将根添加到 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 服务器的所有连接添加到树视图。Indy的onexecute/onconnect get被称为线程。因此,如果同时进入 3+ 个连接,则应用程序会因树视图而崩溃。如果客户端断开连接并且我想删除节点也是如此。

我正在使用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;

它与列表视图一起工作(至少更好)。

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

服务器:

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.

正如您所评论的,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; 

由于 GUI 在主线程上运行,因此您不能(应该)直接从自己的线程访问它。您应该编写自己的 TThread 类,然后使用 Sycnhronize 来处理 UI 调用。

最新更新