Форум: "Начинающим";
Текущий архив: 2006.08.13;
Скачать: [xml.tar.bz2];
ВнизПотоки и пинг Найти похожие ветки
← →
!_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.64 MB
Время: 0.098 c