多线程的问题 |
|
尚未結案
|
|
stockdisk
一般會員   發表：9 回覆：14 積分：4 註冊：2003-06-06 發送簡訊給我 |
我在写的过程中发现线程只能运行一回，好象是线程没有被释放。
PPingcheckItem = ^TPingcheckItem;
TpingcheckItem = RECORD
IP,
Ping: STRING;
ImageIndex: integer;
END; pingtestPItems: TList;
ping_thread_no: integer = 0; //PING线程数量
ping_criticalsection: Tcriticalsection; //全局临界变量
cur_ip: integer; //已工作的线程数量
thread_run: boolean;
PPingcheckItem(pingtestPItems.Items[fprocess]).ping
PROCEDURE TmainForm.suiButton5Click(Sender: TObject);
VAR
I: integer;
BEGIN
IF pingtestPItems.Count = 0 THEN exit;
suiButton5.Enabled := false;
suiButton7.Enabled := true;
ping_thread_no := 0;
thread_run := true;
cur_ip := 0; ELSE FOR I := 0 TO StrToInt(Edit9.Text) - 1 DO BEGIN //edit9是线程数
myping_scan.Create(false); END;
suiButton5.Enabled := true;
suiButton7.Enabled := true;
END; UNIT thread_Pingscan; INTERFACE USES
Classes, ping, sysutils, syncobjs, comctrls; TYPE
myping_scan = CLASS(TThread)
Private
{ Private declarations }
fprocess: integer;
PROCEDURE update_pingzt;
Protected
PROCEDURE Execute; Override;
Public
FPing: Tping;
CONSTRUCTOR Create(CreateSuspended: Boolean);
PROCEDURE ThreadDone(sender: TObject);
PROCEDURE PingEchoReply(sender: TObject; icmp: TObject; error: integer);
PROCEDURE set_str;
END; IMPLEMENTATION
USES main, functions; { myping_scan }
CONSTRUCTOR myping_scan.Create(CreateSuspended: Boolean);
BEGIN
FPing := Tping.Create(mainform);
FPing.Timeout := StrToInt(mainform.Edit10.text);
OnTerminate := ThreadDone;
freeOnTerminate := True;
FPing.OnEchoReply := PingEchoReply;
inc(ping_thread_no);
mainform.Label38.Caption := inttostr(ping_thread_no);
INHERITED Create(CreateSuspended);
END; PROCEDURE myping_scan.Execute;
BEGIN
INHERITED;
WHILE (thread_run) DO BEGIN
ping_criticalsection.Enter;
fprocess := cur_ip;
inc(cur_ip);
synchronize(update_pingzt);
ping_criticalsection.Leave;
IF fprocess <= pingtestPItems.Count THEN BEGIN
PPingcheckItem(pingtestPItems.Items[fprocess]).ping := '正在PING';
mainform.Pingcheck1.Items.Item[fprocess].Update;
FPing.address := PPingcheckItem(pingtestPItems.Items[fprocess]).IP;
FPing.ping;
END ELSE break;
END
END; PROCEDURE myping_scan.update_pingzt;
BEGIN
mainform.Label39.Caption := PPingcheckItem(pingtestPItems.Items[fprocess]).IP;
END;
PROCEDURE myping_scan.PingEchoReply(sender: TObject; icmp: TObject; error: integer);
BEGIN
IF (error = 1) THEN
synchronize(set_str)
ELSE BEGIN
PPingcheckItem(pingtestPItems.Items[fprocess]).ping := 'PING不通';
mainform.Pingcheck1.Items.Item[fprocess].Update;
END;
END;
PROCEDURE myping_scan.set_str;
BEGIN
PPingcheckItem(pingtestPItems.Items[fprocess]).ping := 'PING结束';
mainform.Ppingcheck1.Items.Item[fprocess].Update;
END;
PROCEDURE myping_scan.ThreadDone(sender: TObject);
BEGIN
(myping_scan(sender)).FPing.Free;
dec(ping_thread_no); //递减线程数变量值
mainform.Label38.Caption := inttostr(ping_thread_no);
IF ping_thread_no = 0 THEN
mainform.test1.Lines.text := 'PING结束请查看';
END; END. 發表人 - stockdisk 於 2005/03/07 20:58:40 發表人 - stockdisk 於 2005/03/07 21:01:07
|
|
stockdisk
一般會員 發表：9 回覆：14 積分：4 註冊：2003-06-06 發送簡訊給我 |
我在写的过程中发现线程只能运行一回，好象是线程没有被释放。
PPingcheckItem = ^TPingcheckItem;
TpingcheckItem = RECORD
IP,
Ping: STRING;
ImageIndex: integer;
END; pingtestPItems: TList;
ping_thread_no: integer = 0; //PING线程数量
ping_criticalsection: Tcriticalsection; //全局临界变量
cur_ip: integer; //已工作的线程数量
thread_run: boolean;
PPingcheckItem(pingtestPItems.Items[fprocess]).ping
PROCEDURE TmainForm.suiButton5Click(Sender: TObject);
VAR
I: integer;
BEGIN
IF pingtestPItems.Count = 0 THEN exit;
suiButton5.Enabled := false;
suiButton7.Enabled := true;
ping_thread_no := 0;
thread_run := true;
cur_ip := 0; ELSE FOR I := 0 TO StrToInt(Edit9.Text) - 1 DO BEGIN //edit9是线程数
myping_scan.Create(false); END;
suiButton5.Enabled := true;
suiButton7.Enabled := true;
END; UNIT thread_Pingscan; INTERFACE USES
Classes, ping, sysutils, syncobjs, comctrls; TYPE
myping_scan = CLASS(TThread)
Private
{ Private declarations }
fprocess: integer;
PROCEDURE update_pingzt;
Protected
PROCEDURE Execute; Override;
Public
FPing: Tping;
CONSTRUCTOR Create(CreateSuspended: Boolean);
PROCEDURE ThreadDone(sender: TObject);
PROCEDURE PingEchoReply(sender: TObject; icmp: TObject; error: integer);
PROCEDURE set_str;
END; IMPLEMENTATION
USES main, functions; { myping_scan }
CONSTRUCTOR myping_scan.Create(CreateSuspended: Boolean);
BEGIN
FPing := Tping.Create(mainform);
FPing.Timeout := StrToInt(mainform.Edit10.text);
OnTerminate := ThreadDone;
freeOnTerminate := True;
FPing.OnEchoReply := PingEchoReply;
inc(ping_thread_no);
mainform.Label38.Caption := inttostr(ping_thread_no);
INHERITED Create(CreateSuspended);
END; PROCEDURE myping_scan.Execute;
BEGIN
INHERITED;
WHILE (thread_run) DO BEGIN
ping_criticalsection.Enter;
fprocess := cur_ip;
inc(cur_ip);
synchronize(update_pingzt);
ping_criticalsection.Leave;
IF fprocess <= pingtestPItems.Count THEN BEGIN
PPingcheckItem(pingtestPItems.Items[fprocess]).ping := '正在PING';
mainform.Pingcheck1.Items.Item[fprocess].Update;
FPing.address := PPingcheckItem(pingtestPItems.Items[fprocess]).IP;
FPing.ping;
END ELSE break;
END
END; PROCEDURE myping_scan.update_pingzt;
BEGIN
mainform.Label39.Caption := PPingcheckItem(pingtestPItems.Items[fprocess]).IP;
END;
PROCEDURE myping_scan.PingEchoReply(sender: TObject; icmp: TObject; error: integer);
BEGIN
IF (error = 1) THEN
synchronize(set_str)
ELSE BEGIN
PPingcheckItem(pingtestPItems.Items[fprocess]).ping := 'PING不通';
mainform.Pingcheck1.Items.Item[fprocess].Update;
END;
END;
PROCEDURE myping_scan.set_str;
BEGIN
PPingcheckItem(pingtestPItems.Items[fprocess]).ping := 'PING结束';
mainform.Ppingcheck1.Items.Item[fprocess].Update;
END;
PROCEDURE myping_scan.ThreadDone(sender: TObject);
BEGIN
(myping_scan(sender)).FPing.Free;
dec(ping_thread_no); //递减线程数变量值
mainform.Label38.Caption := inttostr(ping_thread_no);
IF ping_thread_no = 0 THEN
mainform.test1.Lines.text := 'PING结束请查看';
END; END. 發表人 - stockdisk 於 2005/03/07 20:58:40
|
發表時間：2005-03-07 20:55:06
IP:222.33.xxx.xxx 未訂閱
系統時間：2024-06-02 1:28:36
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |