Форум: "Начинающим";
Текущий архив: 2006.08.13;
Скачать: [xml.tar.bz2];

Вниз

Потоки и пинг   Найти похожие ветки 

← →
S46E ©   (2006-07-18 08:36) [0]

Задача: паралельный пинг всех 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.

---

← →
Dmitrij_K   (2006-07-18 10:29) [1]

Синхронизация происходит в основном потоке.

---

← →
isasa ©   (2006-07-18 10:33) [2]

Раздели(выведи из синхронизации) сам пинг и вывод его результатов.
Кстати здесь неплохо(для вывода) работает SendMessage.

---

← →
DrPass ©   (2006-07-18 10:34) [3]

При использовании Syncronize ни о какой параллельности речи быть не может - все потоки будут ждать друг друга в очереди. Создавай экземпляр TIdICMP динамически в execute потока, и с его помощью пингуй

---

← →
Piter ©   (2006-07-18 18:19) [4]

S46E ©   (18.07.06 8:36)
procedure TNew.Execute;
begin
Synchronize(AddStr);
end;

Блин... Неужели такие шедевры будут всегда...

---

← →
DrPass ©   (2006-07-18 18:38) [5]

> Неужели такие шедевры будут всегда...

По крайней мере, до тех пор, пока не пожелтеет и рассыпется последний томик Архангельского...

---

← →
S46E ©   (2006-07-18 19:08) [6]

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

---

← →
Ketmar ©   (2006-07-18 20:45) [7]

>S46E ©   (18.07.06 19:08) [6]
сильно советую не читать жёлтой литературы от подозрительных авторов при этом. лучше родной help -- там всё доступно описано. да ещё и примеры дают в каталоге Demos.

---

← →
S46E ©   (2006-07-20 14:58) [8]

Сейчас код представляет собой:
unit Unit1;

interface

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

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

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

TPinger = class(TIdIcmpClient)
 private
   { Private declarations }
 protected
end;

var
 Form1: TForm1;
 New: TNew;
 Pinger: TPinger;

implementation

{$R *.dfm}

procedure TNew.Execute;
var
s: string;
begin
Pinger := TPinger.Create(Form1);
Pinger.Host:=Form1.Hosts.Lines[New.n];
Pinger.Ping("");
s:=Pinger.ReplyStatus.FromIpAddress;
if s="0.0.0.0" then s:=Form1.Hosts.Lines[New.n]+" не отвечает";
Form1.Log.Lines.Add("Ping "+s+"______RTTime: "+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+"_______TTL: "+InttoStr(Pinger.ReplyStatus.TimeToLive));
end;

{---}

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
 New := TNew.Create(true);
 New.n:=i;
 New.FreeOnTerminate := true;
 New.Priority := tpNormal;
 New.Resume;
 end;
end;

end.

Проходит цикл и выводит многократный пинг одного и того же адреса, нежели пинг каждого из списка..в чем суть?:)

---

← →
StriderMan ©   (2006-07-20 15:09) [9]

> var
>  Form1: TForm1;
>  New: TNew;
>  Pinger: TPinger;
>
> implementation
>
> {$R *.dfm}
>
> procedure TNew.Execute;
> var
> s: string;
> begin
> Pinger := TPinger.Create(Form1);
> Pinger.Host:=Form1.Hosts.Lines[New.n];


жуткий бред!!!!

Pinger у тебя глобальная перменная, и каждый поток ее переназначает, что будет - одному богу известно. опиши ее в процедуре .Execute. После использования - разрушай, причем в конструкции try..finally. И вконструкторе не надо указывать Form1, укажи nil.

---

← →
S46E ©   (2006-07-20 15:15) [10]

вот такой у меня бредогенератор..что-ж, спасибо.

---

← →
S46E ©   (2006-07-20 15:21) [11]

procedure TNew.Execute;
var
s: string;
Pinger: TPinger;
begin
Pinger := TPinger.Create(nil);
Pinger.Host:=Form1.Hosts.Lines[New.n];
Pinger.Ping("");
s:=Pinger.ReplyStatus.FromIpAddress;
if s="0.0.0.0" then s:=Form1.Hosts.Lines[New.n]+" íå îòâå÷àåò";
Form1.Log.Lines.Add("Ping "+s+"______RTTime: "+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+"_______TTL: "+InttoStr(Pinger.ReplyStatus.TimeToLive));
 try
 Pinger.Free
 finally
 end;
