IdThreadComponent 弄乱了用户界面

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 之后，我的应用程序的组件变成了白色块，应用程序的控件无法再使用。

我确实在表单上尝试了 update()，但没有帮助。

我正在使用 Business Skin Forms 为我的应用程序设计皮肤，线程组件在关闭后弄乱了表单。

Answer 1

TIdThreadComponent.OnRun 事件处理程序在工作线程的上下文中运行，而不是在主 UI 线程中运行。您的所有 TIdFTP 操作在工作线程的上下文中都是运行，这很好。但是，您的 TIdFTP.OnWorkEnd 事件处理程序正在尝试进行 UI 更新，但它也在工作线程中运行，而不是在主 UI 线程中。那不安全。您必须与主 UI 线程同步才能安全地访问 UI。这包括对 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;

IdThreadComponent 弄乱了用户界面

IdThreadComponent messes the User interface

delphi

ftp

multithreading