大家帮我看看我这个多线程ping程序，为什么得到的结果不对。 ( 积分: 100 )

  • 主题发起人 主题发起人 lhjiang
  • 开始时间 开始时间
L

lhjiang

Unregistered / Unconfirmed
GUEST, unregistred user!
部分程序如下，执行定时ping的线程的时候，明明是可以ping通的机器，却返回ping不通的消息。
procedure TForm_addtest.Ping1DnsLookupDone(Sender: TObject;
Error: Word);
begin
Ping1.Address := Ping1.DnsResult;
Ping1.Ping;
end;

procedure TForm_addtest.Ping1EchoReply(Sender, Icmp: TObject;
Status: Integer);
begin

if Status <> 0 then
begin
url_memo.Text:='Received ' + IntToStr(Ping1.Reply.DataSize) +' bytes from ' + Ping1.HostIP +' in ' + IntToStr(Ping1.Reply.RTT) + ' msecs';
test_status:='ok';
end
else
{ Failure }
test_status:='bad';
url_memo.Text:='Cannot ping host (' + Ping1.HostIP + ') : ' +Ping1.ErrorString +'. Status = ' + IntToStr(Ping1.Reply.Status);
end;
procedure tmythread.execute;
begin
freeonterminate:=true;
synchronize(giveanswer);
end;
procedure tmythread.giveanswer;
begin
form_addtest.Ping1.Ping;
form_addtest.url_related.Text :=form_addtest.url_related.Text+IntToStr(form_addtest.Ping1.Reply.Status);
end;

procedure TForm_addtest.Timer1Timer(Sender: TObject);
begin
//在定时中触发线程ping执行
if formatdatetime('hh:mm:ss',now)='11:16:30' then
begin
exc:=true;
tmythread.Create(false);
end;
end;
 
部分程序如下，执行定时ping的线程的时候，明明是可以ping通的机器，却返回ping不通的消息。
procedure TForm_addtest.Ping1DnsLookupDone(Sender: TObject;
Error: Word);
begin
Ping1.Address := Ping1.DnsResult;
Ping1.Ping;
end;

procedure TForm_addtest.Ping1EchoReply(Sender, Icmp: TObject;
Status: Integer);
begin

if Status <> 0 then
begin
url_memo.Text:='Received ' + IntToStr(Ping1.Reply.DataSize) +' bytes from ' + Ping1.HostIP +' in ' + IntToStr(Ping1.Reply.RTT) + ' msecs';
test_status:='ok';
end
else
{ Failure }
test_status:='bad';
url_memo.Text:='Cannot ping host (' + Ping1.HostIP + ') : ' +Ping1.ErrorString +'. Status = ' + IntToStr(Ping1.Reply.Status);
end;
procedure tmythread.execute;
begin
freeonterminate:=true;
synchronize(giveanswer);
end;
procedure tmythread.giveanswer;
begin
form_addtest.Ping1.Ping;
form_addtest.url_related.Text :=form_addtest.url_related.Text+IntToStr(form_addtest.Ping1.Reply.Status);
end;

procedure TForm_addtest.Timer1Timer(Sender: TObject);
begin
//在定时中触发线程ping执行
if formatdatetime('hh:mm:ss',now)='11:16:30' then
begin
exc:=true;
tmythread.Create(false);
end;
end;
 
什么控件？
是不是权限的问题，就像TIdIcmpClient控件的ping必须有Administrators的权限
 
帮你提一下
 
了解了一点
 
把代码都帖出来吧
 
全部代码：写的有点乱的，刚学delphi不久
unit addtest;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, Grids, DBGrids, Spin, Ping, DB,
DBTables, DBGridEh,WinSock;
type
TForm_addtest = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
test_name: TEdit;
Label4: TLabel;
url_memo: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label5: TLabel;
ComboBox2: TComboBox;
Label6: TLabel;
ComboBox3: TComboBox;
Label7: TLabel;
Label8: TLabel;
ComboBox4: TComboBox;
Label9: TLabel;
ComboBox_year: TComboBox;
Label10: TLabel;
ComboBox_month: TComboBox;
Label11: TLabel;
ComboBox_day: TComboBox;
Label12: TLabel;
GroupBox2: TGroupBox;
Label13: TLabel;
ComboBox5: TComboBox;
Label19: TLabel;
url_related: TEdit;
Button1: TButton;
OpenDialog1: TOpenDialog;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
Label20: TLabel;
ComboBox_depend: TComboBox;
Panel1: TPanel;
PageControl2: TPageControl;
ping_sheet: TTabSheet;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
ping_addr: TEdit;
ping_timeout: TEdit;
ping_size: TEdit;
ping_nums: TEdit;
ping_deadline: TSpinEdit;
url_sheet: TTabSheet;
Label27: TLabel;
url_address: TEdit;
Label28: TLabel;
url_timeout: TSpinEdit;
Label29: TLabel;
Button2: TButton;
Label30: TLabel;
ComboBox7: TComboBox;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Ping1: TPing;
Label2: TLabel;
ComboBox_enable: TComboBox;
test_id: TEdit;
DataSource1: TDataSource;
Query1: TQuery;
ComboBox_hour: TComboBox;
Label3: TLabel;
ComboBox_min: TComboBox;
Label14: TLabel;
DBGridEh1: TDBGridEh;
DBGridEh2: TDBGridEh;
DBGridEh3: TDBGridEh;
ComboBox_alert: TComboBox;
Timer1: TTimer;
procedure ComboBox7Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Ping1DnsLookupDone(Sender: TObject;
Error: Word);
procedure Ping1EchoReply(Sender, Icmp: TObject;
Status: Integer);
procedure Button5Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
tmythread = class(Tthread)
private
//FTestData: TTestData;
//function Test;
procedure OutputRes;
protected
procedure execute;
override ;
procedure giveanswer;
end;
var
Form_addtest: TForm_addtest;
test_status:string;
test_id:string;
var
exc:boolean;
i:integer;

implementation
uses frm_add_advance, dbmodule, maifrm;
{$R *.dfm}
function PingHost(HostIP: String): Boolean;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize: Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation;
end;
TIcmpCreateFile = function: THandle;
stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean;
stdcall;
TIcmpSendEcho = function(IcmpHandle:THandle;
DestinationAddress: DWORD;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord;
stdcall;
var
hICMP : THandle;
hICMPdll : THandle;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;
pIPE : PIcmpEchoReply;// ICMP Echo reply buffer
FIPAddress : DWORD;
FSize : DWORD;
FTimeOut : DWORD;
BufferSize : DWORD;
pReqData,pRevData:PChar;
MyString:string;
begin
Result := False;
hICMPdll := LoadLibrary('icmp.dll');
if hICMPdll = 0 then
exit;
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
hICMP := IcmpCreateFile;
if (hICMP = INVALID_HANDLE_VALUE) then
exit;
FIPAddress := inet_addr(PChar(HostIP));
MyString := 'Hello,World';
//send data buffer
pReqData := PChar(MyString);
FSize := 40;
//receive data buffer
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
GetMem(pRevData,FSize);
pIPE^.Data := pRevData;
FTimeOut := 4000;
try
Result := IcmpSendEcho(hICMP, FIPAddress, pReqData,
Length(MyString),nil,pIPE,BufferSize,FTimeOut)>0;
finally
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPdll);
FreeMem(pRevData);
FreeMem(pIPE);
end;
end;

procedure TForm_addtest.ComboBox7Change(Sender: TObject);
begin
pagecontrol2.ActivePageIndex:=combobox7.ItemIndex;
end;

procedure TForm_addtest.Button2Click(Sender: TObject);
begin
fm_addtest_advance.Show;
end;

procedure TForm_addtest.Button3Click(Sender: TObject);
begin
// Ping1.DnsLookup(ping_addr.Text);
// Ping1.Ping;
datamodule1.Query1.Close;
datamodule1.Query1.SQL.Clear;
//插入test_id_tbl表
datamodule1.Query1.SQL.Add('insert into test_id_tbl values(seq_testid.nextval,:test_name,:test_type,:memo,:related_url,:regular_id,:alert_status,:alert_action,:log_mod,:common_log,:enabled,sysdate,sysdate,:test_depend,:test_depend_id)');
datamodule1.Query1.ParamByName('test_name').Value:=test_name.Text;
datamodule1.Query1.ParamByName('test_type').Value:=combobox7.Text;
datamodule1.Query1.ParamByName('memo').Value:=url_memo.Text;
datamodule1.Query1.ParamByName('related_url').Value:=url_related.Text;
datamodule1.Query1.ParamByName('regular_id').Value:=pagecontrol1.ActivePage.Caption;
datamodule1.Query1.ParamByName('alert_status').Value:=combobox_alert.ItemIndex;
datamodule1.Query1.ParamByName('alert_action').Value:=combobox5.Text;
datamodule1.Query1.ParamByName('log_mod').Value:=combobox7.Text;
datamodule1.Query1.ParamByName('common_log').Value:='';
datamodule1.Query1.ParamByName('enabled').Value:=combobox_enable.Text;
// datamodule1.Query1.ParamByName('create_time').AsDate:=to_date('''+FromatdateTime('YYYY-MM-DD',NOW)+''',''yyyy-mm-dd'');
// datamodule1.Query1.ParamByName('modify_time').AsDate:=to_date('''+FromatdateTime('YYYY-MM-DD',NOW)+''',''yyyy-mm-dd'');
//是否有测试依赖
if combobox_depend.
Text <> '' then
begin
datamodule1.Query1.ParamByName('test_depend_id').Value:=combobox_depend.
Text;
datamodule1.Query1.ParamByName('test_depend').Value:='true';
end
else
begin
datamodule1.Query1.ParamByName('test_depend').Value:='false';
datamodule1.Query1.ParamByName('test_depend_id').value:='';
end;