end;

{---}

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
 New := TNew.Create(true);
 New.n:=i;
 New.FreeOnTerminate := true;
 New.Priority := tpNormal;
 New.Resume;
 end;
end;

результат правда тот же)) в каждой строке выходит пинг последнего хоста в списке.

---

← →
StriderMan ©   (2006-07-20 15:22) [12]

> S46E ©   (20.07.06 15:15) [10]

пардон за грубость :)

получилось что-нибудь?

Кстати, зачем создавать класс TPinger который полностью повторяет предка?

---

← →
S46E ©   (2006-07-20 15:26) [13]

> Кстати, зачем создавать класс TPinger который полностью повторяет предка?
Блин. Я ж думал еще зачем это..моя невнимательность. Думал как создать "динамически"? Посмотрел как создается поток и так же создал клиент..нада убрать. лишнее.

---

← →
StriderMan ©   (2006-07-20 15:29) [14]

> результат правда тот же))

1. То что я писал по поводу переменной Pinger касается и переменной New. объяви ее в обработчике кнопки.
2.
> Pinger.Host:=Form1.Hosts.Lines[New.n];

Pinger.Host:=Form1.Hosts.Lines[n];(New - не надо. класс и так знает что у него есть поле "n")
3.
>  try
>  Pinger.Free
>  finally
>  end;

все объекты разрушаются/создаются по такой схеме:
obj := TObject.Create;
try
 ... здесь все действия с объектом
finally
 obj.Free;
end;

---

← →
S46E ©   (2006-07-20 15:39) [15]

Да, спасибо, все работает !
Теперь уже другая проблемка - лог формируется коряво + если пинг засел на 5 секунд(т.е. не пингуется) то в логе машина пишет сразу пинг того кто пингуется вместо него. т.е. например список:
192.168.2.1 (on)
192.168.2.244 (off)
то в логе без промидлений выходит:
Ping 192.168.2.1______RTTime: 0_______TTL: 64
Ping 192.168.2.1______RTTime: 0_______TTL: 64

Есть мнение что это связано с потоками.

---

← →
S46E ©   (2006-07-20 15:41) [16]

procedure TNew.Execute;
var
s: string;
Pinger: TIdIcmpClient;
begin
Pinger := TIdIcmpClient.Create(nil);
 try
 Pinger.Host:=Form1.Hosts.Lines[n];
 Pinger.Ping("");
 s:=Pinger.ReplyStatus.FromIpAddress;
 if s="0.0.0.0" then s:=Form1.Hosts.Lines[n]+" íå îòâå÷àåò";
 Form1.Log.Lines.Add("Ping "+s+"______RTTime: "+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+"_______TTL: "+InttoStr(Pinger.ReplyStatus.TimeToLive));
 finally
 Pinger.Free
 end;
end;

{---}

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
New: TNew;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
 New := TNew.Create(true);
 New.n:=i;
 New.FreeOnTerminate := true;
 New.Priority := tpNormal;
 New.Resume;
 end;
end;

Извиняюсь за "промидлений".

---

← →
StriderMan ©   (2006-07-20 15:51) [17]

Я думаю сюда надо копать

ИзСправки:

Call any methods that access a VCL component and update a form only from within the main VCL thread by passing them to the Synchronize method

---

← →
S46E ©   (2006-07-20 15:52) [18]

хм..чую isasa ©   (18.07.06 10:33) [2] :)))

---

← →
StriderMan ©   (2006-07-20 16:03) [19]

предлагаю сделать следующее:

1. убрать из Execute все обращения к Form1.
2. передавать в поток Host через свойство (вместо n);
3. Результат выполнения пинга (да или нет) писать в свойство ResultValue (оно есть в TThread);
4. строку с параметрами пинга писать в строковое поле класса TNew (напр. ResultStr);
4. убрать New2.FreeOnTerminate := true; и разрушать объект ручками.
5. Завести у формы процедуру

procedure TForm1.PingTerminate(Sender: TObject);
begin
 TNew(Sender).ResultValue = 0 then
   //все ОК
 else
   //не ОК

end;
6. Назначить при создании
 new.OnTerminate := PingTerminate;

---

← →
isasa ©   (2006-07-20 16:25) [20]

Для такого случая очень подходит

универсально
var
   wmData : COPYDATASTRUCT;
...
SendMessage(<форма, принимающая данные>.Handle, WM_COPYDATA, 0, longint(@wmData));

для  TStringList
SendMessage(<форма, принимающая данные>.Handle, LB_ADDSTRING, 0, longint(msgs));

без всякого уродства, и синхронизация автоматом.
Недостаток - в форме описывать

procedure WMCopyData(var wMsg : TWMCopyData); message WM_COPYDATA;


---

← →
isasa ©   (2006-07-20 16:27) [21]

Поправка
для  TStringList
SendMessage(<контрол(TStringList), принимающий данные>.Handle, LB_ADDSTRING, 0, longint(msgs));

---

← →
S46E ©   (2006-07-20 16:36) [22]


...

TNew = class(TThread)
 private
 n: string;
 ResultValue: boolean;
 ResultStr: string;
   { Private declarations }
 protected
 procedure Execute; override;
end;

...

procedure TNew.Execute;
var
Pinger: TIdIcmpClient;
s: string;
begin
Pinger := TIdIcmpClient.Create(nil);
 try
 Pinger.Host:=n;
 Pinger.Ping("");
 if Pinger.ReplyStatus.FromIpAddress="0.0.0.0" then ResultValue:=false else ResultValue:=true;
 s:=Pinger.ReplyStatus.FromIpAddress;
 if s="0.0.0.0" then s:=n;
 ResultStr:="Пинг "+s+"______RTTime: "+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+"_______TTL: "+InttoStr(Pinger.ReplyStatus.TimeToLive);
 finally
 Pinger.Free
 end;
end;

...

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
New: TNew;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
 New := TNew.Create(true);
 New.n:=Hosts.Lines[i];
 New.Priority := tpNormal;
 New.OnTerminate := Form1.PingTerminate;
 New.Resume;
 end;
end;

...

procedure TForm1.PingTerminate(Sender: TObject);
begin
if TNew(Sender).ResultValue = true then
  Log.Lines.Add(TNew(Sender).ResultStr)
else
  Log.Lines.Add("Пинг "+TNew(Sender).n+" не отвечает (тайм-аут 5 секунд)")
end;

end.

Проблемы не решило:( Или я закосячил. Лог генерируется так же коряво. Сейчас попробую разобраться в (20.07.06 16:25) [20]

---

← →
StriderMan ©   (2006-07-20 16:44) [23]

> Сейчас попробую разобраться в (20.07.06 16:25) [20]

да, пригодится, однозначно самый красивый подход.

впрочем сдается мне проблема не в потоках...

ЗЫ:
New.Free забыл сделать.

---

← →
S46E ©   (2006-07-20 16:51) [24]

)))))))))
//Ушел в поиски куда ее вставить.

---

← →
S46E ©   (2006-07-20 17:22) [25]

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
New: TNew;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
 New := TNew.Create(true);
   try
   New.n:=Hosts.Lines[i];
   New.Priority := tpNormal;
   New.OnTerminate := Form1.PingTerminate;
   New.Resume;
   finally
   New.Free;
   end;
 end;
end;

Таким образом у нас получается постоянные неответы, т.е. поток только запустился и сразе же уничтожился, благодаря чему "Пинг 127.0.0.1 не отвечает (тайм-аут 5 секунд)". Пробовал вставлять TNew(Sender).Free в PingTerminate, не понимает синтаксис:)

---

← →
StriderMan ©   (2006-07-20 17:31) [26]

попробуй Terminate

---

← →
S46E ©   (2006-07-20 17:52) [27]

не помогает:(
>> Пробовал вставлять TNew(Sender).Free в PingTerminate, не понимает синтаксис:)
поправка: программа просто виснет. как и при TNew(Sender).Terminate

---

← →
S46E ©   (2006-07-20 17:54) [28]

p.s.

New.Resume;
sleep(5000);
finally
New.Free;
end;
Так все работает как надо:) но это естесно не то, с таким же успехом я мог бы просто цикл поставить на одby компонент не затрагивая потоки.

---

← →
StriderMan ©   (2006-07-20 17:56) [29]

> S46E ©   (20.07.06 17:54) [28]

не, ясен перец это не правильно. с Free я махнул пожалуй круто...

верни взад FreeOnTerminate;

---

← →
isasa ©   (2006-07-20 18:04) [30]

Очень мило :)

procedure TForm1.Button1Click(Sender: TObject);
var
...
New: TNew;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
New := TNew.Create(true); <- Содаем экземпляр
  try
....
  New.Resume; <- Запускаем поток
  finally
  New.Free; <- Тут же ему кергуду :) А он закончился, нет?
  end;
end;
end;
Выноси New: TNew в форму и делай пул потоков

---

← →
S46E ©   (2006-07-20 18:05) [31]

procedure TNew.Execute;
var
Pinger: TIdIcmpClient;
s: string;
begin
Pinger := TIdIcmpClient.Create(nil);
 try
 Pinger.Host:=n;
 Pinger.Ping("");
 if Pinger.ReplyStatus.FromIpAddress="0.0.0.0" then ResultValue:=false else ResultValue:=true;
 s:=Pinger.ReplyStatus.FromIpAddress;
 if s="0.0.0.0" then s:=n;
 ResultStr:="Ïèíã "+s+"______RTTime: "+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+"_______TTL: "+InttoStr(Pinger.ReplyStatus.TimeToLive);
 finally
 Pinger.Free
 end;
end;

{---}

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
New: TNew;
begin
for i:=0 to Form1.hosts.Lines.Count-1 do begin
 New := TNew.Create(true);
//    try
 New.n:=Hosts.Lines[i];
 New.Priority := tpNormal;
 New.FreeOnTerminate := true;
 New.OnTerminate := Form1.PingTerminate;
 New.Resume;
//    finally
//    sleep(1);
//    New.Terminate;
//    New.Free;
//    end;
 end;
end;

procedure TForm1.PingTerminate(Sender: TObject);
begin
if TNew(Sender).ResultValue = true then
  Log.Lines.Add(TNew(Sender).ResultStr)
else
  Log.Lines.Add("Ïèíã "+TNew(Sender).n+" íå îòâå÷àåò (òàéì-àóò 5 ñåêóíä)");
//     TNew(Sender).Free;
//     TNew(Sender).Terminate;
end;
Вернул. Результат: такие же кривые результаты:)

---

← →
!_SM_!   (2006-07-20 18:05) [32]

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

А если просто Sender.Free; в PingTerminate;????

---

← →
S46E ©   (2006-07-20 18:08) [33]

>> Выноси New: TNew в форму и делай пул потоков
1) TNew из формы вынули т.к. создаем потоки динамически и локально...)
2) Что есть такое "Пулл Потоков"?:)

---

← →
S46E ©   (2006-07-20 18:09) [34]

>> А если просто Sender.Free; в PingTerminate;????
Так же виснет:)

---

← →
!_SM_!   (2006-07-20 18:10) [35]

Без преобразования в TNew(Sender)?

---

← →
isasa ©   (2006-07-20 18:10) [36]

New: array of TNew;

---

← →
isasa ©   (2006-07-20 18:14) [37]

И вот здесь я не был бы таким самоуверенным

procedure TForm1.PingTerminate(Sender: TObject);
begin
 if (Sender is TNew) then
   if TNew(Sender).ResultValue = true then
     Log.Lines.Add(TNew(Sender).ResultStr)
   else
     Log.Lines.Add("Ïèíã "+TNew(Sender).n+" íå îòâå÷àåò (òàéì-àóò 5 ñåêóíä)");
end;


---

← →
S46E ©   (2006-07-20 18:15) [38]

>> Без преобразования в TNew(Sender)?
Да, просто "Sender.Free;"

>> New: array of TNew;
другого выхода точно нет?))

---

← →
!_SM_!   (2006-07-20 18:16) [39]

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

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

---

← →
!_SM_!   (2006-07-20 18:18) [40]

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

then ssory...

---

← →
S46E ©   (2006-07-20 18:18) [41]

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

---

← →
!_SM_!   (2006-07-20 18:45) [42]

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

---

← →
Пусик ©   (2006-07-20 19:01) [43]

>!_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.


---

← →
Пусик ©   (2006-07-20 19:02) [44]

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

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

---

