IdThreadComponent messes the User interface - multithreading

Question

I am using the IdThreadComponent to perform a simple ftp upload to a server.
The code to the ftp upload is as follows :
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;
The FtpWorkEnd is as follows :
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;
When the upload is completed, the http post is made and in response I get a string [Success/Failure] from the server.
The problem is, after this MessageDlg, the components of my app, turns in to white blocks and the app's controls can no longer be used.
I did try an update() on the form, but that didn't help.
I'm using Business Skin Forms to skin my app, and the thread component is messing the form after closing.

Answer 1

The TIdThreadComponent.OnRun event handler runs in the context of a worker thread, not in the main UI thread. All of your TIdFTP operations are running in the context of the worker thread, which is fine. However, your TIdFTP.OnWorkEnd event handler is trying to make UI updates, but it is running in the worker thread as well, not in the main UI thread. That is not safe. You MUST synchronize with the main UI thread in order to access the UI safely. That includes calls to MessageDlg(), which is not a thread-safe function.
Try something more like this:
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;
If you are using a version of Delphi that does not support anonymous procedures, you can replace TThread.Queue() with TIdNotify instead:
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;