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

← →
Res (2008-05-04 22:49) [0]

Потоки висят в системы и не уничтожаются.... хотя должны :)
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;

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

← →
Loginov Dmitry © (2008-05-04 22:57) [1]

> BeginThread(nil,0,Addr(Thread),PCHar(msg),0,id1);
>
> function thread(thcommand:string): Integer;

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

← →
Res (2008-05-04 23:02) [2]

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

← →
Loginov Dmitry © (2008-05-04 23:17) [3]

> но он висит и не уничтожается :(( Из за этого через 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, в результате скопировано может быть что угодно, любой мусор.

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

← →
Loginov Dmitry © (2008-05-04 23:24) [4]

Кстати, при вызове Copy() массив Buff автоматически преобразовывается в строку String (к тому же достаточно затратная операция), а в String нумерация элементов начинается с единицы, поэтому вместо нолика в Copy (по правильному) должна быть единица).

← →
Res (2008-05-04 23:29) [5]

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

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

← →
DVM © (2008-05-04 23:36) [6]

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

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

← →
Res (2008-05-04 23:53) [7]

Все равно проц нагружается на 50%

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

← →
Loginov Dmitry © (2008-05-04 23:57) [8]

> Все равно проц нагружается на 50%

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

← →
Loginov Dmitry © (2008-05-04 23:58) [9]

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

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

← →
Res (2008-05-05 00:02) [10]

)))

← →
DVM © (2008-05-05 00:02) [11]

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

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

← →
Res (2008-05-05 00:07) [12]

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

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

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

← →
Res (2008-05-05 00:12) [14]

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

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

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

> Res (05.05.08 00:12) [14]

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

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