Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.07.2016, 19:08   #1
fobbass
 
Регистрация: 25.07.2016
Сообщений: 4
По умолчанию пинг двух серверов

Пинг нескольких серверов и выбрать ip того кто первый откликнулся

PHP код:
 unit Unit1;

interface

uses
  Winapi
.WindowsWinapi.MessagesSystem.SysUtilsSystem.VariantsSystem.ClassesVcl.Graphics,
  
Vcl.ControlsVcl.FormsVcl.DialogsOverbyteIcsWndControlOverbyteIcsPing,
  
Vcl.StdCtrlsVcl.ButtonsVcl.ExtCtrls;
const 
IP='192.168.0.1';

type
  TForm1 
= class(TForm)
    
DisplayMemoTMemo;
    
BitBtn1TBitBtn;
    
BitBtn2TBitBtn;
    
Timer1TTimer;
    
procedure Timer1Timer(SenderTObject);
    
procedure BitBtn2Click(SenderTObject);
    
procedure ondd(sender:TObject);
    
procedure ondd2(sender:TObject);

  private
    { Private 
declarations }
  public
    { Public 
declarations }
  
end;

  
type
    TPingThread 
= class(TThread)
      private
        
FHoststring;
        
FResponseHost string;
        
FPingTPing;
        
procedure PingEchoReply(SenderIcmpTObjectStatusInteger);
      protected
        
procedure Executeoverride;
        
procedure SendPing;
      public
        
property LogSeverIP string read FResponseHost;
        
constructor Create(pHost:string);
    
end;

var
  
Form1TForm1;
  
ping1:TPingThread;
  
ping2:TPingThread;
  
server:string;

implementation

{$R *.dfm}



procedure TForm1.BitBtn2Click(SenderTObject);
begin
  ping1
:=TPingThread.Create(ip);
  
ping2:=TPingThread.Create('20.85.229.104');
  
ping1.OnTerminate:=ondd;
  
ping2.OnTerminate:=ondd2;
  
ping1.Resume;
  
ping2.Resume;
  
repeat
    ping1
.WaitFor;
    
ping2.WaitFor;
    if 
server.Length <> 0 then
    
Break
  
until server.Length <> 0
//дальше коннект и отправка в зависимости от адреса

end;

procedure TForm1.ondd(senderTObject);
begin
DisplayMemo
.Lines.Add('--------begin1----------');
if 
Ping1.FResponseHost.Length <> 0 then
begin
  server 
:= Ping1.FResponseHost;
  
DisplayMemo.Lines.Add('--SERVER-IS-: '+server);
end;
DisplayMemo.Lines.Add('----------End1-----------');
end;

procedure TForm1.ondd2(senderTObject);
begin

DisplayMemo
.Lines.Add('--------begin2----------');
if 
Ping2.FResponseHost.Length <> 0 then
begin
  server 
:= Ping2.FResponseHost;
  
DisplayMemo.Lines.Add('--SERVER-IS-: '+server);
end;
DisplayMemo.Lines.Add('----------End2-----------');
end;


procedure TForm1.Timer1Timer(SenderTObject);
begin
try
  
ping1:=TPingThread.Create(ip);
  
ping2:=TPingThread.Create('29.85.229.104');
  
ping1.OnTerminate:=ondd;
  
ping2.OnTerminate:=ondd2;
finally

end;
end;

TPingThread }

constructor TPingThread.Create(pHoststring);
begin
inherited Create
(True);
 
FHost:= pHost;
end;


procedure TPingThread.Execute;
begin
  SendPing
;
end;

procedure TPingThread.PingEchoReply(SenderIcmpTObjectStatusInteger);
begin
 
if Status=0 then
      FResponseHost 
:= ''
      
else
      
FResponseHost := FHost;
end;

procedure  TPingThread.SendPing;
var
FPing:TPing;
begin
Fping
:=Tping.Create(nil);
try
  
FPing.Address:=FHost;
  
FPing.OnEchoReply:=PingEchoReply;
  
FPing.Timeout := 50;
  
FPing.Ping;
finally
  
FPing.Free;
end;
end;
end
server иногда вообще ничего не возвращает
fobbass вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Пинг-понг mixon-21 JavaScript, Ajax 1 19.01.2014 12:57
Неустойчивый пинг WorldMaster Windows 6 28.04.2013 23:19
Создание внутреннего и внешнего серверов. Создание серверов автоматизации. Ann_Sh Помощь студентам 3 09.10.2011 15:53
Как решить проблему двух серверов? Томбмастер Компьютерное железо 0 30.09.2009 21:49