100大洋奉献~~帮忙看一代代码!关于用线程实现Ping操作~ ( 积分: 100 )

下面的这段代码是从网上抄来的....用来进行Ping操作
有点郁闷,当把这段代码放在主窗口单元时,勉强可以正常运行,但如果把它放在非主窗口单元时,却老出错.(我在主窗口中还新建了一个新窗口,代码就放在这窗口中).

还有一个问题,因为这段代码是抄来的,里面还有一些小问题,就是按'停止'按钮的时候,程序是把扫描停止下来了,但不知道是不是线程没释放,整个窗口就卡在那里,不接受任何消息!而且在扫描完毕的时候也是这样!

unit Scan;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

StdCtrls, ExtCtrls, ComCtrls, IdBaseComponent, IdComponent, IdRawBase,

IdRawClient, IdIcmpClient, Gauges, WinSock;//添加WinSock



type

TPingIP = class(TThread)

private

IPAddress: string;

IPEndAddress: string;

procedure PingAddress;

procedure IcmpReply(ASender: TComponent;

const AReplyStatus: TReplyStatus);

protected

procedure Execute; override;

end;



TScanForm = class(TForm)
RadioButton1:TRadioButton;
RadioButton2:TRadioButton;
GroupBox1: TGroupBox;
GroupBox2:TGroupBox;
StartIp_LabE: TLabeledEdit;//起始IP
EndIp_LabE: TLabeledEdit;//终止IP
LabeledEdit1:TLabeledEdit;
LabeledEdit4:TLabeledEdit;
LabeledEdit5:TLabeledEdit;
CheckBox1:TCheckBox;
CheckBox2:TcheckBox;
StatusBar1:TStatusBar;
StartPing_Btn: TButton;//开始Ping按钮
StopPing_Btn: TButton;//停止Ping按钮
ClearIp_Btn: TButton;//清空信息列表
PingProc_GG: TGauge;
IpList_LisB: TListBox;//用来输入Ping操作信息

procedure StartPing_BtnClick(Sender: TObject);

procedure StopPing_BtnClick(Sender: TObject);

procedure ClearIp_BtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

PIP: TPingIP;

procedure SetStatus(BtnStatus: Boolean);

public

procedure PingIPTerminated(Sender: TObject);

end;



var

ScanForm: TScanForm;



implementation



{$R *.dfm}

//转换网络中的地址

function TransformAddr(const CurrInAddr: TInAddr): TInAddr;

var

sbx: char;

tmpInAddr: TInAddr;

begin

tmpInAddr := CurrInAddr;

sbx := tmpInAddr.S_un_b.s_b1;

tmpInAddr.S_un_b.s_b1 := tmpInAddr.S_un_b.s_b4;

tmpInAddr.S_un_b.s_b4 := sbx;

sbx := tmpInAddr.S_un_b.s_b2;

tmpInAddr.S_un_b.s_b2 := tmpInAddr.S_un_b.s_b3;

tmpInAddr.S_un_b.s_b3 := sbx;

result := tmpInAddr;

end;

//获得下一个IP地址

function NextIP(const IPAddr: string; Step: Integer = 1): string;

var

tmpInAddr: TInAddr;

begin

tmpInAddr.S_addr := Winsock.inet_addr(pchar(IPAddr));

tmpInAddr := TransformAddr(tmpInAddr);

tmpInAddr.S_addr := tmpInAddr.S_addr + Step;

tmpInAddr := TransformAddr(tmpInAddr);

result := Winsock.inet_ntoa(tmpInAddr);

end;

//获得两个IP地址之间的数量

function IPWidth(const BeginIP, EndIP: string): DWORD;

var

BInAddr, EInAddr: TInAddr;

begin

BInAddr.S_addr := Winsock.inet_addr(pchar(BeginIP));

EInAddr.S_addr := Winsock.inet_addr(pchar(EndIP));

result := TransformAddr(EInAddr).S_addr

- TransformAddr(BInAddr).S_addr + 1;

end;

//执行线程

procedure TPingIP.Execute;

begin

OnTerminate := ScanForm.PingIPTerminated;

PingAddress;

end;



procedure TPingIP.PingAddress;

var

i, ipcount: integer;

IPEnd: string;

thIcmp: TIdIcmpClient;

begin

thICMP := TIdIcmpClient.Create(nil);

try

thICMP.OnReply := ICMPReply;

thICMP.ReceiveTimeout := 50;

IPEnd := NextIP(IPEndAddress);

ipcount := 0;

while (IPAddress <> IPEnd) do

begin

thICMP.Host := IPAddress;

for i := 1 to 3 do

begin

if Terminated then

Break;

thICMP.Ping;

//Application.ProcessMessages;

end;

if Terminated then

Break;

ipcount := ipcount + 1;

ScanForm.PingProc_GG.Progress := ipcount;

IPAddress := NextIP(IPAddress);

end;

finally

thICMP.Free;

end;

end;

//ICMP控件中的事件

procedure TPingIP.IcmpReply(ASender: TComponent;

const AReplyStatus: TReplyStatus);

var

sTime: string;

begin

if Terminated then Exit;

if (AReplyStatus.MsRoundTripTime = 0) then

sTime := '<1'

else

sTime := '=';

//显示给用户的信息

ScanForm.IpList_LisB.Items.Insert(0, Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',

[AReplyStatus.BytesReceived,

IPAddress, //AReplyStatus.FromIpAddress,

AReplyStatus.SequenceId,

AReplyStatus.TimeToLive,

sTime,

AReplyStatus.MsRoundTripTime]));

end;



procedure TScanForm.SetStatus(BtnStatus: Boolean);

begin
StartPing_Btn.Enabled := BtnStatus;
StopPing_Btn.Enabled := not BtnStatus;
ClearIp_Btn.Enabled := BtnStatus;
end;

//中断线程后的事件

procedure TScanForm.PingIPTerminated(Sender: TObject);

begin

PIP.Free;

PIP := nil;

SetStatus(True);

end;



procedure TScanForm.StartPing_BtnClick(Sender: TObject);

begin

Screen.Cursor := crHourGlass;

try

PingProc_GG.MaxValue := IPWidth(StartIp_LabE.Text, EndIp_LabE.Text);

PingProc_GG.Progress := 0;

PIP := TPingIP.Create(True);

PIP.IPAddress := StartIp_LabE.Text;

PIP.IPEndAddress := EndIp_LabE.Text;

PIP.Resume;

SetStatus(False);

finally

Screen.Cursor := crDefault;

end;

end;



procedure TScanForm.StopPing_BtnClick(Sender: TObject);

begin

PIP.Terminate;

end;



procedure TScanForm.ClearIp_BtnClick(Sender: TObject);

begin

PingProc_GG.Progress := 0;

IpList_LisB.Items.Clear;

end;



procedure TScanForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=CaFree;
end;
end.

各位帮忙啊,问题解决马上给分......在线等待中!!!
谢谢!

下面的这段代码是从网上抄来的....用来进行Ping操作
有点郁闷,当把这段代码放在主窗口单元时,勉强可以正常运行,但如果把它放在非主窗口单元时,却老出错.(我在主窗口中还新建了一个新窗口,代码就放在这窗口中).

还有一个问题,因为这段代码是抄来的,里面还有一些小问题,就是按'停止'按钮的时候,程序是把扫描停止下来了,但不知道是不是线程没释放,整个窗口就卡在那里,不接受任何消息!而且在扫描完毕的时候也是这样!

unit Scan;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

StdCtrls, ExtCtrls, ComCtrls, IdBaseComponent, IdComponent, IdRawBase,

IdRawClient, IdIcmpClient, Gauges, WinSock;//添加WinSock



type

TPingIP = class(TThread)

private

IPAddress: string;

IPEndAddress: string;

procedure PingAddress;

procedure IcmpReply(ASender: TComponent;

const AReplyStatus: TReplyStatus);

protected

procedure Execute; override;

end;



TScanForm = class(TForm)
RadioButton1:TRadioButton;
RadioButton2:TRadioButton;
GroupBox1: TGroupBox;
GroupBox2:TGroupBox;
StartIp_LabE: TLabeledEdit;//起始IP
EndIp_LabE: TLabeledEdit;//终止IP
LabeledEdit1:TLabeledEdit;
LabeledEdit4:TLabeledEdit;
LabeledEdit5:TLabeledEdit;
CheckBox1:TCheckBox;
CheckBox2:TcheckBox;
StatusBar1:TStatusBar;
StartPing_Btn: TButton;//开始Ping按钮
StopPing_Btn: TButton;//停止Ping按钮
ClearIp_Btn: TButton;//清空信息列表
PingProc_GG: TGauge;
IpList_LisB: TListBox;//用来输入Ping操作信息