← →
!_SM_!   (2006-07-20 20:43) [45]

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

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

---

← →
StriderMan ©   (2006-07-20 23:07) [46]

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

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

---

← →
!_SM_!   (2006-07-21 00:05) [47]

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

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

---

← →
isasa ©   (2006-07-21 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;


---

← →
isasa ©   (2006-07-21 09:09) [49]

Оно надо?

---

← →
Пусик ©   (2006-07-21 09:44) [50]

> 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 просто бессмысленно выполнять.

---

← →
Пусик ©   (2006-07-21 09:49) [51]

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

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

---

← →
isasa ©   (2006-07-21 10:29) [52]

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

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

---

← →
S46E ©   (2006-07-21 11:23) [53]

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

---

← →
S46E ©   (2006-07-21 11:24) [54]

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

---

← →
StriderMan ©   (2006-07-21 12:14) [55]

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

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

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

---

← →
Пусик ©   (2006-07-21 14:17) [56]

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


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

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

---

← →
S46E ©   (2006-07-21 14:39) [57]

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

---

← →
S46E ©   (2006-07-21 14:46) [58]


...

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 сек:)

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

---

← →
Пусик ©   (2006-07-21 14:55) [59]

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


Это уже твоя задача - отладить и разобраться, почему так происходит.

---

← →
StriderMan ©   (2006-07-21 15:07) [60]

> Не очень качественно пингует мертвые хосты

сдается мне надо покопаться в исходниках Indy. может при многопоточном пинговании не разруливается какие ответы какому потоку предназначены?

---

← →
isasa ©   (2006-07-21 15:20) [61]

Вот юнит на основе Пусика(с) класса. Только что проверил. Работает как часы.
Мочаливые IP - ждут и поток возвращает " ping time out", естесственно, немного погодя.
Берем книги, ровняем руки. :)

unit Unit1;

interface

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

type

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

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

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ 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
 Pinger := TIdIcmpClient.Create(nil);
 Pinger.Host := FHost;
 Pinger.Ping();
 Result:=FHost;
 case Pinger.ReplyStatus.ReplyStatusType of
   rsEcho:
     Result:=Result+
       " RoundTripTime: "+InttoStr(Pinger.ReplyStatus.MsRoundTripTime)+
       " TTL: "+InttoStr(Pinger.ReplyStatus.TimeToLive);
   rsError:
     Result:=Result+" ping error";
   rsTimeOut:
     Result:=Result+" ping time out";
   rsErrorUnreachable:
     Result:=Result+" host unreachable";
   rsErrorTTLExceeded:
     Result:=Result+" time out exceeded";
 end;
end;

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

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

end.


---

← →
S46E ©   (2006-07-21 15:20) [62]

>> Это уже твоя задача - отладить и разобраться, почему так происходит

Так я в этой ветке и пытаюсь разобраться:) Этим сообщением я имел ввиду что все так же как и было)) Чето потоки между друг другом трутся..

---

← →
isasa ©   (2006-07-21 15:24) [63]

Собака порылась где?
Потоки запустились и нигде не видно их состояния.
Запускаем(я пускал на 8 адресах) и идем курим, или вставляем индикатор выполнения потоков, или завершения последнего активного.

---

← →
isasa ©   (2006-07-21 15:26) [64]

S46E ©   (21.07.06 15:20) [62]
... Чето потоки между друг другом трутся..

Ага, намылить бы их ... :)

---

← →
S46E ©   (2006-07-21 15:28) [65]

>> Работает как часы...
...для одного последнего хоста:)

Хосты:
192.168.2.1 (on)
192.168.2.2 (off)
192.168.2.3 (off)
192.168.2.4 (off)
192.168.2.5 (off)
192.168.2.6 (off)
192.168.2.7 (on)
192.168.2.8 (on)
192.168.2.9 (on)
192.168.2.10 (off)
Результат:
192.168.2.3 RoundTripTime: 0 TTL: 64
192.168.2.1 RoundTripTime: 0 TTL: 64
192.168.2.2 RoundTripTime: 0 TTL: 64
192.168.2.4 RoundTripTime: 16 TTL: 128
192.168.2.5 RoundTripTime: 0 TTL: 128
192.168.2.9 RoundTripTime: 16 TTL: 128
192.168.2.6 RoundTripTime: 16 TTL: 128
192.168.2.7 RoundTripTime: 16 TTL: 128
192.168.2.8 RoundTripTime: 16 TTL: 128
192.168.2.10 ping time out

