Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

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

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

Res © (2008-05-04 22:49:00)
Потоки висят в системы и не уничтожаются.... хотя должны :)
BeginThread(nil,0,Addr(Thread),PCHar(msg),0,id1);

function thread(thcommand:string): Integer; .. pg:=getpage(thcommand); .. end;
Такое ощущение, что проблема в функции getpage.. когда я использовал indy компанент, то все было норм. Но я незнаю как сделать таймаут, после которого, функция останавливает свою работу.

function getpage(url:string):string; var s: TSocket; data: TWSAData; Addr: TSockAddr; Recived: Integer; Buff: array [0..1023] of Char; HTTPRequest,HTTPResponse,path,name: string; y,n:integer; begin if(copy(url,1,7)<>'http://') then begin result:=''; exit; end; url:=copy(url,8,length(url)); if(Pos('/',url)<>0) then begin n:=length(url); for y:=1 to n do begin if(url[y]='/') then begin name:=copy(url,1,y-1); path:=copy(url,y,n); break; end; end; end else begin name:=url; path:='/'; end; WSAStartup($101, data); s:=socket(AF_INET, SOCK_STREAM,IPPROTO_TCP); Addr.sin_family:=AF_Inet; Addr.sin_port:=htons(80); Addr.sin_addr.S_addr:=inet_addr(pChar(NameToIP(name))); if (connect(s,Addr,SizeOf(TSockAddr)) <> SOCKET_ERROR) then begin HTTPRequest:='GET '+Path+' HTTP/1.1'+#13#10+'Host: '+Name+#13#10+'Connection: Close'+#13#10#13#10; try send(s, HTTPRequest[1], 1024,0); except end; HTTPResponse:= ''; Recived:= 1; while Recived <> 0 do begin try Recived:= recv(s, Buff, 1024, 0); except end; HTTPResponse:= HTTPResponse + Copy (Buff,0,Recived); end; closesocket(s); result:=HTTPResponse; end; end;

Заранее спасибо за советы.

Сергей М. (2008-05-05 08:40:00) [1]

> Res (05.05.08 00:12) [14]

Грабли будут еще до-о-олго лупить тебя, до тех пор пока не научишься хотя бы основным приемам отладки своих программ средствами встроенного в Делфи отладчика)

DVM (2008-05-05 00:20:00) [2]

> Тогда так, будет верно?

Уже лучше, даже может уже и заработает. Recv не возбуждает вроде исключений, так что try...except тут бесполезен. Recived:= 0; никогда не будет выполнено. Да и все равно этот код не для непредсказуемого Интернет. Для локальной сети и то с оговорками.

Res (2008-05-05 00:12:00) [3]
while Recived > 0 do
begin
try
Recived:= recv(s, Buff, 1024, 0);
except
Recived:= 0;
end;
HTTPResponse:= HTTPResponse + Copy (Buff,1,Recived);
end;
Тогда так, будет верно?

DVM (2008-05-05 00:10:00) [4]

> то будет... все норм :)

Ничего не будет норм. Будет бесконечный цикл. SOCKET_ERROR = -1.
И твой try...except тут как собаке пятая нога.

Res (2008-05-05 00:07:00) [5]
while Recived <> 0 do begin try Recived:= recv(s, Buff, 1024, 0); except Recived:= 0; end; HTTPResponse:= HTTPResponse + Copy (Buff,1,Recived); end;
то будет... все норм :)

Res (2008-05-05 00:02:00) [6]
)))

DVM (2008-05-05 00:02:00) [7]

> Res (04.05.08 23:53) [7]
> Все равно проц нагружается на 50%

А что ты хотел то? С таким кодом. Как ты думаешь. что будет если recv будет возвращать SOCKET_ERROR все время?

Loginov Dmitry (2008-05-04 23:58:00) [8]
> Кол-во потоков: 14 и это значение постоянно растет

Не боись! Дойдет до 2048 - само остановится!

Loginov Dmitry (2008-05-04 23:57:00) [9]
> Все равно проц нагружается на 50%

Ну это уже прогресс!
Значит все-таки в правильном направлении движешься! :)))

Res (2008-05-04 23:53:00) [10]
Все равно проц нагружается на 50%

Кол-во потоков: 14 и это значение постоянно растет...

DVM (2008-05-04 23:36:00) [11]

> HTTPResponse:= HTTPResponse + Copy (Buff,0,Recived)

А если в ответе сервера бинарные данные будут?
А вообще, код жуткий, от начала и до конца. Он не будет работать в Интернет. Нигде не анализируется возвращаемые сетевыми функциями значения.

Res (2008-05-04 23:29:00) [12]

> Recived остается старое значение

Спасибо, помогло ) пошел тестить

Loginov Dmitry (2008-05-04 23:24:00) [13]
Кстати, при вызове Copy() массив Buff автоматически преобразовывается в строку String (к тому же достаточно затратная операция), а в String нумерация элементов начинается с единицы, поэтому вместо нолика в Copy (по правильному) должна быть единица).

Loginov Dmitry (2008-05-04 23:17:00) [14]
> но он висит и не уничтожается :(( Из за этого через 10 минут,
> моя прога жрет 70% проца(Dual Xeon 2.6Ghz, 8 ядерный)

Проверь, не зацикливается ли код на

> while Recived <> 0 do
> begin
> try
> Recived:= recv(s, Buff, 1024, 0);
> except
> end;
> HTTPResponse:= HTTPResponse + Copy (Buff,0,Recived)
> ;
> end;

Это - рассадник глюков!
Что будет при Exception в recv? Ошибка гасится, но у Recived остается старое значение, которое все равно передается в Copy, в результате скопировано может быть что угодно, любой мусор.

Воспользуйся отладчиком в конце концов!

Res (2008-05-04 23:02:00) [15]
msg - глобальная переменная )))
Да, прокатывает, поток запускается... но он висит и не уничтожается :(( Из за этого через 10 минут, моя прога жрет 70% проца(Dual Xeon 2.6Ghz, 8 ядерный)

Loginov Dmitry (2008-05-04 22:57:00) [16]
> BeginThread(nil,0,Addr(Thread),PCHar(msg),0,id1);
>
> function thread(thcommand:string): Integer;

Какое-то издевательство над строками! Неужели это прокатывает? :)
Переменная "msg", полагаю, глобальная?

Наверх

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