Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Потоки и пинг [D7, WinXP]


Страницы:   1 2 3 4

S46E ©   (2006-07-18 08:36:00) 

Задача: паралельный пинг всех ip в списке Hosts без зависания программы.

Код который имеется:
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
 IdIcmpClient;

type
 TForm1 = class(TForm)
   Icmp: TIdIcmpClient;
   Button1: TButton;
   hosts: TMemo;
   Log: TMemo;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

TNew = class(TThread)
 private
   n: integer;
   procedure AddStr;
   { Private declarations }
 protected
 procedure Execute; override;
end;

var
 Form1: TForm1;
 New, New2: TNew;

implementation

{$R *.dfm}

procedure TNew.Execute;
begin
Synchronize(AddStr);
end;

procedure TNew.AddStr;
begin
Form1.Icmp.Host:=Form1.Hosts.Lines[n];
Form1.Icmp.Ping('');
Form1.Log.Lines.Add('Ping '+Form1.Icmp.ReplyStatus.FromIpAddress+'______RTTime: '+InttoStr(Form1.Icmp.ReplyStatus.MsRoundTripTime)+'_______TTL: '+InttoStr(Form1.Icmp.ReplyStatus.TimeToLive));
end;

{---}

procedure TForm1.Button1Click(Sender: TObject);
begin
New := TNew.Create(true);
New.FreeOnTerminate := true;
New.Priority := tpNormal;
New2 := TNew.Create(true);
New2.FreeOnTerminate := true;
New2.Priority := tpNormal;
New.n:=0;
New2.n:=1;
New.Resume;
New2.Resume;
end;

end.

S46E   (2006-07-21 14:46:00) [21]


...

TPingThread=class(Tthread)
private
  FHost: String;
  FResult: String;
  function Pinghost: string;
protected
  procedure Execute; override;
public
  constructor Create(Host: String);
end;

...

procedure TForm1.Button1Click(Sender: TObject);
var
N: integer;
begin
For N:=0 to Hosts.Lines.Count-1 do
 begin
   with TPingThread.Create(Hosts.Lines[N]) do
   begin
     OnTerminate := PingTerminated;
     //Resume;
   end;
 end;
end;

{ TPingThread }

constructor TPingThread.Create(Host: String);
begin
inherited Create(True);
FreeOnTerminate := True;
FHost := Host;
Resume;
end;

procedure TPingThread.Execute;
begin
FResult := PingHost;
end;

function TPingThread.Pinghost: string;
var
Pinger: TIdIcmpClient;
begin
Result := 'Îøèáêà';
Pinger := TIdIcmpClient.Create(nil);
Pinger.Host := FHost;
Pinger.Ping('');
Result:='Ïèíã '+FHost+'______Âðåìÿ îòâåòà: '+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+' ìñ_______TTL: '+InttoStr(Pinger.ReplyStatus.TimeToLive);
if Pinger.ReplyStatus.FromIpAddress='0.0.0.0' then Result:=FHost+' íå îòâå÷àåò (òàéì-àóò 5 ñåêóíä)';
end;

procedure TForm1.PingTerminated(Sender: TObject);
var
PR: TPingThread;
begin
PR := TPingThread(Sender);
Log.Lines.Add(PR.FResult);
end;

...


Не очень качественно пингует мертвые хосты. Если в списке помимо реал-мертвых есть хоть один реал-живой то в логе все оказываются живыми. Если нету - то все ок. Т.е. достаточно одного реал-живого хоста в списке - выводит всех как живых без всяких раздумий. Раздумия идут если все реал-мертвые, 5 сек:)

Мне кажется или в этом коде много масла масленого?

S46E   (2006-07-21 14:39:00) [22]

А если
OnTerminate := PingTerminated;
          запихать собстно в Create?

Пусик   (2006-07-21 14:17:00) [23]


> isasa ©   (21.07.06 10:29) [52]
> Пусик ©   (21.07.06 09:49) [51]А присваивать событие, при
> работающем потоке, логично?А вдруг не успеет?


Согласна, упустила из виду.
Хотя в любом случае обработчик успеет в данном случае присоиться раньше, но для общего случая лучше не использовать его так.

Может даже лучше будет изменить(или добавить еще один) конструктор, и в нем передавать адрес обработчика этого события.

StriderMan   (2006-07-21 12:14:00) [24]


> !_SM_!   (21.07.06 00:05) [47]
> Оказывается, всамом деле, если в PingTerminate делать Free
> Sender'у то все виснет.

Я думаю происходит следующее:

деструкторе TThread вызывает обработчик OnTerminate а в нем опять вызывается деструктор. получается бесконечная рекурсия

S46E   (2006-07-21 11:24:00) [25]

А, понял. Блин..

S46E   (2006-07-21 11:23:00) [26]

Есть мнение что OnTerminate это обработчик который срабатывает после того как пинг сам добровольно завершится, на то он и 'On':)

isasa   (2006-07-21 10:29:00) [27]

Пусик ©   (21.07.06 09:49) [51]
А присваивать событие, при работающем потоке, логично?
А вдруг не успеет?

