VPF::Странное поведение idHTTP - Форум программистов

Serzant

Дата 21.2.2014, 18:48 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 11.2.2014

Репутация: нет
Всего: нет

Добрый вечер!
Давно использую многопоточность, но с такой проблемой столкнулся впервые. Ситуация следующия...

Для теста сворганил небольшой код:

Код


type //-------------- Класс потока, потомок от tThread -------------//
  WfThread = class(TThread)
                private FThrStr : string;
                protected procedure Execute; override;
                public  FSData, FThrName : string;
                FProc : procedure(aThr : WfThread);
                FCnt : ^Integer;
                procedure InfoSync;
                procedure IsTerminate(Sender : TObject);
              end; //---------------------------------------------------------//


procedure TForm2.sSpeedButton4Click(Sender: TObject); // Запускаем потоки ///
var i : integer;
begin

Cnt := Form6.sTrackBar1.Position;  
SetLength(MyT, Cnt); 
Url := -1;
Form2.sStatusBar1.Panels[3].Text := IntToStr(StrList.Count);
Form2.sStatusBar1.Panels[5].Text := '0'; 
Form2.sStatusBar1.Panels[7].Text := '0';
Form2.sStatusBar1.Panels[1].Text := '0'; 
Ch := 2;

for i := 0 to High(MyT) do begin
  MyT[i]:= WfThread.Create(True);
  MyT[i].Priority := tpNormal;
  MyT[i].FThrName := 'Поток номер [ ' + IntToStr(i + 1) + ' ]';
  Form2.sStatusBar1.Panels[1].Text := IntToStr(i + 1);
  MyT[i].FCnt := @Cnt; 
  MyT[i].FProc := ProcExt1;
end;

for i := 0 to High(MyT) do MyT[i].Start;

while Cnt > 0 do begin Application.ProcessMessages;
end; Cnt := Cnt + 1;

for i := 0 to High(MyT) do FreeAndNil(MyT[i]);
Form2.sStatusBar1.Panels[1].Text := IntToStr(Cnt - 1);
MyT := nil;
end; //-----------------------------------------------------------------------//


procedure ProcExt1(aThr : WfThread); // START тело потока //
const SelfName = 'ProcExt1()';
var Page : TStringList; 
  Links, Texts : string; 
  CurUrl : integer; 
  HTTP : TIdHTTP;
begin 
  CurUrl := 0;
with aThr do begin
  if Terminated then Exit;        Page := TStringList.Create;
  HTTP := TIdHTTP.Create(nil);    HTTP.AllowCookies := True;
  HTTP.HandleRedirects := True;   HTTP.Request.UserAgent := UserAg[random(16)];
  HTTP.ConnectTimeout := 10000;   HTTP.ReadTimeout := 10000;

  HTTP.Request.Accept :='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
  HTTP.Request.AcceptLanguage := 'ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
  HTTP.Request.AcceptEncoding := 'deflate';
  HTTP.Request.Connection := 'keep-alive';

while (Url < StrList.Count) do begin
  if Terminated then Exit;
       CS.Enter;
       Inc(Url);
       CS.Leave;
  if (Url < StrList.Count) then CurUrl := Url else Break;
  FThrStr := StrList.Strings[CurUrl];
  FSData := FThrStr;

try 
  Page.Text := HTTP.GET(FSData);
  Texts := Page.Text;

  if (Pos('блаблабла', Texts) <> 0) then begin
    Rez := 4;
    Synchronize(InfoSync); 
    Continue; 
  end;
 
except
  Rez := 0; 
  Synchronize(InfoSync); 
  Continue;
end;

Rez := 6; Synchronize(InfoSync); Continue;
end; 
end; 
end; // END //

Ошибка в теле цикла WHILE, вылезает не всегда, программа иногда может полностью отработать а иногда на 2-3 минуте начинает странно себя вести.

Алгоритм следующий, запускаю к примеру 20 потоков, каждый поток берет свой URL, делает запрос, проверяет условие, если соответствует то Rez := 4; и через синхронизацию увеличивает счетчик, если ошибка в результате запроса то Rez := 0; и url добавляется в Лог.

Не могу отследить из-за чего возникает ошибка с запросом Page.Text := HTTP.GET(FSData); , программа работает потом ни стого ни с сего начинает быстро на глазах проходить весь цикл, может 100000 урл обработать за пару минут, при этом по снифферу запросы практически не выполняются, а сразу срабатывает исключительная ситуация, в следствии чего так быстро и проходит цикл.

Serzant

Дата 21.2.2014, 20:05 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 11.2.2014

Репутация: нет
Всего: нет

Данная ошибка возникает при использовании более 5-ти потоков, если меньше то все норм. Включил журнал записи лога исключений, программа проработала 5 минут и начала выдавать исключение "ClassName EIdSocketError, message Socket Error # 10054 Connection reset by peer." на каждый запрос.

Код



20:36:59 ClassName EIdHTTPProtocolException, message HTTP/1.1 301 Moved Permanently
20:36:59 ClassName EIdHTTPProtocolException, message HTTP/1.1 404 Not Found
20:37:19 ClassName EIdConnectTimeout, message Connect timed out.
20:37:19 ClassName EIdHTTPProtocolException, message HTTP/1.1 404 Not Found
20:37:20 ClassName EIdConnectTimeout, message Connect timed out.
20:37:20 ClassName EIdHTTPProtocolException, message HTTP/1.1 404 Not Found
20:37:20 ClassName EIdConnectTimeout, message Connect timed out.
20:37:21 ClassName EIdHTTPProtocolException, message HTTP/1.1 404 Not Found
20:37:21 ClassName EIdConnectTimeout, message Connect timed out.
20:37:21 ClassName EIdConnectTimeout, message Connect timed out.
20:37:21 ClassName EIdHTTPProtocolException, message HTTP/1.1 404 Not Found
20:38:33 ClassName EIdSocketError, message Socket Error # 10054
20:39:34 ClassName EIdConnectTimeout, message Connect timed out.
Connection reset by peer.
// Тут 5000 строк повторяещейся ошибки
20:40:57 ClassName EIdSocketError, message Socket Error # 10054
Connection reset by peer.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »