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

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

H
带托盘图标的服务程序,服务运行后为什么没有托盘图标(100)
2
回复
20
查看
3K
appfirst
A
Y
为什么我接收不到存储过程返回的错误提示啊！！ 大家来看看 帮下忙吧 谢谢大家了(100)
回复
9
查看
847
Yang.SZ
Y
楚
请帮助修改一个简单小学生计算程序,目的想实现,当在EDIT里结果对话,label3:提示"对".不对的话提示"重新输入"(50)
回复
5
查看
661
楚辞
楚
完
多线程查询数据库，偶尔会丢掉一个线程。但大部分时候是正常。苦恼中。 (问题解决，有待优化，欢迎发表意见，顶者有分，晚上结贴)(100)
回复
11
查看
1K
完美动物
完
H
为什么我一个函数在主线程工作没问题再开个线程运行程序就崩溃了啊！(100)
回复
3
查看
699
hksoobe
H
顶部