Форум: "Начинающим";
Текущий архив: 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...

---

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

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

Наверх

Память: 0.56 MB
Время: 0.038 c