datamodule1.Query1.ExecSQL;
datamodule1.Query1.Close;
//获得test_id
{
datamodule1.Query2.Close;
datamodule1.Query2.Database.Connected:=false;
datamodule1.Query2.Database.Connected:=True;
datamodule1.Query2.SQL.Clear;
datamodule1.Query2.SQL.Add('select max(test_id) from test_id_tbl');
datamodule1.Query2.Open;
if datamodule1.Query2.RecordCount>0 then
begin
test_id:=datamodule1.Query2.DataSource.DataSet.Fields.Fields[0].AsString;
end;
}
{ //插入结果表test_result_tbl
datamodule1.Query1.Close;
datamodule1.Query1.SQL.Clear;
datamodule1.Query1.SQL.Add('insert into test_result_tbl values(seq_testid.CURRVAL,:test_status,:test_reply,:test_method,:alive,:dead,:unknown,:total_time,:alive_time,:dead_time,:tests,:passed_tests,:dead_tests,:average_time,:min_time,:max_time,sysdate,sysdate,sysdate)');
//datamodule1.Query1.ParamByName('test_id').Value:=test_id;
datamodule1.Query1.ParamByName('test_status').Value:=test_status;
datamodule1.Query1.ParamByName('test_reply').Value:=ping1.Reply.RTT;
datamodule1.Query1.ParamByName('test_method').Value:=Combobox7.Text;
datamodule1.Query1.ParamByName('alive').Value:=100;
datamodule1.Query1.ParamByName('dead').Value:=0;
datamodule1.Query1.ParamByName('unknown').Value:=0;
datamodule1.Query1.ParamByName('total_time').Value:=1;
datamodule1.Query1.ParamByName('alive_time').Value:=1;
datamodule1.Query1.ParamByName('dead_time').Value:=0;
datamodule1.Query1.ParamByName('tests').Value:=1;
datamodule1.Query1.ParamByName('passed_tests').Value:=1;
datamodule1.Query1.ParamByName('dead_tests').Value:=1;
datamodule1.Query1.ParamByName('average_time').Value:=0;
datamodule1.Query1.ParamByName('min_time').Value:=1;
datamodule1.Query1.ParamByName('max_time').Value:=1;
// datamodule1.Query1.ParamByName('change_time').Value:='';
// datamodule1.Query1.ParamByName('start_time').Value:='';
// datamodule1.Query1.ParamByName('end_time').Value:='';
datamodule1.Query1.ExecSQL;
}
//插入ping_properties_tbl表
if ( combobox7.ItemIndex = 0 ) then
begin
datamodule1.Query1.Close;
datamodule1.query1.sql.clear;
datamodule1.Query1.SQL.Add('insert into ping_properties_tbl values(seq_testid.CURRVAL,:test_url,:timeout,:packet_size,:packets,:deadline)');
// datamodule1.Query1.ParamByName('test_id').Value:=test_id;
datamodule1.Query1.ParamByName('test_url').Value:=ping_addr.Text;
datamodule1.Query1.ParamByName('timeout').Value:=ping_timeout.Text;
datamodule1.Query1.ParamByName('packet_size').Value:=ping_size.Text;
datamodule1.Query1.ParamByName('packets').Value:=ping_nums.Text;
datamodule1.Query1.ParamByName('deadline').Value:=ping_deadline.Text;
datamodule1.Query1.ExecSQL;
// datamodule1.Query1.Close;
end
else
//否则插入url_properties_tbl表
begin
datamodule1.Query1.Close;
datamodule1.query1.sql.clear;
datamodule1.Query1.SQL.Add('insert into url_properties_tbl values(seq_testid.CURRVAL,:test_url,:timeout,:advanced_set)');
//datamodule1.Query1.ParamByName('test_id').Value:=test_id;
datamodule1.Query1.ParamByName('test_url').Value:=url_address.Text;
datamodule1.Query1.ParamByName('timeout').Value:=url_timeout.Text;
datamodule1.Query1.ParamByName('advanced_set').Value:='false';
datamodule1.Query1.ExecSQL;
// datamodule1.Query1.Close;
end;
//是常规日程
if pagecontrol1.ActivePageIndex=0 then
begin
datamodule1.Query1.Close;
datamodule1.query1.sql.clear;
datamodule1.Query1.SQL.Add('insert into regular_tbl values(seq_testid.CURRVAL,:regular_schedule,:hour,:minute)');
datamodule1.Query1.ParamByName('regular_schedule').Value:=combobox4.Text;
datamodule1.Query1.ParamByName('hour').Value:=combobox2.Text;
datamodule1.Query1.ParamByName('minute').Value:=combobox3.Text;
datamodule1.Query1.ExecSQL;
end
else
//非常规日程
begin
datamodule1.Query1.Close;
datamodule1.query1.sql.clear;
datamodule1.Query1.SQL.Add('insert into irregular_tbl values(seq_testid.CURRVAL,:year,:month,:day,:hour,:minute)');
datamodule1.Query1.ParamByName('year').Value:=combobox_year.Text;
datamodule1.Query1.ParamByName('month').Value:=combobox_month.Text;
datamodule1.Query1.ParamByName('day').Value:=combobox_day.Text;
datamodule1.Query1.ParamByName('hour').Value:=combobox_hour.Text;
datamodule1.Query1.ParamByName('minute').Value:=combobox_min.Text;
datamodule1.Query1.ExecSQL;
end;
// form_addtest.Close;
mainfrm.DBGridEh1.DataSource.DataSet.Active:=false;
mainfrm.DBGridEh1.DataSource.DataSet.Active:=true;
//threed part
// exc:=true;
// tmythread.Create(false);
end;

