VPF::idHTTP в рабочем потоке - Форум программистов

schnaps

Дата 30.3.2010, 18:49 (ссылка)

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

Загрузка ...

Новичок

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

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

Здравствуйте!
собственно возникает такая незадачка: запускаю idHHTP в отдельном потоке (по нажатию кнопки в основном), и пока рабочий поток что то выкачивает, то основная форма подвисает, я недоумеваю. вот код рабочего потока:

Код


unit GetHTML;

interface

uses
  Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF};

type
  TGetHTML = class(TThread)
  private
    FOutHTML : string;
    FURL : string;
    function ReturnWebPage : string;
  protected
    procedure Execute; override;

  public
    property URL : string write FURL;
    property WebPage : string read ReturnWebPage;
  end;

implementation
  uses idHTTP, IdCookieManager;

{ GetHTML }

function TGetHTML.ReturnWebPage : string;
begin

 Execute;
 result := FOutHTML;

end;


procedure TGetHTML.Execute;
var
  HTTP : TIdHTTP;
  CM : TidCookieManager;
  s : string;
begin

  try
      HTTP := TIdHTTP.Create;
      CM := TidCookieManager.Create;

      HTTP.HandleRedirects := true;
      HTTP.CookieManager := CM;
      HTTP.AllowCookies := true;
      HTTP.ProtocolVersion := pv1_1;
      HTTP.RedirectMaximum := 15;
      HTTP.MaxAuthRetries := 3;

      HTTP.Request.AcceptEncoding := 'windows-1251;q=1';
      HTTP.Request.UserAgent :='Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.2) Gecko/20100316 Firefox/3.6.2 WebMoney Advisor';
      HTTP.Request.AcceptLanguage := 'ru;q=1';
      HTTP.Request.Accept := 'text/html;q=1';

      if pos('http://', FURL) <> 0 then
        FOutHTML := HTTP.Get(FURL)
      else
        FOutHTML:= HTTP.Get('http://' + FURL);
  finally
      HTTP.Free;
      CM.Free;
  end;

end;

end.

а вот код запуска потока

Код


procedure TForm1.btn_puskClick(Sender: TObject);
var
  NewThread: TGetHTML;
begin
  NewThread := TGetHTML.Create;
  NewThread.FreeOnTerminate := True;

  try
    NewThread.URL := 'пусть будет yandex.ru';
    NewThread.Resume;
    memo1.Lines.Add(NewThread.WebPage);
  finally
      NewThread.Free;
  end;

end;

в догонку еще вопрос: в настройках IdHTTP выставляю вот так

Код


HTTP.Request.AcceptEncoding := 'windows-1251;q=1';

а эта сволочь возвращает мне UTF8

Matematik

Дата 30.3.2010, 19:14 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

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

Цитата(schnaps @ 30.3.2010, 18:49

)

а вот код запуска потока

Обрати внимание на строки 6 и 13

Цитата(schnaps @ 30.3.2010, 18:49

)

в догонку еще вопрос: в настройках IdHTTP выставляю вот так

Подозреваю, сервер просто игнорирует поле.

schnaps

Дата 30.3.2010, 19:28 (ссылка)

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

Загрузка ...

Новичок

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

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

эм.... ну да smile

косячок, но не думаю что жто влияет на затупу главной формы

А по поводу сервера, скажу по секрету, вчера как то колупал конкрентный сервер, он мне выдавал в win-1251, но настроек idHTTP не помню, потому как проект убил, кажется вообще дефолтные были,а эти я взял из снифера и подкрутил чтоб utf8 не раздавал, но не врубаюсь почему команда игнорируется smile

Akella

Дата 31.3.2010, 15:02 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Цитата(schnaps @ 30.3.2010, 18:49

)

HTTP.Request.AcceptEncoding := 'windows-1251;q=1';

а что ты этим хочешь сделать?

Добавлено через 53 секунды
Используй ExtraHeaders.

Matematik

Дата 31.3.2010, 17:41 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

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

Цитата(schnaps @ 30.3.2010, 18:49)

в догонку еще вопрос: в настройках IdHTTP выставляю вот так

Код


HTTP.Request.AcceptEncoding := 'windows-1251;q=1';

а эта сволочь возвращает мне UTF8

AcceptEncoding , как следует из названия, только указывает какие кодировки понимает клиент. Это не приказ серверу в какой кодировке посылать данные.
Логично что сервер не будет для каждого клиента преобразовывать кодировку.

GET / HTTP/1.1
Host: ya.ru
Accept: text/html, */*
Accept-Encoding: windows-1251
User-Agent: Mozilla/3.0 (compatible; Indy Library)

HTTP/1.1 200 OK
Server: nginx
Date: Wed, 31 Mar 2010 14:40:04 GMT
Content-Type: text/html; charset=utf-8
Content-Length: 4962
Last-Modified: Tue, 12 Jan 2010 15:29:04 GMT
Connection: keep-alive
Accept-Ranges: bytes

<!DOCTYPE HTML PUBLIC

Это сообщение отредактировал(а) Matematik - 31.3.2010, 17:41

Akella

Дата 31.3.2010, 20:01 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Цитата(Matematik @ 31.3.2010, 17:41

)

Это не приказ серверу в какой кодировке посылать данные.

Вот. Вот.

schnaps, это ты должен узнать в какой кодировке сервер отдаёт информацию и работать уже дальше с этой кодировкой.

schnaps

Дата 1.4.2010, 05:09 (ссылка)

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

Загрузка ...

Новичок

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

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

Ладно, кодировка пес с ней, уговорили smile

) но как быть что формочка основная подвисает? так и не могу понять в чем дело smile

Mikel

Дата 2.4.2010, 21:54 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник Клуба
Сообщений: 882
Регистрация: 30.3.2002
Где: Саратов

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

Почитайте про работу с потоками. Примерно так должно выглядеть:

Код


procedure TForm1.btn_puskClick(Sender: TObject);
var
  NewThread: TGetHTML;
begin
  NewThread := TGetHTML.Create(true);
  NewThread.FreeOnTerminate := True;
  NewThread.URL := 'пусть будет yandex.ru';
  NewThread.Resume;
    

end;

Код


procedure TGetHTML.ReturnWebPage;
begin
 Form1.memo1.Lines.Add(FOutHTML);
end;

procedure TGetHTML.Execute;
var
  HTTP : TIdHTTP;
  CM : TidCookieManager;
  s : string;
begin
  try
      HTTP := TIdHTTP.Create;
      CM := TidCookieManager.Create;
      HTTP.HandleRedirects := true;
      HTTP.CookieManager := CM;
      HTTP.AllowCookies := true;
      HTTP.ProtocolVersion := pv1_1;
      HTTP.RedirectMaximum := 15;
      HTTP.MaxAuthRetries := 3;
      HTTP.Request.AcceptEncoding := 'windows-1251;q=1';
      HTTP.Request.UserAgent :='Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.2) Gecko/20100316 Firefox/3.6.2 WebMoney Advisor';
      HTTP.Request.AcceptLanguage := 'ru;q=1';
      HTTP.Request.Accept := 'text/html;q=1';
      if pos('http://', FURL) <> 0 then
        FOutHTML := HTTP.Get(FURL)
      else
        FOutHTML:= HTTP.Get('http://' + FURL);
  Synchronize(ReturnWebPage);
  finally
      HTTP.Free;
      CM.Free;
  end;

end;

--------------------

...so remember, it's better to burn out than to fade away

Демо

Дата 2.4.2010, 22:12 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

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

1. См. сообщение от Mikel http://forum.vingrad.ru/index.php?showtopi...t&p=2128578

2. Всё неправильно.

Код


procedure TForm1.btn_puskClick(Sender: TObject);
var
  NewThread: TGetHTML;
begin
  NewThread := TGetHTML.Create;
  NewThread.FreeOnTerminate := True;

  try
    NewThread.URL := 'пусть будет yandex.ru';
    NewThread.Resume;
    memo1.Lines.Add(NewThread.WebPage);
  finally
      NewThread.Free;
  end;

end;

Ты не понял сам, что в этом коде происходит.

По строкам:

1.   NewThread := TGetHTML.Create; //Создаём доп. нить - всё в порядке.

2.   NewThread.FreeOnTerminate := True; //Указываем, что объект нашего класса будет уничтожен сразу после того, как выполнится поточная функция (на OnTerminate не будем обращать внимание - у тебя его нет).

3.   NewThread.URL := 'пусть будет yandex.ru';  /Присваиваем адрес URL. Здесь пока в порядке

4.  NewThread.Resume; //В этот момент поточная функция начинает исполняться и вызывается Execute
В ней выполняется запрос.
Обрати внимание на следущую строчку.

5. memo1.Lines.Add(NewThread.WebPage); //В этот момент ты вызываешь с какого-то перепугу метод потока, который
вызывает Execute (что совершенно неправильно).

Но это ещё полбеды.
Метод Execute ты выполняешь как обычную процедуру в основном потоке. Естественно, что в этот момент форма не обновляется.

Но этого мало. В этот момент Execute, который начал работать после NewThread.Resume может закончить выполнение,
  после чего твой поток успешно самоуничтожится, но Execute, который ты вызвал в основном потоке, ещё продолжает выполняться.

У тебя не возникает AV только из-за того, что метод Execute статический.

6.   finally
      NewThread.Free;

Мало того, что поток ранее уже самоуничтожился, ты пытаешься его здесь убить ещё раз.

Добавлено через 5 минут и 10 секунд
Итог: без изучения принципов многопоточной разработки мало что получится.

http://forum.vingrad.ru/forum/topic-60076.html
http://www.almar.net.ru/dokuwiki/doku.php?id=articles:00000

Это сообщение отредактировал(а) Демо - 2.4.2010, 22:14

--------------------

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