Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 29.07.2022, 21:57
VolodinAS VolodinAS вне форума
Прохожий
 
Регистрация: 16.07.2017
Сообщения: 23
Версия Delphi: Delphi XE3
Репутация: 10
Вопрос IdHttp в отдельном потоке

IdHttp в отдельном потоке

Пытаюсь сделать загрузку URL по клику в отдельном потоке. Делаю в отдельном потоке, так как прогрузка URL осуществляется постоянно с временно́й задержкой. Вот код кнопки:
Код:
procedure Tfrm.btn_launchClick(Sender: TObject);
begin
  if not G_SYS_ISLAUNCHED then
  begin
    sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': запускаем...';
    G_SYS_ISLAUNCHED := true;
    // StartIdHttpCycle;
    MainThread := TMyThread1.Create(true);
    MainThread.FreeOnTerminate := true;
    MainThread.Priority := tpLower;
    MainThread.Resume;
  end
  else
  begin
    G_SYS_ISLAUNCHED := False;
    sbar_main.Panels.Items[0].Text := 'загружен ' + G_SYS_PROFILE;

    MainThread.Terminate;
  end;
end;

G_SYS_ISLAUNCHED - это глобальная переменная, которую считывает таймер 1 раз в 100 секунд. Если переменная true - блокируются все поля ввода и кнопки на форме, если false - разблокируются

Вот сама функция onTimer:
Код:
procedure Tfrm.isNewTimer(Sender: TObject);
begin
  // if G_SYS_ISNEW then
  // begin
  if (edit_profileName.Text <> '') and (edit_url.Text <> '') and
    (rgb_success.ItemIndex > -1) and (rgb_fail.ItemIndex > -1) and
    (edit_success_w_from.Text <> '') and (edit_success_w_to.Text <> '') and
    (edit_success_wa_from.Text <> '') and (edit_success_wa_to.Text <> '') and
    (edit_fail_w_from.Text <> '') and (edit_fail_w_to.Text <> '') and
    (edit_fail_wa_from.Text <> '') and (edit_fail_wa_to.Text <> '') then
  begin
    btn_save.Enabled := true;
  end
  else
  begin
    btn_save.Enabled := False;
  end;
  // end;

  if G_SYS_PROFILE <> '' then
  begin
    btn_remove.Enabled := true;
  end
  else
  begin
    btn_remove.Enabled := False;
  end;

  if G_SYS_PROFILE <> '' then
  begin
    btn_launch.Enabled := true;
  end
  else
  begin
    btn_launch.Enabled := False;
  end;

  if G_SYS_ISLAUNCHED then
  begin
    lbox_list.Enabled := False;
    btn_launch.Caption := 'ОСТАНОВИТЬ';
    btn_save.Enabled := False;
    btn_remove.Enabled := False;
    btn_new.Enabled := False;

    edit_profileName.Enabled := False;
    edit_url.Enabled := False;
    rgb_success.Enabled := False;
    rgb_fail.Enabled := False;
    edit_success_w_from.Enabled := False;
    edit_success_w_to.Enabled := False;
    edit_success_wa_from.Enabled := False;
    edit_success_wa_to.Enabled := False;
    edit_fail_w_from.Enabled := False;
    edit_fail_w_to.Enabled := False;
    edit_fail_wa_from.Enabled := False;
    edit_fail_wa_to.Enabled := False;
  end
  else
  begin
    lbox_list.Enabled := true;
    btn_launch.Caption := 'Запустить';
    btn_save.Enabled := true;
    btn_remove.Enabled := true;
    btn_new.Enabled := true;

    edit_profileName.Enabled := true;
    edit_url.Enabled := true;
    rgb_success.Enabled := true;
    rgb_fail.Enabled := true;
    edit_success_w_from.Enabled := true;
    edit_success_w_to.Enabled := true;
    edit_success_wa_from.Enabled := true;
    edit_success_wa_to.Enabled := true;
    edit_fail_w_from.Enabled := true;
    edit_fail_w_to.Enabled := true;
    edit_fail_wa_from.Enabled := true;
    edit_fail_wa_to.Enabled := true;
  end;