procedure TForm_addtest.Ping1DnsLookupDone(Sender: TObject;
Error: Word);
begin
Ping1.Address := Ping1.DnsResult;
Ping1.Ping;
end;

procedure TForm_addtest.Ping1EchoReply(Sender, Icmp: TObject;
Status: Integer);
begin

if Status <> 0 then
begin
url_memo.Text:='Received ' + IntToStr(Ping1.Reply.DataSize) +' bytes from ' + Ping1.HostIP +' in ' + IntToStr(Ping1.Reply.RTT) + ' msecs';
test_status:='ok';
end
else
{ Failure }
test_status:='bad';
url_memo.Text:='Cannot ping host (' + Ping1.HostIP + ') : ' +Ping1.ErrorString +'. Status = ' + IntToStr(Ping1.Reply.Status);
end;

procedure TForm_addtest.Button5Click(Sender: TObject);
begin
form_addtest.Close;
end;

procedure TForm_addtest.FormShow(Sender: TObject);
begin
{ Query1.Close;
query1.sql.clear;
Query1.SQL.Add('select * from test_id_tbl where test_id=:test_id');
Query1.ParamByName('test_id').Value:=test_id.Text;
Query1.Open;
// if not Query1.DataSource.DataSet.EOF then
// begin
// query1.DataSource.DataSet.First;
test_name.Text:=Query1.DataSource.DataSet.Fields.Fields[1].Value;
// end;
}
end;
procedure tmythread.execute;
begin
freeonterminate:=true;
synchronize(giveanswer);
sleep(10);
// form_addtest.Ping1.DnsLookup(form_addtest.ping_addr.Text);
// form_addtest.Ping1.Ping;
// form_addtest.url_related.Text :=form_addtest.url_related.Text+IntToStr(form_addtest.Ping1.Reply.Status);
// if formatdatetime('hh:mm:ss',now)='15:36:00' then
// begin
{ if PingHost('192.168.0.108') then
begin
// if exc=false then
break;
showmessage('ping is ok');
form_addtest.url_related.Text :=form_addtest.url_related.text+'ping is ok';
end
else
form_addtest.url_related.Text :='ping is bad';
// end;
}
end;

procedure tmythread.giveanswer;
begin
// form_addtest.Ping1.DnsLookup(form_addtest.ping_addr.Text);
// form_addtest.Ping1.Address:=form_addtest.ping_addr.Text;
form_addtest.Ping1.Ping;
form_addtest.url_related.Text :=form_addtest.url_related.Text+IntToStr(form_addtest.Ping1.Reply.Status);
end;

procedure TForm_addtest.Timer1Timer(Sender: TObject);
//var NewThread:tmythread;
begin
//在定时中触发线程ping执行
if formatdatetime('hh:mm:ss',now)='11:16:30' then
begin
exc:=true;
tmythread.Create(false);
end;
end;
procedure tmythread.OutputRes;
begin
//....
end;
end.
 
//网上的一个Ping程序
www.hitekersoft.com/download/Ping.rar
 
不能下载的
 
在多线程我调用PingHost函数可以的，结果可以ping通局域网的机器，但是我用ping组件就不行。
 
重新下载
www.hitekersoft.com/download/Ping.rar
 
您必须登录或注册才可回复。

Similar threads

W
进程高手帮忙看看！(20分)
回复
2
查看
279
lp414
L
Y
请大家帮忙看看这段有关多线程的代码(100分)
回复
5
查看
330
yyk518
Y
Q
多线程问题，请教。(50分)
回复
4
查看
370
穿越沦陷的爱
穿
B
IDFTP的多线程扫描问题？（200分相送）(100分)
回复
4
查看
423
bamfk1023
B
S
老大们帮帮我哦！！！线程怎样挂起的？？？？？？？？？？？(50分)
回复
6
查看
260
sanlanggugu
S
后退
顶部