with TPingThread.Create('10.0.0.1') do <- Тут уже запустили
begin                                            <- А вот тут он уже завершился, быстро пинганул.
  OnTerminate := PingTerminated;
end;

Пусик   (2006-07-21 09:49:00) [28]

>isasa ©
Сорри, невнимательно прочитала пост.

Не соглашусь, что перенести Resume из конструктора в основной поток - логичнее. Не видно в этом смысла.

Пусик   (2006-07-21 09:44:00) [29]


> isasa ©   (21.07.06 09:07) [48]
> !_SM_!   (21.07.06 00:05) [47]Оказывается, всамом деле,
> если в PingTerminate делать Free Sender'у то все виснет.
> Оно радо?FreeOnTerminate := True; ?procedure TForm1.Button1Click(Sender:
>  TObject);begin with TPingThread.Create('10.0.0.1') do begin
>   OnTerminate := PingTerminated;   Resume;   <- Перенести
> из Create сюда, так логичнее :) end;end;


OnTerminate возникает после иокончания выполнения поточной функции.
Resume-же как раз и позволяет начать выполнение этой функции. В обработчике события OnTerminate Resume просто бессмысленно выполнять.

isasa   (2006-07-21 09:09:00) [30]

Оно надо?

isasa   (2006-07-21 09:07:00) [31]

!_SM_!   (21.07.06 00:05) [47]
Оказывается, всамом деле, если в PingTerminate делать Free Sender'у то все виснет.
Оно радо?
FreeOnTerminate := True; ?


procedure TForm1.Button1Click(Sender: TObject);
begin
with TPingThread.Create('10.0.0.1') do
begin
  OnTerminate := PingTerminated;
  Resume;   <- Перенести из Create сюда, так логичнее :)
end;
end;

!_SM_!   (2006-07-21 00:05:00) [32]


> StriderMan ©   (20.07.06 23:07) [46]

Спасибо.
И как же в таком случае экземпляр убить в другой подпрограмме
т.е. по нажатию кнопки он (поток) создается, а на свое (потока) завершение, в другом месте, как убить экземпляр. Ну это все из выше приведенного... Или это опять чушь?
Оказывается, всамом деле, если в PingTerminate делать Free Sender'у то все виснет.

StriderMan   (2006-07-20 23:07:00) [33]


> А там, походу, и не надо Free делать, да и вооще наверное
> не надо его делать... так как переменная локальная то она
> убьется и память освабодится при выходе... Или не так?

нет не так. переменная убъется, а экземпляр класса останется в памяти.

!_SM_!   (2006-07-20 20:43:00) [34]


> S46E ©   (20.07.06 17:52) [27]
> не помогает:(>> Пробовал вставлять TNew(Sender).Free в PingTerminate,
>  не понимает синтаксис:)поправка: программа просто виснет.
>  как и при TNew(Sender).Terminate

А там, походу, и не надо Free делать, да и вооще наверное не надо его делать... так как переменная локальная то она убьется и память освабодится при выходе... Или не так?

Пусик   (2006-07-20 19:02:00) [35]

В конструкторе забыла Resume:

constructor TPingThread.Create(Host: String);
begin
 inherited Create(True);
 FreeOnTerminate := True;
 FHost := Host;
 Resume;
end;

Пусик   (2006-07-20 19:01:00) [36]

>!_SM_!
Вот схематично код:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type

 TPingThread=class(Tthread)
 private
   FHost: String;
   FResult: Boolean;
   function Pinghost: Boolean;
 protected
   procedure Execute; override;
 public
   constructor Create(Host: String);
 end;

 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   procedure PingTerminated(Sender: TObject);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 with TPingThread.Create('10.0.0.1') do
 begin
   OnTerminate := PingTerminated;
 end;
end;

{ TPingThread }

constructor TPingThread.Create(Host: String);
begin
 inherited Create(True);
 FreeOnTerminate := True;
 FHost := Host;
end;

procedure TPingThread.Execute;
begin
 FResult := PingHost;
end;

function TPingThread.Pinghost: Boolean;
var
 Pinger: TPinger;
begin
 Result := False;
 Pinger := TPinger.Create(nil);
 Pinger.Host := FHost;
// ...
//здесь пингуем.
//if Ok then Result := True;
end;

procedure TForm1.PingTerminated(Sender: TObject);
var
 PR: TPingThread;
begin
 PR := TPingThread(Sender);
 if PR.FResult
   then Memo1.Lines.Add(PR.FHost+' OK')
   else Memo1.Lines.Add(PR.FHost+' FAILED')
end;

end.

!_SM_!   (2006-07-20 18:45:00) [37]

>then ssory...
Sorry, then sorry...

!_SM_!   (2006-07-20 18:18:00) [38]


> Да, просто "Sender.Free;"

then ssory...

S46E   (2006-07-20 18:18:00) [39]

>> Ну и тудаже
>> if (Sender is TNew) then Sender.Fre;
Ну и так же виснет=)

!_SM_!   (2006-07-20 18:16:00) [40]


> isasa ©   (20.07.06 18:14) [37]

Ну и тудаже
if (Sender is TNew) then Sender.Fre;

Страницы:   1 2 3 4

Наверх

Титульная страница Поиск, карта сайта Написать письмо