各位高手富翁,帮忙看看,多线程也能造成主界面死,什么原因? ( 积分: 50 )

  • 主题发起人 主题发起人 cqwty
  • 开始时间 开始时间
C

cqwty

Unregistered / Unconfirmed
GUEST, unregistred user!
第一次遇到这个问题,专门运行多线程主界面也会死,帮忙看看吧!
unit ConnThreadUnit;
interface
uses
Classes, Sockets, ExtCtrls, SysUtils, Windows;
var
CS:TRTLCriticalSection;
type
ConnThread = class(TThread)
private
{ Private declarations }
FTimer:TTimer;
FIPList:TStrings;
FTcpClient:TTcpClient;
procedure ontime(Sender: TObject);
procedure addinfo;
protected
procedure Execute;
override;
destructor Destroy;
override;
public
constructor create(IPAddress:tstrings);
end;

implementation
uses Unit1;
{ ConnThread }
constructor ConnThread.create(IPAddress:tstrings);
begin
FTimer:=TTimer.Create(nil);
FTimer.Enabled:=false;
FTimer.Interval:=600000;//10minutes
FIPList:=TStringlist.Create;
FIPList:=IPAddress;
InitializeCriticalSection(CS);
//初始化临界区
inherited create(false);
end;

destructor ConnThread.Destroy;
begin
FTimer.Enabled:=false;
FTimer.Free;
FIPList.Free;
inherited Destroy;
end;

function testconn(ipaddress:string):boolean;
var
tcpclient:TTcpClient;
begin
TcpClient:=TTcpClient.Create(nil);
TcpClient.Active:=false;
TcpClient.RemotePort:='5555';
TcpClient.RemoteHost:=ipaddress;
result:=false;
try
if tcpclient.Connect then
begin
result:=true;
end
else
begin
result:=false;
end;
finally
tcpclient.Disconnect;
tcpclient.Free;
end;

end;

procedure ConnThread.addinfo;
var
i:integer;
begin
for i:=0 to FIPList.Count-1do
begin
if testconn(fiplist.Strings) then
begin
form1.Memo1.Lines.Add(fiplist.strings+'可以连接');
//如果注释掉这行和下面行,程序主界面一样会死
end
else
begin
form1.Memo1.Lines.Add(fiplist.strings+'不可以连接');
//..........................................
end;
end;
end;

procedure ConnThread.ontime(sender:TObject);
begin
Synchronize(addinfo);
end;
procedure ConnThread.Execute;
begin
{ Place thread code here }
FreeOnTerminate:=false;
EnterCriticalSection(cs);
//
FTimer.Enabled:=true;
FTimer.OnTimer:=ontime;
LeaveCriticalSection(CS);
//
end;

end.
 
第一次遇到这个问题,专门运行多线程主界面也会死,帮忙看看吧!
unit ConnThreadUnit;
interface
uses
Classes, Sockets, ExtCtrls, SysUtils, Windows;
var
CS:TRTLCriticalSection;
type
ConnThread = class(TThread)
private
{ Private declarations }
FTimer:TTimer;
FIPList:TStrings;
FTcpClient:TTcpClient;
procedure ontime(Sender: TObject);
procedure addinfo;
protected
procedure Execute;
override;
destructor Destroy;
override;
public
constructor create(IPAddress:tstrings);
end;

implementation
uses Unit1;
{ ConnThread }
constructor ConnThread.create(IPAddress:tstrings);
begin
FTimer:=TTimer.Create(nil);
FTimer.Enabled:=false;
FTimer.Interval:=600000;//10minutes
FIPList:=TStringlist.Create;
FIPList:=IPAddress;
InitializeCriticalSection(CS);
//初始化临界区
inherited create(false);
end;

destructor ConnThread.Destroy;
begin
FTimer.Enabled:=false;
FTimer.Free;
FIPList.Free;
inherited Destroy;
end;

function testconn(ipaddress:string):boolean;
var
tcpclient:TTcpClient;
begin
TcpClient:=TTcpClient.Create(nil);
TcpClient.Active:=false;
TcpClient.RemotePort:='5555';
TcpClient.RemoteHost:=ipaddress;
result:=false;
try
if tcpclient.Connect then
begin
result:=true;
end
else
begin
result:=false;
end;
finally
tcpclient.Disconnect;
tcpclient.Free;
end;

end;

procedure ConnThread.addinfo;
var
i:integer;
begin
for i:=0 to FIPList.Count-1do
begin
if testconn(fiplist.Strings) then
begin
form1.Memo1.Lines.Add(fiplist.strings+'可以连接');
//如果注释掉这行和下面行,程序主界面一样会死
end
else
begin
form1.Memo1.Lines.Add(fiplist.strings+'不可以连接');
//..........................................
end;
end;
end;

