VPF::Прерывания выполнения потока по Time out

Vitus28

Дата 20.3.2014, 07:32 (ссылка)

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

Загрузка ...

Новичок

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

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

Здравствуйте!
Сталкнулся с такой проблемой. После того как поток останавливается по TIME OUT в дальнейших потоках функция не работает.

Цитата

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TParam = class
    public
      url: string;
  end;

var
  Form1: TForm1;
  hThread: THandle;
  check: integer;
  text11: string;

implementation

{$R *.dfm}

function CheckUrl(p: Pointer): DWORD; stdcall;
var
  hSession,hfile: hInternet;
  dwindex,dwcodelen: dword;
  dwcode: array[1..20] of char;
  lpBuffer: array[0..1024 + 1] of Char;
  res: pchar;
  dwBytesRead: DWORD;
  URL: string;
begin
  URL:=TParam(p).url;
  hSession:= InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 1);
  if assigned(hsession) then begin
    hfile:= InternetOpenUrl(hsession,pchar(URL),nil,0,INTERNET_FLAG_RELOAD,0);
    dwIndex:= 0;
    dwCodeLen:= 10;
    HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
    res:= pchar(@dwcode);
    if (assigned(hfile) and (res = '200')) then begin
      dwBytesRead := 1024;
      InternetReadFile(hfile, @lpBuffer, 1024, dwBytesRead);
      text11:=utf8toansi(lpBuffer);
      if pos('<title>Доступ ограничен</title>',utf8toansi(lpBuffer)) = 0 then result:=1 else result:=0;
    end else result:=0;
    if assigned(hfile) then InternetCloseHandle(hfile);
    InternetCloseHandle(hsession);
  end else result:=0;

  check:=result;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  param: TParam;
begin
  param:=TParam.Create;
  for i:=0 to ListBox1.Items.Count-1 do begin
    param.url:=ListBox1.Items.Strings[i];
    check:=-100;
    text11:='';
    hThread:=CreateThread(nil, 0, @CheckUrl, Pointer(param), 0, pdword(0)^);
    SetThreadPriority(hThread, THREAD_PRIORITY_BELOW_NORMAL);
    if WaitForSingleObject(hThread, 2000) = WAIT_TIMEOUT then begin
      SuspendThread(hThread);
      Memo1.Lines.Add('Time out!');
    end;
    if TerminateThread(hThread, 0) then Memo1.Lines.Add('TerminateThread - OK') else Memo1.Lines.Add('TerminateThread - ERROR');
    CloseHandle(hThread);
    Memo1.Lines.Add(IntToStr(check));
    //Memo1.Lines.Add(text11);
    Memo1.Lines.Add('========================================================');
  end;
  Memo1.Lines.Add('End');
end;

В листе список урлов:

Цитата

http://growblog.pro/
http://www.mail.ru/
http://rutracker.ru/viewtopic.php?t=46287
http://trava.kiev.ua/archives/689
http://www.drom.ru

http://trava.kiev.ua/archives/689 - вот этот вообще недоступен и поток из него выходит по time out. И следующий url тоже вываливается по time out, хотя доступен!

Это сообщение отредактировал(а) Vitus28 - 21.3.2014, 02:46

Vitus28

Дата 21.3.2014, 03:20 (ссылка)

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

Загрузка ...

Новичок

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

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

Понял почему так проивходит.
В функции начинает выполняться hfile:= InternetOpenUrl(hsession,pchar(URL),nil,0,INTERNET_FLAG_RELOAD,0); и зависает на период ожидания соединения (это по тайм ауту 2 минуты - настройка на проксе). Соответственно, соединение не освобождается и в дальнейшем функция отрабатывает не правильно.
У кого-нибудь есть мысли как можно это исправить? Спасибо!

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