end;

Вот type:

Код:
type
  TMyThread1 = class(TThread)
  private
    { Private declarations }
  protected
    procedure DoWork;
    procedure Execute; override;
  end;

Вот глобальные var:
Код:
var
  frm: Tfrm;
  IniFile: TIniFile;
  MainThread: TMyThread1;

И сами процедуры Execute и DoWork:
Код:
procedure TMyThread1.Execute;
begin
  { Если Вы хотите, чтобы процедура DoWork выполнялась лишь один раз - удалите цикл while }
  while not Terminated do
    Synchronize(DoWork);
end;

procedure TMyThread1.DoWork;
var
  data: string;
  code: Integer;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
  lHTTP: TIdHTTP;
  rnd: Integer;
begin
  frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': загружаю...';
  // ShowMessage('START');
  SSL := TIdSSLIOHandlerSocketOpenSSL.Create(frm);
  SSL.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
  lHTTP := TIdHTTP.Create(nil);

  try
    lHTTP.IOHandler := SSL;
    lHTTP.HandleRedirects := true;
    data := lHTTP.Get(frm.edit_url.Text);
    code := lHTTP.ResponseCode;
    // ShowMessage(IntToStr(code));
    // ShowMessage(data);
    frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': ' + IntToStr(code);
    if code = -1 then
    begin
      // запрос успешный, схема
      if frm.rgb_success.ItemIndex = 0 then
      begin
        Randomize;
        rnd := RandomRange(StrToInt(frm.edit_success_w_from.Text),
          StrToInt(frm.edit_success_w_to.Text));
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': ждем рандом ('
          + frm.edit_success_w_from.Text + ', ' + frm.edit_success_w_to.Text +
          ') = ' + IntToStr(rnd);
        Sleep(rnd * 1000);
      end
      else if frm.rgb_success.ItemIndex = 1 then
      begin
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE +
          ': ждем дополнительно';
      end
      else if frm.rgb_success.ItemIndex = 2 then
      begin
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': сразу';
      end;

    end;
  except
    on E: Exception do
    begin
      // перезапуск, схема
      if frm.rgb_fail.ItemIndex = 0 then
      begin
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE +
          ': ОШИБКА, ждем рандом';
        Randomize;
        rnd := RandomRange(StrToInt(frm.edit_fail_w_from.Text),
          StrToInt(frm.edit_fail_w_to.Text));
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE +
          ': ОШИБКА, ждем рандом (' + frm.edit_fail_w_from.Text + ', ' +
          frm.edit_fail_w_to.Text + ') = ' + IntToStr(rnd);
        Sleep(rnd * 1000);
      end
      else if frm.rgb_fail.ItemIndex = 1 then
      begin
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE +
          ': ОШИБКА, ждем дополнительно';
      end
      else if frm.rgb_fail.ItemIndex = 2 then
      begin
        frm.sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': ОШИБКА, сразу';
      end;
    end;

  end;

end;

Я рассчитывал, что при нажатии btn_launch кнопка, исходя из функции таймера, поменяет свой Caption и потихоньку начнётся циклическое пингование URL, но происходит так, что срабатывает только изменение статус бара:
Код:
sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': запускаем...';
и всё.. дальше приложение зависает... До таймера, который изменяет Caption кнопки даже не доходит...

Где я сделал не так? Проблема в таймере? Или поток не срабатывает?
Ответить с цитированием
  #2  
Старый 29.07.2022, 22:45
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,052
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Естественно, не срабатывает. Ты же блокируешь основной поток приложения:
Код:
procedure TMyThread1.Execute;
begin
  { Если Вы хотите, чтобы процедура DoWork выполнялась лишь один раз - удалите цикл while }
  while not Terminated do
    Synchronize(DoWork);
end;

Synchronize используется только для обновлнения данных в главном потоке. Нельзя все работу потока засунуть туда. Просто получается, что у тебя поток тупо блокирует главный поток приложения.
Править не буду, бо как надо перелопатить всю процедуру потока...
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 22:20.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter