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 кнопки даже не доходит...
Где я сделал не так? Проблема в таймере? Или поток не срабатывает?