Добрый день. Есть код загрузчика страниц(вызывается в поток):

Код:

function TLoader.LoadHtmlCode(const PageUrl: String):string;
var
ErrorData:string; (*ответ сервера в тестовом виде*)
ResponseCode:integer; (*ответ сервера в виде кода ошибки*)
begin
   try
     (*---------настройка параметров закачки-----------*)
     FIdHttp.Request.UserAgent:=GetRandomUserAgent; (*получаем случайное значение Юзер-Агент*)
     FIdHttp.Request.AcceptLanguage:='ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3'; (*вроде нужно*)
     FIdHttp.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.3'; (*вроде нужно*)
     FIdHttp.ConnectTimeout:=10000;
     FIdHttp.ReadTimeout:=10000;
     FIdHttp.IOHandler:=FSSL;
     FIdHttp.HandleRedirects:=True;
     Result:=AnsiLowerCase(FIdHttp.Get(PageUrl));
       except
         Result:=PageUrl;
         (*тут вызов ПРОЦ для записи ответа сервера и УРЛ в лог*)
       end;
      Exit;  (*выход из функции. в РЕЗУЛЬТАТ содержится последнее значение*)
   end;
end; 

1. При высокой скорости трафика все работает нормально:
- загрузка 100 УРЛ за 20...25 сек (10 потоков одновременно)
- никаких утечек памяти
практически все как предначертано работает
2. При наличие потребителя трафика(другой РС в сети с работающим ТОРРЕНТ, источник интернета - роутер 3 мбит\сек):
- загрузка 97...100 УРЛ за 60...120 сек
- один или два потока зависают(есть на форме индикатор числа работающих потоков)при закачке УРЛ и могут висеть часами, пока не закрыть программу
- никакой зависимости от УРЛ нет, в одон тесте одни УРЛ не закачиваются в другом другие
- еще одна особенность: в логе фиксируется ответ сервера. при наличие конкурента на трафик от 10 до 30 УРЛ не загружаются(то же различные, от теста к тесту), хотя ответ сервера = 200 (ну это не самая большая проблема, скоро будет добавлен код перезакачки УРЛ), но о чем то этот факт говорит?

Внимание! Вопросы:
1. в чем причина такого поведения TidHttp?
возможно надо что то настроить в параметрах загрузчика?
2. возможно ли ввести в поток загрузчика таймер типа:

Код:

procedure TLoader.Execute;
begin
  CallTimer;
  FIdHttp.Get(PageUrl);
end;

procedure TLoader.CallTimer;
begin
  (*тут реализация таймера на 100 сек, но на чем? TTimer явно не подойдет*)
   Событие OnTimer вызывает
   FIdHttp.Socket.Close; (*если через 100 сек страница не закачается и поток не сдохнет 
   принудительно закрыть idHTTP, поток после тоже закроется*)
   может кто подскажет реализацию таймера, на чем бы его сделать?
end;

почитал на форумах что нашел, похоже таймер единственный вариант решить эту проблему

[lmikle]

Вообще, скорее всего, просто у тебя есть необработанное исключение, которое из потока никак себя внешне не проявляет. На самом деле поток уже закончился, а вот объект продолжает "висеть". Оберни все тело Execute в try...except и залогируй ошибку:

Код:

procedure TMyThread.Execute;
begin
  Try
     // весь твой код здесь
  Except
    On E : Exception Do
      // здесь записать куда-нить, например в файл, текст ошибки E.Message
  End;
end;

lmikle, спасибо за подсказку, к сожалению она оказалась практически бесполезной в данном конкретном случае(но как метод разборки полетов), в частности сделал так:

Код:

procedure TLoader.Execute;
var Code:string;
begin
    try
    (*------------------------------*)
    Code:=LoadPage(Url); (*ту вызов загрузчика*)
       CS.Enter;  (*вход в КС*)
         try
           gStore.Add(Code); (*передаем результат в ГП*)
           Dec(CurrentNumOfTHreads); (*счетчик потоков*)
         finally
            Cs.Leave;  (*выход из КС*)
         end;
     (*-----------------------------*)
    except
         On E:Exception do
           ShowMessage(E.Message); (*просто вывести чего либо*)
    end;
end;

результат тот же: при наличии работающего торрента(хавает 95% трафика) один - два потока уходят в небытие. то есть в TLoader.Execute; никаких исключений не возникает поскольку метод GET не отработал в загрузчике.
в связи с выше перечисленным вернемся к насущной проблеме: как правильно сделать таймер внутри потока, чиста внутри потока. конечно таймер будет обращаться к системе через КС, но как конкретно?
кто нибуть в курсе?

[PhoeniX]

Инди, как показала практика с одним моим парсером, любит падать и виснуть в самый неподходящий момент.
Решил переходом на WinHTTP, который имеет на порядок меньше ограничений, да и работает шустрее (WinAPI таки).
Пример кода (winhttp.pas брать тут):

Код:

uses
  WinHTTP;

function LoadFile(server, url: WideString): WideString;
begin
var
  hInet, hConn, hReq: Pointer;
  buf: array of char;
  bufSize, bufRead, p: cardinal;
begin
  hInet := WinHttpOpen('UserAgent/1.0',0,nil,nil,0);
  hConn := WinHttpConnect(hInet, PWideChar(server), INTERNET_DEFAULT_HTTP_PORT, 0);
  hReq := nil;
  repeat
    if hReq <> nil then WinHttpCloseHandle(hReq);
    repeat hReq := WinHttpOpenRequest(hConn, 'GET', PWideChar(url), 'HTTP/1.1', nil, nil, 0) until hReq <> nil;
    while not WinHttpSendRequest(hReq, nil, 0, nil, 0, 0, 0) do;
  until WinHttpReceiveResponse(hReq, nil);
  bufSize := 0;
  p := 0;
  while WinHttpQueryDataAvailable(hReq, bufSize) do begin
    SetLength(buf,p+bufSize);
    if bufSize = 0 then break;
    bufRead := 0;
    WinHttpReadData(hReq, @buf[p], bufSize, bufRead);
    inc(p,bufRead);
  end;
  WinHttpCloseHandle(hReq);
  WinHttpCloseHandle(hConn);
  WinHttpCloseHandle(hInet);
  SetLength(buf,p+1);
  Result := UTF8Decode(UTF8String(PChar(@buf[0])));
end;

procedure TForm1.Button1Click(Sender: TButton);
begin
  MessageBoxW(0,PWideChar(LoadFile('delphisources.ru','/forum/index.php')),nil,0);
  // Используем MessageBoxW для нормального отображения UTF-8
end;

а вот это:
- переадресация по 301 и 302, ответы сервера 404 500 502 и прочее самому делать прийдется?
- выбор кодовой страницы самому делать прийдется?(хотя ттут видимо и с ИНДИ тоже)
- запуск экземпляря загрузчика в потоке получится? хотя тут наверно косяков не будет
WinHttp.pas - это интерфейс? для winhttp.dll там вообще как? ВЫНьХР, ВЫНь7 и 8 совместимость есть? мне нужно чтоб под любой из этих ОС все работало
не в курсе?

[PhoeniX]

Если верить MSDN (что я предпочитаю делать), поддерживается на всех виндах, начиная с XP.

Сообщение от Minimum supported client

Windows XP, Windows 2000 Professional with SP3 [desktop apps only]

На Win7 и Win8 работает точно. Под XP - должно, если верить документации.

С потоками проблем нет, у меня качает спокойно и в 70 с лишним потоков, даже без подвисаний и ожиданий.

Кодовая страница - UTF-8 поддерживаются нативно благодаря WideString. Хотя, с Win1251 будут проблемы, но это быстро решается.

Редиректы и ошибки не пробовал, но обрабатывать их довольно просто.

Надо будет попробовать заменить код загрузчика от idHTTP на winInet
Спасибо за подсказку

[PhoeniX]

WinInet не советую. Он ограничен 2 (или 4) потоками одновременно, зависит от конфигурации. Жалкая прослойка между WinHTTP и Internet Explorer-ом... WinHTTP имеет аналогичный интерфейс программирования, но ограничений нет...

а в списке модулей есть WinInet
так это что иное чем WinInet, ICS, socket и прочее?
winhttp.dll надо будет поискать информацию что это такое
и еще, с HTTPs это будет как то работать?

[lmikle]

Еще можно synapse попробовать. Я вот собираюсь (залодбала Indy с некоторыми вещами). Как минимум, ping реализуется практически не глядя (просто проверил, что работоспособна, кстати, на XE3).

[PhoeniX]

Сообщение от Pcrepair

и еще, с HTTPs это будет как то работать?

Код:

 
function LoadFileHTTPS(server, url: WideString): WideString;
begin
var
  hInet, hConn, hReq: Pointer;
  buf: array of char;
  bufSize, bufRead, p: cardinal;
begin
  hInet := WinHttpOpen('UserAgent/1.0',0,nil,nil,0);
  hConn := WinHttpConnect(hInet, PWideChar(server), INTERNET_DEFAULT_HTTPS_PORT, 0); // HTTP -> HTTPS
  hReq := nil;
  repeat
    if hReq <> nil then WinHttpCloseHandle(hReq);
    repeat hReq := WinHttpOpenRequest(hConn, 'GET', PWideChar(url), 'HTTP/1.1', nil, nil, WINHTTP_FLAG_SECURE) until hReq <> nil;
    // Флаг WINHTTP_FLAG_SECURE
    while not WinHttpSendRequest(hReq, nil, 0, nil, 0, 0, 0) do;
  until WinHttpReceiveResponse(hReq, nil);
  bufSize := 0;
  p := 0;
  while WinHttpQueryDataAvailable(hReq, bufSize) do begin
    SetLength(buf,p+bufSize);
    if bufSize = 0 then break;
    bufRead := 0;
    WinHttpReadData(hReq, @buf[p], bufSize, bufRead);
    inc(p,bufRead);
  end;
  WinHttpCloseHandle(hReq);
  WinHttpCloseHandle(hConn);
  WinHttpCloseHandle(hInet);
  SetLength(buf,p+1);
  Result := UTF8Decode(UTF8String(PChar(@buf[0])));
end;
 
procedure TForm1.Button1Click(Sender: TButton);
begin
  MessageBoxW(0,PWideChar(LoadFileHTTPS('github.com','/')),nil,0);
end;