Проблема с потоками

← →
Buzzik © (2010-04-06 18:56) [0]

Пишу программу, для проверки работоспособности большого количества комутаторов, по средством пинг. Чтобы приложение не подвисало начал использовать потоки. И все бы хорошо, если опрашиваемых комутаторов не много, но если их около сотни и больше, и многии из них лежат, то когда идет ожидание ответа - программа начинает подвисать. Причем загрузка проца около 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.
Подскажите, пожалуйста как избежать подвисания интерфейса программы.
Или как правильно организовать работу данной задачи.

← →
Игорь Шевченко © (2010-04-06 19:28) [1]

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

← →
Buzzik © (2010-04-06 20:08) [2]

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;

← →
DVM © (2010-04-06 20:23) [3]

> Buzzik ©

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

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

← →
Игорь Шевченко © (2010-04-06 20:28) [4]

> Synchronize(UpdateGrid);

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

← →
Buzzik © (2010-04-06 20:49) [5]

> 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;

← →
DVM © (2010-04-06 21:01) [6]

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

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

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

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

>form1.NextGrid1

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

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

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

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

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

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

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

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

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

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

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

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

> DVM

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

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

Проблема с потоками Найти похожие ветки