|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
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 + ': запускаем...'; Где я сделал не так? Проблема в таймере? Или поток не срабатывает? |
#2
|
|||
|
|||
Естественно, не срабатывает. Ты же блокируешь основной поток приложения:
Код:
procedure TMyThread1.Execute; begin { Если Вы хотите, чтобы процедура DoWork выполнялась лишь один раз - удалите цикл while } while not Terminated do Synchronize(DoWork); end; Synchronize используется только для обновлнения данных в главном потоке. Нельзя все работу потока засунуть туда. Просто получается, что у тебя поток тупо блокирует главный поток приложения. Править не буду, бо как надо перелопатить всю процедуру потока... |