Текущий архив: 2006.08.13;
Скачать: CL | DM;

Вниз

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

← →
!_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;
Скачать: CL | DM;

Наверх

Память: 0.66 MB
Время: 0.032 c