[VolodinAS]

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

Пытаюсь сделать загрузку URL по клику в отдельном потоке. Делаю в отдельном потоке, так как прогрузка URL осуществляется постоянно с временно́й задержкой. Вот код кнопки:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

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:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80

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:

Код:

1 2 3 4 5 6 7 8

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

Вот глобальные var:

Код:

1 2 3 4

var   frm: Tfrm;   IniFile: TIniFile;   MainThread: TMyThread1;

И сами процедуры Execute и DoWork:

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83

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, но происходит так, что срабатывает только изменение статус бара:

Код:

1	sbar_main.Panels.Items[0].Text := G_SYS_PROFILE + ': запускаем...';

и всё.. дальше приложение зависает... До таймера, который изменяет Caption кнопки даже не доходит...

Где я сделал не так? Проблема в таймере? Или поток не срабатывает?

[lmikle]

Естественно, не срабатывает. Ты же блокируешь основной поток приложения:

Код:

1 2 3 4 5 6

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

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