---

← →
S46E ©   (2006-07-21 15:32) [66]

Могу на мыло выслать исходник который такое выдает - проверишь у себя))

---

← →
Пусик ©   (2006-07-21 20:23) [67]

unit Unit5;

interface

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

type

TPingThread=class(Tthread)
private
 FHost: String;
 FResult: String;
 FSeq: Word;
 function Pinghost: string;
 procedure IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
protected
 procedure Execute; override;
public
 constructor Create(Host: String; OnTerminateEvent: TNotifyEvent; aSeq: Word);
 property Result: String read FResult;
end;

TForm5 = class(TForm)
 Memo1: TMemo;
 Panel1: TPanel;
 Button1: TButton;
   IdIcmpClient1: TIdIcmpClient;
 procedure Button1Click(Sender: TObject);
private
 { Private declarations }
public
 { Public declarations }
 procedure PingTerminated(Sender: TObject);
end;

var
Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 1 to 254 do
begin
 TPingThread.Create("10.0.0."+IntToStr(i),PingTerminated,i);
end;

end;

procedure TForm5.PingTerminated(Sender: TObject);
begin
Memo1.Lines.Add(TPingThread(Sender).Result);
end;

{ TPingThread }

constructor TPingThread.Create(Host: String; OnTerminateEvent: TNotifyEvent; aSeq: Word);
begin
inherited Create(True);
FreeOnTerminate := True;
FHost := Host;
FSeq := aSeq;
OnTerminate := OnTerminateEvent;
Resume;
end;

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

function TPingThread.Pinghost: string;
var
Pinger: TIdIcmpClient;
begin
Pinger := TIdIcmpClient.Create(nil);
Pinger.Host := FHost;
Pinger.OnReply := IdIcmpClient1Reply;
Pinger.Ping("",FSeq);
Result:=FHost+": "+FResult;
end;

procedure TPingThread.IdIcmpClient1Reply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
begin
Fresult := "";
case AReplyStatus.ReplyStatusType of
 rsEcho:
  FResult := FResult+
   " RoundTripTime: "+IntToStr(AReplyStatus.MsRoundTripTime)+
   " TTL: "+IntToStr(AReplyStatus.TimeToLive);
 rsError:
  FResult := "ping error";
 rsTimeOut:
  FResult := "ping time out"+
   " RoundTripTime: "+IntToStr(AReplyStatus.MsRoundTripTime)+
   " TTL: "+IntToStr(AReplyStatus.TimeToLive);
 rsErrorUnreachable:
  FResult := "host unreachable";
 rsErrorTTLExceeded:
  FResult:="time out exceeded";
end;

end;

end.


---

← →
XeON ©   (2006-07-21 23:49) [68]

Вот это тут понаворотили ответов... Попробуй воспользоваться компонентами, которые называются ICS, там кажсь был контрол специальный. Который так и назывался: ПИНГ. Или возьми обычный сокет и привинти к нему исключения Try Except и т.п. Тоже мона сделать пинг!

---

← →
Шпиён   (2006-07-22 00:18) [69]

> XeON ©   (21.07.06 23:49) [68]


> Или возьми обычный сокет и привинти к нему исключения Try
> Except и т.п. Тоже мона сделать пинг!

Можно. Но работать этот пинг будет только если у пользователя есть права администратора.

Кстати, хотелось бы посмотреть на Вашу реализацию.

---

← →
Пусик ©   (2006-07-22 02:01) [70]

> XeON ©   (21.07.06 23:49) [68]
>Попробуй воспользоваться
> компонентами, которые называются ICS

Зачем?


>Или возьми обычный  сокет


Что такое "Обычный сокет"


> и привинти к нему исключения Try Except и т.п.


Try Except будет посылать пакеты удаленному хосту?

---

← →
S46E ©   (2006-07-22 09:16) [71]

unit Unit1;

interface

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

type

TPingThread=class(Tthread)
private
FHost: String;
FResult: String;
FSeq: Word;
function Pinghost: string;
procedure IdIcmpClient1Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
protected
procedure Execute; override;
public
constructor Create(Host: String; OnTerminateEvent: TNotifyEvent; aSeq: Word);
property Result: String read FResult;
end;

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

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TPingThread }

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

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

