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-20 18:15:00) [41]

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

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

isasa   (2006-07-20 18:14:00) [42]

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

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;

isasa   (2006-07-20 18:10:00) [43]

New: array of TNew;

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

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

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

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

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

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

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

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:00) [48]


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

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

isasa   (2006-07-20 18:04:00) [49]

Очень мило :)

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 в форму и делай пул потоков

StriderMan   (2006-07-20 17:56:00) [50]


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

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

верни взад FreeOnTerminate;

S46E   (2006-07-20 17:54:00) [51]

p.s.

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

S46E   (2006-07-20 17:52:00) [52]

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

StriderMan   (2006-07-20 17:31:00) [53]

попробуй Terminate

S46E   (2006-07-20 17:22:00) [54]

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, не понимает синтаксис:)

S46E   (2006-07-20 16:51:00) [55]

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

StriderMan   (2006-07-20 16:44:00) [56]


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

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

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

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

S46E   (2006-07-20 16:36:00) [57]


...

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]

isasa   (2006-07-20 16:27:00) [58]

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

isasa   (2006-07-20 16:25:00) [59]

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

универсально
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;

StriderMan   (2006-07-20 16:03:00) [60]

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

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;

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

Наверх

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