Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Проблема с потоками [D7, XP]


Buzzik ©   (2010-04-06 18:56:00) 

Пишу программу, для проверки работоспособности большого количества комутаторов, по средством пинг. Чтобы приложение не подвисало начал использовать потоки. И все бы хорошо, если опрашиваемых комутаторов не много, но если их около сотни и больше, и многии из них лежат, то когда идет ожидание ответа - программа начинает подвисать. Причем загрузка проца около 10%-15%.

в  procedure TNewThread.Execute;
у меня идет стандартная посылка пакета
   IcmpSendEcho(hIP,
                destAddress.S_addr,
                @pingBuffer,
                sizeof(pingBuffer),
                Nil,
                pIpe,
                sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                Timeout);
и результат идет в Synchronize(UpdateGrid);
В которой собственно изменения идут в vlc.

По таймеру у меня идет запуск цикла потоков
if     tr_on_=false then  //Проверяю закончился ли прошлый  
                                            //таймерный цикл
for i:=0 to form1.NextGrid1.RowCount-1 do
begin
   if  form1.NextGrid1.CellByName['Enabled',i].AsBoolean=true then begin
Delay(1);
Application.ProcessMessages;
host_2:= form1.NextGrid1.CellByName['IP',i].AsString;

colgrid:=i;

 NewThread:=TNewThread.Create(true);
 NewThread.FreeOnTerminate:=true;
 NewThread.Priority:=tpLower;
 NewThread.Resume;
// delay(10);
end;

Скорее всего подвисание происходит когда выполняеться IcmpSendEcho, пакет не проходит и идет собственно Timeout.
Подскажите, пожалуйста  как избежать подвисания интерфейса программы.
Или как правильно организовать работу данной задачи.

Buzzik   (2010-04-07 11:55:00) [1]


> DVM

Спасибо, помогло, работает без тормозов, хоть я и не дошел до сообщений.

Всем спасибо, за помощь в решении проблемы.

Slym   (2010-04-07 10:57:00) [2]

Удалено модератором

Loginov Dmitry   (2010-04-06 23:22:00) [3]

Вот что хотелось бы добавить:

Synchronize(UpdateGrid);
следует убрать.

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

Бросить на форму таймер, который будет несколько раз в секунду считывать информацию их этой структуры и отображать ее на сетке. При этом структура должна быть "потокобезопасной". Плюс все это можно неслабо оптимизировать (например не обновлять ячейку, если ее значение не изменилось).

Дмитрий Белькевич   (2010-04-06 23:02:00) [4]


> with напиши. Глаза болят.


Да и вообще - к форме из треда лучше не лезть. Пусть форма сообщения от тредов обрабатывает.

Но with напиши даже в форме.

И вот это: CellByName['Kol_vo_p',vi_] лучше один раз посчитать как-то типа CellKolVol := CellByName['Kol_vo_p',vi_] (если, правда, CellByName возвращает какой-нибудь TCell) и уже потом по всему методу к CellKolVol обращаться.

Как есть - больно глазам и компьютеру.

Дмитрий Белькевич   (2010-04-06 22:53:00) [5]

>form1.NextGrid1

with напиши. Глаза болят.

DVM   (2010-04-06 21:01:00) [6]


> Buzzik ©   (06.04.10 20:49) [5]
> > DVM
> Может быть, просто замеченно что именно в том месте подвисает.
> Покопаю в этом направлении.

Ты лучше сделай по другому.

1) Выкинь таймер, не нужен он.
2) Создаешь нужное число потоков по числу коммутаторов.
3) Циклы делаешь в самих потоках.
4) Пусть потоки извещают главный поток с помощью сообщений

Buzzik   (2010-04-06 20:49:00) [7]


> DVM

Может быть, просто замеченно что именно в том месте подвисает.
Покопаю в этом направлении.


> Игорь Шевченко

Проверено опытным путем, что если закаментить весь вывод, то подвисание всеравно происходит

procedure TNewThread.UpdateGrid;
var //i, j:integer;
str:string;
begin

if (pos('Reqested Timed out.', msg)=0)and(pos('Destination host unreachable.', msg)=0) then begin
if form1.NextGrid1.CellByName['Status',vi_].AsString='Down' then
form1.NextGrid1.CellByName['Log',vi_].AsString:=
datetimetostr(now)+' '+form1.NextGrid1.CellByName['IP',vi_].AsString
+' is UP'+#13+
form1.NextGrid1.CellByName['Log',vi_].AsString;

form1.NextGrid1.CellByName['Status',vi_].AsString:='OK';
form1.NextGrid1.CellByName['Status', vi_].Color:=clWhite;

form1.NextGrid1.CellByName['Kol_vo_p',vi_].AsInteger:=0;

end else Begin
form1.NextGrid1.CellByName['Kol_vo_p',vi_].AsInteger:=
form1.NextGrid1.CellByName['Kol_vo_p',vi_].AsInteger+1;
if  (form1.NextGrid1.CellByName['Status',vi_].AsString='OK')or
(form1.NextGrid1.CellByName['Status',vi_].AsString='Unknown')or
(form1.NextGrid1.CellByName['Status',vi_].AsString='Disabled')
 then begin
form1.NextGrid1.CellByName['Status',vi_].AsString:='Some problems';

form1.NextGrid1.CellByName['Status', vi_].Color:=clYellow;

                                                end;
if (form1.NextGrid1.CellByName['Kol_vo_p',vi_].AsInteger>form1.ploss_spin.value-1)
then begin

