| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, Ping, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Button1: TButton;
Button3: TButton;
Edit2: TEdit;
Edit1: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
XPManifest1: TXPManifest;
Timer1: TTimer;
RichEdit1: TRichEdit;
Ping1: TPing;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
RichEdit: TRichEdit;
Button5: TButton;
ProgressBar1: TProgressBar;
Button2: TButton;
procedure Button4Click(Sender: TObject);
procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);
procedure Ping1EchoReply(Sender, Icmp: TObject; Error: Integer);
procedure Ping1EchoRequest(Sender, Icmp: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
procedure MyProc(c:Tcolor);
{ Public declarations }
end;
var
Form1: TForm1;
i,j,start,kp,pp,k,h:integer; //kp-êîë. îòðïð. ïàêåòîâ, pp-ïîòåðÿííûõ ïàêåòîâ
p: TPoint;
implementation
{$R *.dfm}
procedure TForm1.Button4Click(Sender: TObject);
begin
pp:=0;
kp:=0;
start:=1;
j:=0;
RichEdit1.Clear ;
label6.Caption :='0,0% ïîòåðü';
richEdit1.SetFocus;
RichEdit1.Lines.Add('Ïîèñê'''+ Edit1.Text +'''');
MyProc(clblack);
ping1.Size:=strToInt(edit2.Text );
ping1.DnsLookup(edit1.Text);
//ping1.Timeout:=StrToInt(edit3.Text);
timer1.Interval:= StrToInt(edit3.Text);
end;
procedure TForm1.Ping1DnsLookupDone(Sender: TObject; Error: Word);
begin
//åñëè ïðîèçîøëà îøèáêà, òî...
if error <>0 then
begin
//âûâåñòè ñîîáùåíèå îá îøèáêå
RichEdit1.Lines.Add('Õîñò íå íàéäåí'''+ Edit1.Text + '''');
MyProc(clblack);
//âûõîä
exit;
end;
//åñëè îøèáîê íå áûëî, òî âûâîäèì â Richedit1 ðåçóëüòàòû ïîèñêà
RichEdit1.Lines.Add('Õîñò '''+ Edit1.text + ''' - '+ping1.DnsResult );
MyProc(clblack);
//óñòîíàâëèâàåì ñâîéñòâî Address êîìïîíåíòà Ping ðàâíûì
//àäðåñó, íàéäåííîìó â áàçå DNS
Ping1.address:= ping1.dnsresult;
//çàïóñêàåì Ping
Timer1.Enabled := true;
end;
procedure TForm1.Ping1EchoReply(Sender, Icmp: TObject; Error: Integer);
begin
if error = 0 then
begin
RichEdit1.Lines.Add('Íå ìîãó âûïîëíèòü îïåðàöèþ Ping: '+Ping1.ErrorString );
MyProc(clred);
pp:=pp+1;
label5.Caption:='Ïîòåðÿíî: '+inttostr(pp);
end;
if error <> 0 then
begin
RichEdit1.Lines.Add('Ïîëó÷åíî '+ IntTostr(Ping1.Reply.DataSize)+
' áàéò îò '+ping1.HostIP + ' çà ' + intToStr(Ping1.Reply.RTT) + ' ìèëëèñåêóíä');
// MyProc(StrToInt('$'+'ff0000'));
MyProc(clblack);
end;
end;
procedure TForm1.Ping1EchoRequest(Sender, Icmp: TObject);
begin
if start= 1 then
begin
RichEdit1.Lines.Add('Îòïðàâëåíî' + intTostr(Ping1.Size) + ' áàéòîâ íà ' + Ping1.HostName );
MyProc(clblack);
start:=0;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
start:=0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ping1.ping;
kp:=kp+1;
label4.Caption:='Îòïðàâëåíî ïàêåòîâ: '+inttostr(kp);
if (pp*100)/kp<1 then
begin
label6.Caption :=Format('%.1f',[(pp*100)/kp])+'%'+' ïîòåðü';
end
else
label6.Caption :=IntToStr(round((pp*100)/kp))+'%'+' ïîòåðü';
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Timer1.Enabled := false;
edit1.SetFocus;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
ip:PAnsiChar;
begin
ip:=PAnsiChar('ping '+edit1.Text+' -t'+' -l '+edit2.Text+' -w '+edit3.Text);
WinExec(ip,SW_SHOW);
end;
end.
|
|
работает! 