procedure ConnThread.ontime(sender:TObject);
begin
Synchronize(addinfo);
end;
procedure ConnThread.Execute;
begin
{ Place thread code here }
FreeOnTerminate:=false;
EnterCriticalSection(cs);
//
FTimer.Enabled:=true;
FTimer.OnTimer:=ontime;
LeaveCriticalSection(CS);
//
end;

end.
 
哪里有你这么用线程的.单就你贴出的代码功能,没必要用线程,直接操作就可以了.非要用线程,只能劝你去看书了,或者在多线程的版块翻一番
 
我不是问你有没有我这么用线程的,我的这个用法有错吗?如果你不喜欢回答,我不会强求你,你知道我为什么要用多线程吗?总是这么武断的给别人下定义.现在我告诉我我现在做的整个软件是干什么的.你看看你不用线程直接给我操作出来:
第一.我的软件要采集多台网络设备(带有snmp agent)的mib库信息,比如流量数据.
第二.我要给使用人员提供一个定时测试其他服务器比如ftp服务器,web服务器等的网络运行状况,也就是是不是没有和网络断开连接,如果这些服务器断了网络要马上修复.
还有好多功能,为了商业保密,就不再列出来了.
现在你牛b,你不用多线程帮我操作出来,就专门上面这两个功能,来试试!
 
楼主,什么情况下不会死,然后再加上一句就会死。
 
进入循环部分,开始出现界面死,但是最终还是能够执行完毕,关键是在这个线程执行的过程中,用户还要操作别的东西,如果出现界面死,那肯定不好.
unit ConnThreadUnit;
interface
uses
Classes, Sockets, ExtCtrls, SysUtils, Windows;
var
CS:TRTLCriticalSection;
type
ConnThread = class(TThread)
private
{ Private declarations }
FTimer:TTimer;
FIPList:TStrings;
procedure ontime(Sender: TObject);
procedure addinfo;
protected
procedure Execute;
override;
destructor Destroy;
override;
public
constructor create(IPAddress:tstrings);
end;

implementation
uses Unit1;
{ ConnThread }
constructor ConnThread.create(IPAddress:tstrings);
begin
FTimer:=TTimer.Create(nil);
FTimer.Enabled:=false;
FTimer.Interval:=600000;//10minutes
FIPList:=TStringlist.Create;
FIPList:=IPAddress;
InitializeCriticalSection(CS);
//初始化临界区
inherited create(false);
end;

destructor ConnThread.Destroy;
begin
FTimer.Enabled:=false;
FTimer.Free;
FIPList.Free;
inherited Destroy;
end;

function testconn(ipaddress:string):boolean;
var
tcpclient:TTcpClient;
begin
TcpClient:=TTcpClient.Create(nil);
TcpClient.Active:=false;
TcpClient.RemotePort:='5555';
TcpClient.RemoteHost:=ipaddress;
result:=false;
try
if tcpclient.Connect then
begin
result:=true;
end
else
begin
result:=false;
end;
finally
tcpclient.Disconnect;
tcpclient.Free;
end;

end;

procedure ConnThread.addinfo;
var
i:integer;
begin
for i:=0 to FIPList.Count-1do
begin
if testconn(fiplist.Strings) then
begin
form1.Memo1.Lines.Add(fiplist.strings+'可以连接');
//如果注释掉这行和下面行,程序主界面一样会死
end
else
begin
form1.Memo1.Lines.Add(fiplist.strings+'不可以连接');
//..........................................
end;
end;
end;

procedure ConnThread.ontime(sender:TObject);
begin
Synchronize(addinfo);
end;
procedure ConnThread.Execute;
begin
{ Place thread code here }
FreeOnTerminate:=false;
EnterCriticalSection(cs);
//
FTimer.Enabled:=true;
FTimer.OnTimer:=ontime;
LeaveCriticalSection(CS);
//
end;

end.
 
用这个试试
application.ProcessMessages
既然用了线程,旧不要用时间控件了
 
楼主,你的ontime是10分钟执行一次吗,是时间太长的缘故吧
FTimer.Interval:=600000;//10minutes
procedure ConnThread.ontime(sender:TObject);
begin
Synchronize(addinfo);
end;
 
这个不是时间长短问题了,timer只是一个在多少时间间隔的时候执行而已了,使用时间控件,是因为我要定时扫描,比如半小时查一次这些ip地址的这个端口开了没有,如果不使用时间控件,我知道还可以使用sleep来处理,在execute里面来一个条件永远为真的循环,然后循环的后面sleep一段时间,但是效果一样的,就是只执行一次,也出现死界面的情况!
 
你的FTimer是私有的,不要用临界区试试,注释掉看如何
FreeOnTerminate:=false;
// EnterCriticalSection(cs);
//
FTimer.Enabled:=true;
FTimer.OnTimer:=ontime;
// LeaveCriticalSection(CS);
//
 
已经注释了测试过的,一样的,既然是私有的,加上临界区也没有关系啊,对吧.而且你可以将我这段代码拷贝下去测试一下就知道了,反正我在我系统上就是出现这个问题,不知道怎么回事,按道理,使用了多线程主界面不应该死才对,可是没有用处啊!
 
我试了不会死
 
我的IP地址列表只有一个127.0.0.1,时间设为3秒,发现会有停顿现象,应该是testconn函数在尝试TCP连接时造成的
 
因为你只是界面死,程序还能运行,肯定是某些语句占用了CPU,你在可疑语句前后加上时间显示看是什么原因造成的
form1.Memo1.Lines.Add(fiplist.strings+'开始: '+datetimetostr(now));
if testconn(fiplist.Strings) then
begin
form1.Memo1.Lines.Add(fiplist.strings+'可以连接');
//如果注释掉这行和下面行,程序主界面一样会死
end
else
begin
form1.Memo1.Lines.Add(fiplist.strings+'不可以连接');
//..........................................
end;
form1.Memo1.Lines.Add(fiplist.strings+'开始: '+datetimetostr(now)+chr(13)+chr(10));
 
我说的死就是停顿了,如果列表多几个ip地址,界面根本就动不了.不知道这是什么原因,虽然说,是尝试连接造成的,但是是在线程里面啊,不应该影响主界面.
 
端口扫描方法不对
 
这里有一个检测端口开放的源码,可以参考参考
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,WInSock, ExtCtrls;
const WM_SOCKET=WM_USER+1;
//socket消息
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Panel1: TPanel;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
Sockhd : integer;
//socket句柄
Serv_Addr : Tsockaddr;//目标地址
procedure SockEvent(var msg: Tmessage);message WM_SOCKET;
//处理cocket消息
procedure DspMsg(msg : string);
//显示信息
{ Private declarations }
public
{ Public declarations }
end;

Form1: TForm1;
implementation
{$R *.DFM}
function lookup_hostname(const hostname:string):longint;
//把域名转化成IP地址
var
RemoteHost : PHostEnt;
(* no,do
n't free it! *)
ip_address: longint;
begin
ip_address:=-1;
try
if hostname='' then
begin
(* no host given! *)
lookup_hostname:=ip_address;
EXIT;
end
else
begin
ip_address:=Winsock.Inet_Addr(PChar(hostname));
(* try a xxx.xxx.xxx.xx first *)
if ip_address=SOCKET_ERROR then
begin
RemoteHost:=Winsock.GetHostByName(PChar(hostname));
if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then
begin
lookup_hostname:=ip_address;
EXIT;
(* host not found *)
end
else
ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
end;
end;
except
ip_address:=-1;
end;
lookup_hostname:=ip_address;
end;

procedure TFOrm1.DspMsg(msg: string);
begin
memo1.Lines.Add(msg+'...');
if Memo1.Lines.Count>200 then
Memo1.Lines.Delete(0);
end;

procedure TForm1.SockEvent(var msg : tmessage);
//处理socket消息
begin
case msg.LParam of
FD_READ: begin
//标识可以读数据,当然肯定已经链接上了
dspmsg('可以读取数据');
//do what you wantdo
end;

FD_WRITE: begin
dspmsg('可以发送数据');
//do what you wantdo
end;

FD_ERROR: begin
dspmsg('发生错误');
//如果你是客户端,则应该是连接不上,即端口没有开
end;

FD_CLOSE: begin
dspmsg('服务器断开连接');
//对方关闭连接
end;

FD_CONNECT: begin
dspmsg('连结上服务器');
//表示对方端口开放
end;

FD_ACCEPT: begin
dspmsg('接收一个请求');
//这个消息只有服务端可能出现
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var wsaData:TwsaData;
begin
//启动winsock动态链接库
if WSAStartup (makeword(2,2), wsaData)<>0 then
begin
messagebox(application.handle,'无法启动winsock动态连接库!','警告',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
Application.Terminate;
end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//关闭dll
WSACleanup;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Sockhd := socket(AF_INET,SOCK_STREAM,0);
//创建socket句柄
if Sockhd<0 then
begin
messagebox(application.handle,'无法创建句柄!','警告',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
exit;
end;
Serv_addr.sin_addr.s_addr:= lookup_hostname(edit1.Text);
//主机名
Serv_addr.sin_family := PF_INET;
Serv_addr.sin_port := htons(23);
//any port you want to connect
if WSAAsyncSelect(Sockhd,Form1.handle,WM_SOCKET,FD_ACCEPT or FD_CONNECT or FD_CLOSE or FD_READ or FD_WRITE)=SOCKET_ERROR
then
begin
messagebox(application.handle,'无法创建句柄!','警告',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
exit;
end;
//异步socket
connect(sockhd,serv_addr,sizeof(serv_addr));
//连接,结果会在前面的处理函数处理
end;

end.
 
楼主,我遇到过你同样的问题,
Synchronize(addinfo);
SynchronizE你放在循环内试试。在最小同步。如果你整个循环后才同步,当然要等好长一段时间了。
 
就象zjan521所说的,没见过这么用线程的。另外,别人好心看了问题然后回复说了自己的看法,不管你有没有理解、接不接受他所说的,最起码态度应该友好虚心点,不用这么大火气吧?[:D]建议看看soul老大的“论坛的十个基本礼节”http://www.delphibbs.com/delphibbs/dispq.asp?lid=2911142
再来说说问题:
procedure ConnThread.Execute;
begin
{ Place thread code here }
FreeOnTerminate:=false;
EnterCriticalSection(cs);
//
FTimer.Enabled:=true;
FTimer.OnTimer:=ontime;
LeaveCriticalSection(CS);
//
end;
OK,所有的线程执行的代码就这么几句,不会有什么时间耽搁的,很快执行完毕,好在FreeOnTerminate:=false,不是自动释放线程对象,不然FTimer被Free掉,根本没机会到定时器事件触发再去执行OnTime过程了。
FTimer是在Create中创建的,实际上是主线程调用的,也就是FTimer对应的隐形窗口(这个看看TTimer的代码)是隶属于主线程,其OnTimer的触发发生在主线程收到WM_TIMER消息时,当然它的事件代码的执行也就是在主线程中,跟这个ConnThread线程有什么关系呢?
再退一步说,即使OnTimer事件代码是在ConnThread线程中执行的,
procedure ConnThread.ontime(sender:TObject);
begin
Synchronize(addinfo);
end;
这样子的代码也完全不行的,Synchronize就是将addinfo同步到主线程中执行(Synchronize主要是为了保证VCL的线程访问安全),你这样不就等于在主线程中调用addinfo吗?那当然会让界面没有反应了,所以正确的做法应该是在需要访问VCL组件跟界面打交道的时候才用Synchronize进行同步。
procedure ConnThread.addinfo;
var
i:integer;
begin
for i:=0 to FIPList.Count-1do
begin
if testconn(fiplist.Strings) then
begin
//form1.Memo1.Lines.Add(fiplist.strings+'可以连接');
Synchronize(Memo1添加一行);
...
end
else
begin
form1.Memo1.Lines.Add(fiplist.strings+'不可以连接');
Synchronize(Memo1添加一行);
...
end;
end;
end;

再回过头来,说说怎么解决前面一个问题。可以在线程中使用CreateEvent创建一个事件内核对象,然后在线程执行体Execute中
while not Terminateddo
begin
if WAIT_OBJECT_0 = WaitForSingleObject(hEvent, INFINITE) then
begin
if Terminated then
Break;
{ 这里写工作代码 }
end;
end;
主线程中用定时器,在OnTimer中用SetEvent触发hEvent事件,OK,这样就既可以在线程中执行代码,避免阻塞主线程,又可以定时循环执行。之所以不在线程中用Sleep延时来代替定时器的定时,主要是为了结束线程考虑,这样只需要Thread.Terminate;
SetEvent(Thread.hEvent)一下,线程就可以结束了,否则就只有等到线程Sleep延时时间到才能结束线程了,这在程序执行过程中问题还不是很大,在要结束程序时就是个大问题了,总不能让程序过个几分钟再关吧?[:D]
 
to lichengbin:首先谢谢你的帮助,至于你提到的zjan521,我想你理解偏了吧.我是有点火,我火他上来就这么武断的说一句,如果我的软件单独就只需要完成这个功能,我用线程确实是傻蛋了.我后面回帖子告诉了他我软件要做的是什么功能了.他能不用多线程来解决吗?我想如果不用多线程能解决的问题,没有多少人会去给自己找麻烦,来使用多线程吧.论坛的礼节我懂,因为我生活之中就很将礼节,只要别人对我所做的提出建议或者意见,而不是象他这样,看到这段代码就说没有必要用多线程,然后让我怎么怎么的.如果是一个真心要帮助解决问题的,应该不是说别人这段代码有没有必要用多线程吧,而是帮助别人分析一下,说说自己的建议吧.你觉得他上来回的帖子是想帮助人吗?看论坛的帖子我不知道看啊?看书我不知道看啊?我要是自己能解决了,能找到毛病,我跑上来发这个帖子干什么,我神经病啊?
 
后退
顶部