procedure StartPing_BtnClick(Sender: TObject);

procedure StopPing_BtnClick(Sender: TObject);

procedure ClearIp_BtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

PIP: TPingIP;

procedure SetStatus(BtnStatus: Boolean);

public

procedure PingIPTerminated(Sender: TObject);

end;



var

ScanForm: TScanForm;



implementation



{$R *.dfm}

//转换网络中的地址

function TransformAddr(const CurrInAddr: TInAddr): TInAddr;

var

sbx: char;

tmpInAddr: TInAddr;

begin

tmpInAddr := CurrInAddr;

sbx := tmpInAddr.S_un_b.s_b1;

tmpInAddr.S_un_b.s_b1 := tmpInAddr.S_un_b.s_b4;

tmpInAddr.S_un_b.s_b4 := sbx;

sbx := tmpInAddr.S_un_b.s_b2;

tmpInAddr.S_un_b.s_b2 := tmpInAddr.S_un_b.s_b3;

tmpInAddr.S_un_b.s_b3 := sbx;

result := tmpInAddr;

end;

//获得下一个IP地址

function NextIP(const IPAddr: string; Step: Integer = 1): string;

var

tmpInAddr: TInAddr;

begin

tmpInAddr.S_addr := Winsock.inet_addr(pchar(IPAddr));

tmpInAddr := TransformAddr(tmpInAddr);

tmpInAddr.S_addr := tmpInAddr.S_addr + Step;

tmpInAddr := TransformAddr(tmpInAddr);

result := Winsock.inet_ntoa(tmpInAddr);

end;

//获得两个IP地址之间的数量

function IPWidth(const BeginIP, EndIP: string): DWORD;

var

BInAddr, EInAddr: TInAddr;

begin

BInAddr.S_addr := Winsock.inet_addr(pchar(BeginIP));

EInAddr.S_addr := Winsock.inet_addr(pchar(EndIP));

result := TransformAddr(EInAddr).S_addr

- TransformAddr(BInAddr).S_addr + 1;

end;

//执行线程

procedure TPingIP.Execute;

begin

OnTerminate := ScanForm.PingIPTerminated;

PingAddress;

end;



procedure TPingIP.PingAddress;

var

i, ipcount: integer;

IPEnd: string;

thIcmp: TIdIcmpClient;

begin

thICMP := TIdIcmpClient.Create(nil);

try

thICMP.OnReply := ICMPReply;

thICMP.ReceiveTimeout := 50;

IPEnd := NextIP(IPEndAddress);

ipcount := 0;

while (IPAddress <> IPEnd) do

begin

thICMP.Host := IPAddress;

for i := 1 to 3 do

begin

if Terminated then

Break;

thICMP.Ping;

//Application.ProcessMessages;

end;

if Terminated then

Break;

ipcount := ipcount + 1;

ScanForm.PingProc_GG.Progress := ipcount;

IPAddress := NextIP(IPAddress);

end;

finally

thICMP.Free;

end;

end;

//ICMP控件中的事件

procedure TPingIP.IcmpReply(ASender: TComponent;

const AReplyStatus: TReplyStatus);

var

sTime: string;

begin

if Terminated then Exit;

if (AReplyStatus.MsRoundTripTime = 0) then

sTime := '<1'

else

sTime := '=';

//显示给用户的信息

ScanForm.IpList_LisB.Items.Insert(0, Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',

[AReplyStatus.BytesReceived,

IPAddress, //AReplyStatus.FromIpAddress,

AReplyStatus.SequenceId,

AReplyStatus.TimeToLive,

sTime,

AReplyStatus.MsRoundTripTime]));

end;



procedure TScanForm.SetStatus(BtnStatus: Boolean);

begin
StartPing_Btn.Enabled := BtnStatus;
StopPing_Btn.Enabled := not BtnStatus;
ClearIp_Btn.Enabled := BtnStatus;
end;

//中断线程后的事件

procedure TScanForm.PingIPTerminated(Sender: TObject);

begin

PIP.Free;

PIP := nil;

SetStatus(True);

end;



procedure TScanForm.StartPing_BtnClick(Sender: TObject);

begin

Screen.Cursor := crHourGlass;

try

PingProc_GG.MaxValue := IPWidth(StartIp_LabE.Text, EndIp_LabE.Text);

PingProc_GG.Progress := 0;

PIP := TPingIP.Create(True);

