VirtualTreeView使用线程添加根 [英] VirtualTreeView add roots with Threads
问题描述
我想将根添加到VirtualTreeView http://www .delphi-gems.com/index.php/controls/virtual-treeview ,带有这样的线程:
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;
这样做的原因是我想将所有连接都从INDY服务器添加到TreeView. Indy的onexecute/onconnect get被称为线程.因此,如果同时有3个以上的连接进入,则应用程序由于TreeView而崩溃.如果客户端断开连接并且我要删除节点,也是如此.
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.
我正在使用Delphi7和Indy9
I am using Delphi7 and Indy9
任何想法如何解决该问题?
Any Idea how to fix that?
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一起正常工作(至少更好).
It works fine with ListView (at least better).
这是我的完整代码:
服务器:
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
(异步)类,例如:
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;
这篇关于VirtualTreeView使用线程添加根的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!