if form1.NextGrid1.CellByName['Status',vi_].AsString='Some problems'  then

if form1.NextGrid1.CellByName['Kol_vo_p',vi_].AsInteger=form1.ploss_spin.value then begin
form1.NextGrid1.CellByName['Status',vi_].AsString:='Down';
form1.NextGrid1.CellByName['Status', vi_].Color:=clRed;

form1.NextGrid1.CellByName['Log',vi_].AsString:=
datetimetostr(now)+' '+form1.NextGrid1.CellByName['IP',vi_].AsString
+' is DOWN'+#13+
form1.NextGrid1.CellByName['Log',vi_].AsString;

if Form1.Alert_CheckBox.Checked=true then
if Alert_window.Visible=false then begin
ShowWindow(Alert_window.Handle, SW_RESTORE);
row_down:=vi_;
Alert_window.timer2.Enabled:=true;
Alert_window.Label1.Caption:=
form1.NextGrid1.CellByName['Host',vi_].AsString+' is DOWN'+#13;
//+
                                   end;  end;

if  form1.NextGrid1.CellByName['Alarm_en', vi_].AsBoolean=true then
                            begin

if form1.NextGrid1.CellByName['Kol_vo_p',vi_].AsInteger=form1.ploss_spin.value then begin

str:=(form1.NextGrid1.CellByName['Alarm', vi_].AsString);
 if  BASS_ChannelIsActive(Channel)<>BASS_ACTIVE_PLAYING then
 if mute<>true then begin
 try
BASS_ChannelStop(Channel);
Channel := BASS_StreamCreateFile(FALSE, PChar(str), 0, 0, 0);
if form1.NextGrid1.CellByName['Loop_sound', vi_].AsBoolean<>false then
BASS_ChannelFlags(channel, BASS_SAMPLE_LOOP, BASS_SAMPLE_LOOP)  // set LOOP flag
else
BASS_ChannelFlags(channel, 0, BASS_SAMPLE_LOOP); // remove LOOP flag

BASS_ChannelPlay(Channel, true);
    except  end;
                              end;
                     end;

        end;

                                                                       end;
        end;
if form1.NextGrid1.CellByName['Enabled',vi_].AsBoolean=false
then form1.NextGrid1.CellByName['Status',vi_].Color:=clGray;

tr_on_:=false;
end;

Игорь Шевченко   (2010-04-06 20:28:00) [8]


>   Synchronize(UpdateGrid);


еще эту часть - UpdateGrid

DVM   (2010-04-06 20:23:00) [9]


> Buzzik ©  

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

Нахрена их уничтожать то?

Buzzik   (2010-04-06 20:08:00) [10]

procedure TNewThread.Execute;
var
   hIP : THandle;
   pingBuffer : array [0..31] of Char;
   pIpe : ^icmp_echo_reply;
   wVersionRequested : WORD;
   lwsaData : WSAData;
   error : DWORD;
   destAddress : In_Addr;
//    i: integer;
   IPReply: string;    pHostEn : PHostEnt;

begin
// delay(100);
  tr_on_:=true;
  vi_:=colgrid;
  msg:='';
  host_:=host_2;
  hIP := IcmpCreateFile();
  pHostEn := gethostbyname(pchar(host_));

   if not Assigned(pHostEn) then
   begin
     msg := 'Reqested Timed out.';
     Synchronize(UpdateGrid);  Exit;
   end;

   destAddress := PInAddr(pHostEn^.h_addr_list^)^;

   GetMem( pIpe,
           sizeof(icmp_echo_reply) + sizeof(pingBuffer));
   pIpe.Data := @pingBuffer;
   pIpe.DataSize := sizeof(pingBuffer);

   wVersionRequested := MakeWord(1,1);
   error := WSAStartup(wVersionRequested,lwsaData);
   if (error <> 0) then
   begin
        msg := 'Reqested Timed out.';

   end;
          msg3:=  IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
              IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
              IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
              IntToStr(HiByte(HiWord(pIpe^.Address)));

       Timeout:=(2000);
//CriticalSection.Enter;

  if error=0 then begin

   IcmpSendEcho(hIP,
                destAddress.S_addr,
                @pingBuffer,
                sizeof(pingBuffer),
                Nil,
                pIpe,
                sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                Timeout);

                end;
//  CriticalSection.Leave;

   error := GetLastError();
   if (error <> 0) then
   begin
        msg := 'Reqested Timed out.';

   end;
            if error=0 then begin

   IPReply := IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+
              IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+
              IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+
              IntToStr(HiByte(HiWord(pIpe^.Address)));

            if error=0 then
   msg:=  'Reply from '+  IPReply
               + ' bytes='+
                   IntToStr(sizeof(pingBuffer)) +
                   ' time='
               +
               IntToStr(pIpe.RTTime)+' ms'
               else msg:= 'Reqested Timed out.';

               if (LoByte(LoWord(pIpe^.Status)))=250 then
              msg:= 'Destination host unreachable.' ;

                   end;
 if pos(msg3,msg)<>0 then msg:='Destination host unreachable.' ;{сравнение IP хоста с IP отвечающей железяки}

                msg:= datetimetostr(now)+' '+msg;

  Synchronize(UpdateGrid);

IcmpCloseHandle(hIP);
WSACleanup();
FreeMem(pIpe);

end;

Игорь Шевченко   (2010-04-06 19:28:00) [11]

код потока в студию

Наверх

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