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.