IdThreadComponent messes Пользовательский интерфейс

Question

Я использую IdThreadComponent для выполнения простой загрузки ftp на сервер.

Код для загрузки FTP выглядит следующим образом:

procedure TfrmNoticeWindow.IdThreadComponent1Run(
    Sender: TIdCustomThreadComponent); 

begin 
    IdFtp1.Host := 'ip'; 
    IdFtp1.Username := 'user'; 
    IdFtp1.Password := 'pass'; 
    try 
    IdFtp1.Connect; 
    except 
    begin 
     msgDlgBox.MessageDlg('Could not connect!', mtError, [mbOk], 0); 
     publishing := false; 
    end; 
    end; 
    IdFtp1.Put(txtPath.text, file_name); 
    IdFtp1.Quit; 
    IdFtp1.Disconnect; 
End; 

FtpWorkEnd выглядит следующим образом:

procedure TfrmNoticeWindow.IdFTP1WorkEnd(Sender: TObject; 
    AWorkMode: TWorkMode); 
var 
    Params : TStringList; 
    Resp : String; 
begin 
    IdThreadComponent1.Active := false; 
    Params := TStringList.Create; 
    Params.Add('enotice_publish='+packet); 
    if (aborted = true) then 
    begin 
    IdFtp1.Quit; 
    idFtp1.Disconnect; 
    aborted := false; 
    uploadGauge.Value := 0; 
    uploadGauge.Visible := false; 
    frmNoticeWindow.Height := 512; 
    btnUpload.Caption := 'Publish'; 
    exit; 
    end; 
    Resp := doPost('url', params); 
    if (Resp = 'Notice published successfully!') then 
    msgDlgBox.MessageDlg(Resp, mtInformation, [mbOk], 0) 
    else 
    msgDlgBox.MessageDlg(Resp, mtError, [mbOk], 0); 

    frmNoticeWindow.Refresh; 

    uploadGauge.Value := 0; 
    uploadGauge.Visible := false; 
    frmNoticeWindow.Height := 512; 
    btnUpload.Caption := 'Publish'; 
    publishing := false; 
    txtPath.Text := ''; 
    txtNoticeHeader.Text := ''; 
end; 

Когда загрузка будет завершена, HTTP POST сделан и в ответ я получаю строка [Success/Failure] с сервера.

Проблема заключается в том, что после этого MessageDlg компоненты моего приложения превращаются в белые блоки, и элементы управления приложения больше не могут использоваться.

Я попробовал обновление() в форме, но это не помогло.

Я использую Business Skin Forms для защиты своего приложения, а компонент нити заполняет форму после закрытия.

Answer 1

Обработчик события TIdThreadComponent.OnRun работает в контексте рабочего потока, а не в основном потоке пользовательского интерфейса. Все ваши операции TIdFTP выполняются в контексте рабочего потока, что отлично. Однако обработчик событий TIdFTP.OnWorkEnd пытается сделать обновления пользовательского интерфейса, но он также работает в рабочем потоке, а не в основном потоке пользовательского интерфейса. Это небезопасно. Для обеспечения доступа к пользовательскому интерфейсу вы ДОЛЖНЫ синхронизироваться с основным потоком пользовательского интерфейса. Это включает вызовы MessageDlg(), которые не являются потокобезопасной функцией.

Попробуйте что-то больше, как это:

procedure TfrmNoticeWindow.IdThreadComponent1Run(
    Sender: TIdCustomThreadComponent); 
begin 
    IdFtp1.Host := 'ip'; 
    IdFtp1.Username := 'user'; 
    IdFtp1.Password := 'pass'; 
    if aborted then Exit; 
    try 
    IdFtp1.Connect; 
    except 
    TThread.Queue(nil, 
     procedure 
     begin 
     msgDlgBox.MessageDlg('Could not connect!', mtError, [mbOk], 0); 
     end 
    ); 
    Exit; 
    end; 
    try 
    if not aborted then 
     IdFtp1.Put(txtPath.text, file_name); 
    finally 
    IdFtp1.Disconnect; 
    end; 
end; 

procedure TfrmNoticeWindow.IdThreadComponent1AfterRun(
    Sender: TIdCustomThreadComponent); 
begin 
    publishing := false; 
    TThread.Queue(nil, 
    procedure 
    begin 
     uploadGauge.Value := 0; 
     uploadGauge.Visible := false; 
     frmNoticeWindow.Height := 512; 
     btnUpload.Caption := 'Publish'; 
     if not aborted then 
     begin 
     txtPath.Text := ''; 
     txtNoticeHeader.Text := ''; 
     end; 
    end 
); 
end; 

procedure TfrmNoticeWindow.IdFTP1Work(Sender: TObject; 
    AWorkMode: TWorkMode; AWorkCount: Int64); 
begin 
    if aborted then 
    IdFtp1.Abort; 
end; 

procedure TfrmNoticeWindow.IdFTP1WorkEnd(Sender: TObject; 
    AWorkMode: TWorkMode); 
var 
    Params : TStringList; 
    Resp : String; 
begin 
    if aborted then Exit; 
    Params := TStringList.Create; 
    try 
    Params.Add('enotice_publish='+packet); 
    Resp := doPost('url', params); 
    finally 
    Params.Free; 
    end; 
    TThread.Queue(nil, 
    procedure 
    begin 
     if (Resp = 'Notice published successfully!') then 
     msgDlgBox.MessageDlg(Resp, mtInformation, [mbOk], 0) 
     else 
     msgDlgBox.MessageDlg(Resp, mtError, [mbOk], 0);  
    end 
); 
end; 

Если вы используете версию Delphi, которая не поддерживает анонимные процедуры, вы можете заменить TThread.Queue() с TIdNotify вместо:

uses 
    ..., IdSync; 

procedure TfrmNoticeWindow.MsgBoxCouldNotConnect; 
begin 
    msgDlgBox.MessageDlg('Could not connect!', mtError, [mbOk], 0); 
end; 

procedure TfrmNoticeWindow.MsgBoxPostOk; 
begin 
    msgDlgBox.MessageDlg('Notice published successfully!', mtInformation, [mbOk], 0) 
end; 

procedure TfrmNoticeWindow.MsgBoxPostFail; 
begin 
    msgDlgBox.MessageDlg('Notice failed to publish!', mtError, [mbOk], 0);  
end; 

procedure TfrmNoticeWindow.ResetUiOk; 
begin 
    uploadGauge.Value := 0; 
    uploadGauge.Visible := false; 
    frmNoticeWindow.Height := 512; 
    btnUpload.Caption := 'Publish'; 
    txtPath.Text := ''; 
    txtNoticeHeader.Text := ''; 
end; 

procedure TfrmNoticeWindow.ResetUiAborted; 
begin 
    uploadGauge.Value := 0; 
    uploadGauge.Visible := false; 
    frmNoticeWindow.Height := 512; 
    btnUpload.Caption := 'Publish'; 
end; 

procedure TfrmNoticeWindow.IdThreadComponent1Run(
    Sender: TIdCustomThreadComponent); 
begin 
    IdFtp1.Host := 'ip'; 
    IdFtp1.Username := 'user'; 
    IdFtp1.Password := 'pass'; 
    if aborted then Exit; 
    try 
    IdFtp1.Connect; 
    except 
    TIdNotify.NotifyMethod(MsgBoxCouldNotConnect); 
    Exit; 
    end; 
    try 
    if not aborted then 
     IdFtp1.Put(txtPath.text, file_name); 
    finally 
    IdFtp1.Disconnect; 
    end; 
end; 

procedure TfrmNoticeWindow.IdThreadComponent1AfterRun(
    Sender: TIdCustomThreadComponent); 
begin 
    publishing := false; 
    if aborted then 
    TIdNotify.NotifyMethod(ResetUiAborted) 
    else 
    TIdNotify.NotifyMethod(ResetUiOk); 
end; 

procedure TfrmNoticeWindow.IdFTP1Work(Sender: TObject; 
    AWorkMode: TWorkMode; AWorkCount: Int64); 
begin 
    if aborted then 
    IdFtp1.Abort; 
end; 

procedure TfrmNoticeWindow.IdFTP1WorkEnd(Sender: TObject; 
    AWorkMode: TWorkMode); 
var 
    Params : TStringList; 
    Resp : String; 
begin 
    if aborted then Exit; 
    Params := TStringList.Create; 
    try 
    Params.Add('enotice_publish='+packet); 
    Resp := doPost('url', params); 
    if (Resp = 'Notice published successfully!') then 
     TIdNotify.NotifyMethod(MsgBoxPostOk) 
    else 
     TIdNotify.NotifyMethod(MsgBoxPostFail); 
    finally 
    Params.Free; 
    end; 
end;