function TPingThread.Pinghost: string;
var
Pinger: TIdIcmpClient;
begin
Pinger := TIdIcmpClient.Create(nil);
Pinger.Host := FHost;
Pinger.OnReply := IdIcmpClient1Reply;
Pinger.Ping("",FSeq);
Result:=FHost+": "+FResult;
end;

procedure TForm1.PingTerminated(Sender: TObject);
begin
Log.Lines.Add(TPingThread(Sender).Result);
end;

procedure TPingThread.IdIcmpClient1Reply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
begin
FResult := "";
case AReplyStatus.ReplyStatusType of
rsEcho:
 FResult := FResult+
  " RoundTripTime: "+IntToStr(AReplyStatus.MsRoundTripTime)+
  " TTL: "+IntToStr(AReplyStatus.TimeToLive);
rsError:
 FResult := "ping error";
rsTimeOut:
 FResult := "ping time out"+
  " RoundTripTime: "+IntToStr(AReplyStatus.MsRoundTripTime)+
  " TTL: "+IntToStr(AReplyStatus.TimeToLive);
rsErrorUnreachable:
 FResult := "host unreachable";
rsErrorTTLExceeded:
 FResult:="time out exceeded";
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i := 1 to 254 do
begin
TPingThread.Create("192.168.2."+IntToStr(i),PingTerminated,i);
end;

end;

end.
У меня Не работает. Вообще ничего не выводит, только разве при многократном нажатии на пинг, дельфи виснет и вылетает с ошибкой насчет памяти=)

---

← →
S46E ©   (2006-07-22 09:18) [72]

Поразительно...такая примитивная распрастраненная мелнькая задачка как пинговалка и столько хлопот...:) Как буд-то я и не велосипед придумываю..)

---

← →
S46E ©   (2006-07-22 13:19) [73]

Скажите, насколько будет экологично использовать?


for i:=1 to 244 do WinExec("ping 192.168.2."+i+" > c:\ping_192_168_2_"+i+".tmp", SW_hide);
//далее читаем программного результаты пинга из кучи файлов по циклу и пишем в лог.


---

← →
Пусик ©   (2006-07-22 13:50) [74]

> У меня Не работает. Вообще ничего не выводит, только разве
> при многократном нажатии на пинг, дельфи виснет и вылетает
> с ошибкой насчет памяти=)


FSeq := aSeq;
OnTerminate := OnTerminateEvent;

А вот эти строки сложно было скопировать тоже в конструкторе?

---

← →
S46E ©   (2006-07-22 13:59) [75]

constructor TPingThread.Create(Host: String; OnTerminateEvent: TNotifyEvent; aSeq: Word);
begin
inherited Create(True);
FreeOnTerminate := True;
FHost := Host;
FSeq := aSeq;
OnTerminate := OnTerminateEvent;
end;
не сложно. эффект тот же.

---

← →
Пусик ©   (2006-07-22 14:19) [76]

> S46E ©   (22.07.06 13:59) [75]
> constructor TPingThread.Create(Host: String; OnTerminateEvent:
>  TNotifyEvent; aSeq: Word);begin inherited Create(True);
>  FreeOnTerminate := True; FHost := Host; FSeq := aSeq; OnTerminate
> := OnTerminateEvent;end;не сложно. эффект тот же.


Слушай, так и будем по строчке добавлять?
Сравни код у меня в конструкторе и у себя. Найди отличия.

---

← →
Пусик ©   (2006-07-22 14:31) [77]

В приведенном выше примере как в конструкторе, так и в поточной функции, каждый оператор несен вполне определенную смысловую нагрузку.
Естественно, если некоторые операторы из кода "выкинуть", то в целом код не будет выполнять поставленную задачу.
Для написания многопоточных приложений необходимо четко понимать, что делает код.
Рекомендую почитать статьи:
1. http://forum.vingrad.ru/index.php?showtopic=60076
2. http://www.delphimaster.ru/articles/panov/index.html

---

← →
S46E ©   (2006-07-22 14:31) [78]

Ух ты как. Я полон позитива! Спасибо Пусик!

---

Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.08.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.69 MB
Время: 0.042 c