PIP.IPAddress := StartIp_LabE.Text;

PIP.IPEndAddress := EndIp_LabE.Text;

PIP.Resume;

SetStatus(False);

finally

Screen.Cursor := crDefault;

end;

end;



procedure TScanForm.StopPing_BtnClick(Sender: TObject);

begin

PIP.Terminate;

end;



procedure TScanForm.ClearIp_BtnClick(Sender: TObject);

begin

PingProc_GG.Progress := 0;

IpList_LisB.Items.Clear;

end;



procedure TScanForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=CaFree;
end;
end.

各位帮忙啊,问题解决马上给分......在线等待中!!!
谢谢!

unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, ComCtrls, IdBaseComponent, IdComponent, IdRawBase,
IdRawClient, IdIcmpClient, Gauges, WinSock; //添加WinSock

type
TPingIP = class(TThread)
private
IPAddress: string;
IPEndAddress: string;
procedure PingAddress;
procedure IcmpReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
protected
procedure Execute; override;
end;

TPingUsersForm = class(TForm)
gbRound: TGroupBox;
lbedtIP: TLabeledEdit;
btnPing: TButton;
btnPingStop: TButton;
btnClear: TButton;
lbedtIPEnd: TLabeledEdit;
gbInfo: TGroupBox;
ggPing: TGauge;
lstReplies: TListBox;
procedure btnPingClick(Sender: TObject);
procedure btnPingStopClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
private
PIP: TPingIP;
procedure SetStatus(BtnStatus: Boolean);
public
procedure PingIPTerminated(Sender: TObject);
end;
var
PingUsersForm: TPingUsersForm;

implementation

{$R *.dfm}
//转换网络中的地址

function TransformAddr(const CurrInAddr: TInAddr): TInAddr;
var
sbx: char;
tmpInAddr: TInAddr;
begin
tmpInAddr := CurrInAddr;
sbx := tmpInAddr.S_un_b.s_b1;
tmpInAddr.S_un_b.s_b1 := tmpInAddr.S_un_b.s_b4;
tmpInAddr.S_un_b.s_b4 := sbx;
sbx := tmpInAddr.S_un_b.s_b2;
tmpInAddr.S_un_b.s_b2 := tmpInAddr.S_un_b.s_b3;
tmpInAddr.S_un_b.s_b3 := sbx;
result := tmpInAddr;
end;

//获得下一个IP地址

function NextIP(const IPAddr: string; Step: Integer = 1): string;
var
tmpInAddr: TInAddr;
begin
tmpInAddr.S_addr := WinSock.inet_addr(pchar(IPAddr));
tmpInAddr := TransformAddr(tmpInAddr);
tmpInAddr.S_addr := tmpInAddr.S_addr + Step;
tmpInAddr := TransformAddr(tmpInAddr);
result := WinSock.inet_ntoa(tmpInAddr);
end;

//获得两个IP地址之间的数量

function IPWidth(const BeginIP, EndIP: string): DWORD;
var
BInAddr, EInAddr: TInAddr;
begin
BInAddr.S_addr := WinSock.inet_addr(pchar(BeginIP));
EInAddr.S_addr := WinSock.inet_addr(pchar(EndIP));
result := TransformAddr(EInAddr).S_addr - TransformAddr(BInAddr).S_addr + 1;
end;

//执行线程

procedure TPingIP.Execute;
begin
OnTerminate := PingUsersForm.PingIPTerminated;
PingAddress;
end;

procedure TPingIP.PingAddress;
var
i, ipcount: Integer;
IPEnd: string;
thIcmp: TIdIcmpClient;
begin
thIcmp := TIdIcmpClient.Create(nil);
try
thIcmp.OnReply := IcmpReply;
thIcmp.ReceiveTimeout := 50; IPEnd := NextIP(IPEndAddress);
ipcount := 0;

while (IPAddress <> IPEnd) do begin
thIcmp.Host := IPAddress;
for i := 1 to 3 do begin
if Terminated then Break;
thIcmp.Ping;
//Application.ProcessMessages;
end;
if Terminated then Break;
ipcount := ipcount + 1;
PingUsersForm.ggPing.Progress := ipcount;
IPAddress := NextIP(IPAddress);
end;
finally
thIcmp.Free;
end;
end;

//ICMP控件中的事件

procedure TPingIP.IcmpReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
var
sTime: string;
begin
if Terminated then Exit;
if (AReplyStatus.MsRoundTripTime = 0) then
sTime := '<1'
else
sTime := '=';
//显示给用户的信息
PingUsersForm.lstReplies.Items.Insert(0, Format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
[AReplyStatus.BytesReceived,
IPAddress, //AReplyStatus.FromIpAddress,
AReplyStatus.SequenceId,
AReplyStatus.TimeToLive,
sTime,
AReplyStatus.MsRoundTripTime]));
end;

procedure TPingUsersForm.SetStatus(BtnStatus: Boolean);
begin
btnClear.Enabled := BtnStatus;
btnPingStop.Enabled := not BtnStatus;
btnPing.Enabled := BtnStatus;
end;

//中断线程后的事件

procedure TPingUsersForm.PingIPTerminated(Sender: TObject);
begin
PIP.Free;
PIP := nil;
SetStatus(True);
end;

procedure TPingUsersForm.btnPingClick(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
try
ggPing.MaxValue := IPWidth(lbedtIP.Text, lbedtIPEnd.Text);
ggPing.Progress := 0;
PIP := TPingIP.Create(True);
PIP.IPAddress := lbedtIP.Text;
PIP.IPEndAddress := lbedtIPEnd.Text;
PIP.Resume;
SetStatus(False);
finally
Screen.Cursor := crDefault;
end;
end;

procedure TPingUsersForm.btnPingStopClick(Sender: TObject);
begin
PIP.Terminate;
end;


procedure TPingUsersForm.btnClearClick(Sender: TObject);
begin
ggPing.Progress := 0;
lstReplies.Items.Clear;
end;

end.


object PingUsersForm: TPingUsersForm
Left = 192
Top = 107
Width = 420
Height = 361
BorderIcons = [biSystemMenu, biMinimize]
Caption = '多线程IP搜索'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 12
object ggPing: TGauge
Left = 8
Top = 300
Width = 393
Height = 25
ForeColor = 10930928
Progress = 0
end
object gbRound: TGroupBox
Left = 8
Top = 8
Width = 393
Height = 109
Caption = '搜索范围'
TabOrder = 0
object lbedtIP: TLabeledEdit
Left = 24
Top = 28
Width = 157
Height = 20
EditLabel.Width = 48
EditLabel.Height = 12
EditLabel.Caption = '起始IP：'
ImeName = '中文 (简体) - 拼音加加3.11'
LabelPosition = lpAbove
LabelSpacing = 3
TabOrder = 0
end
object lbedtIPEnd: TLabeledEdit
Left = 200
Top = 28
Width = 173
Height = 20
EditLabel.Width = 48
EditLabel.Height = 12
EditLabel.Caption = '结束IP：'
ImeName = '中文 (简体) - 拼音加加3.11'
LabelPosition = lpAbove
LabelSpacing = 3
TabOrder = 1
end
object btnPing: TButton
Left = 132
Top = 60
Width = 75
Height = 29
Caption = '搜索计算机'
Default = True
TabOrder = 2
OnClick = btnPingClick
end
object btnPingStop: TButton
Left = 216
Top = 60
Width = 75
Height = 29
Caption = '停止搜索'
Enabled = False
TabOrder = 3
OnClick = btnPingStopClick
end
object btnClear: TButton
Left = 300
Top = 60
Width = 75
Height = 29
Caption = '清空'
TabOrder = 4
OnClick = btnClearClick
end
end
object gbInfo: TGroupBox
Left = 8
Top = 124
Width = 393
Height = 169
Caption = '扫描结果'
TabOrder = 1
object lstReplies: TListBox
Left = 7
Top = 14
Width = 380
Height = 147
Align = alCustom
ImeName = '中文 (简体) - 拼音加加3.11'
ItemHeight = 12
TabOrder = 0
end
end
end
给分吧

接受答案了.

还是有问题啊.....如果把上面代码不是放在主窗口的话(比如新建一个窗口,再把代码放在这个窗口的单元里调用),就会出错:
在扫描过程中按停止扫描或者在扫描结束时,整个窗口就卡住不动了,并且不接受任何消息!!!!!!
闷~~~~~~~~~

没分没人理~~~~~~~~~~~~~~~~~~

上面那段代码在D7上有问题啊...........
执行完任务后或路途中止任务后整个界面就卡住了,动都动不了~~~
谁帮我测试一下,问题解决了再开贴给分......
谢谢啊~~~