Question

我正在编写一个与excel通信的delphi应用程序。我注意到的一件事是，如果我在Excel工作簿对象上调用Save方法，它可能会挂起，因为excel有一个为用户打开的对话框。我正在使用后期绑定。

我希望我的应用能够注意到Save需要几秒钟，然后采取某种动作，比如显示一个对话框，告诉这是发生了什么。

我觉得这很容易。我需要做的就是创建一个调用Save的线程并让该线程调用Excel的Save例程。如果花了太长时间，我可以采取一些行动。

procedure TOfficeConnect.Save;
var
  Thread:TOfficeHangThread;
begin
  // spin off as thread so we can control timeout
  Thread:=TOfficeSaveThread.Create(m_vExcelWorkbook);

  if WaitForSingleObject(Thread.Handle, 5 {s} * 1000 {ms/s})=WAIT_TIMEOUT then
    begin
      Thread.FreeOnTerminate:=true;
      raise Exception.Create(_('The Office spreadsheet program seems to be busy.'));
    end;

  Thread.Free;
end;

  TOfficeSaveThread = class(TThread)
  private
    { Private declarations }
    m_vExcelWorkbook:variant;
  protected
    procedure Execute; override;
    procedure DoSave;
  public
    constructor Create(vExcelWorkbook:variant);
  end;

{ TOfficeSaveThread }

constructor TOfficeSaveThread.Create(vExcelWorkbook:variant);
begin
  inherited Create(true);

  m_vExcelWorkbook:=vExcelWorkbook;

  Resume;
end;

procedure TOfficeSaveThread.Execute;
begin
  m_vExcelWorkbook.Save;
end;

我理解这个问题的发生是因为OLE对象是从另一个线程（绝对）创建的。

我该如何解决这个问题？我很可能需要以某种方式“重新编组”这个电话......

任何想法？

Answer 1

不是从两个线程访问COM对象，而是在辅助线程中显示消息对话框。 VCL不是线程安全的，但Windows是。

type
  TOfficeHungThread = class(TThread)
  private
    FTerminateEvent: TEvent;
  protected
    procedure Execute; override;
  public
   constructor Create;
   destructor Destroy; override;
   procedure Terminate; override;
  end;

...

constructor TOfficeHungThread.Create;
begin
  inherited Create(True);
  FTerminateEvent := TSimpleEvent.Create;
  Resume;
end;

destructor TOfficeHungThread.Destroy;
begin
  FTerminateEvent.Free;
  inherited;
end;

procedure TOfficeHungThread.Execute;
begin
  if FTerminateEvent.WaitFor(5000) = wrTimeout then
    MessageBox(Application.MainForm.Handle, 'The Office spreadsheet program seems to be busy.', nil, MB_OK);
end;

procedure TOfficeHungThread.Terminate;
begin
  FTerminateEvent.SetEvent;
end;

...

procedure TMainForm.Save;
var
  Thread: TOfficeHungThread;
begin
  Thread := TOfficeHungThread.Create;
  try
    m_vExcelWorkbook.Save;
    Thread.Terminate;
    Thread.WaitFor;
  finally
    Thread.Free;
  end;
end;

Answer 2

这里真正的问题是Office应用程序不适合多线程使用。因为可以有任意数量的客户端应用程序通过COM发出命令，所以这些命令被序列化为调用并逐个处理。但有时Office处于不接受新呼叫的状态（例如，当它显示模式对话框时）并且您的呼叫被拒绝（给您“呼叫被被呼叫者拒绝” - 错误）。 See also the answer of Geoff Darst in this thread.

您需要做的是实施IMessageFilter并处理您的拒绝来电。我是这样做的：

function TIMessageFilterImpl.HandleInComingCall(dwCallType: Integer;
  htaskCaller: HTASK; dwTickCount: Integer;
  lpInterfaceInfo: PInterfaceInfo): Integer;
begin
  Result := SERVERCALL_ISHANDLED;
end;

function TIMessageFilterImpl.MessagePending(htaskCallee: HTASK;
  dwTickCount, dwPendingType: Integer): Integer;
begin
  Result := PENDINGMSG_WAITDEFPROCESS;
end;

function ShouldCancel(aTask: HTASK; aWaitTime: Integer): Boolean;
var
  lBusy: tagOLEUIBUSYA;
begin
  FillChar(lBusy, SizeOf(tagOLEUIBUSYA), 0);
  lBusy.cbStruct := SizeOf(tagOLEUIBUSYA);
  lBusy.hWndOwner := Application.Handle;

  if aWaitTime < 20000 then //enable cancel button after 20 seconds
    lBusy.dwFlags := BZ_NOTRESPONDINGDIALOG;

  lBusy.task := aTask;
  Result := OleUIBusy(lBusy) = OLEUI_CANCEL;
end;

function TIMessageFilterImpl.RetryRejectedCall(htaskCallee: HTASK;
  dwTickCount, dwRejectType: Integer): Integer;
begin
  if dwRejectType = SERVERCALL_RETRYLATER then
  begin
    if dwTickCount > 10000 then //show Busy dialog after 10 seconds
    begin
      if ShouldCancel(htaskCallee, dwTickCount) then
        Result := -1
      else
        Result := 100;
    end
    else
      Result := 100; //value between 0 and 99 means 'try again immediatly', value >= 100 means wait this amount of milliseconds before trying again
  end
  else
  begin
    Result := -1; //cancel
  end;
end;

messagefilter必须在与发出COM调用的线程相同的线程上注册。我的messagefilter实现将在显示标准OLEUiBusy对话框之前等待10秒。此对话框为您提供了重试被拒绝的呼叫的选项（在您的情况下保存）或切换到阻止应用程序（Excel显示模式对话框）。阻止20秒后，将启用取消按钮。单击取消按钮将导致保存呼叫失败。

所以忘记搞乱线程并实现messagefilter，这就是方法处理这些问题。

修改以上修复了“被叫被拒绝的呼叫”错误，但是你有一个保存挂起。我怀疑Save会弹出一个需要你注意的弹出窗口（你的工作簿是否已经有文件名？）。如果它是一个阻碍的弹出窗口，请尝试以下（不是在单独的线程中！）：

{ Turn off Messageboxes etc. } m_vExcelWorkbook.Application.DisplayAlerts := False; try { Saves the workbook as a xls file with the name 'c:\test.xls' } m_vExcelWorkbook.SaveAs('c:\test.xls', xlWorkbookNormal); finally { Turn on Messageboxes again } m_vExcelWorkbook.Application.DisplayAlerts := True; end;

还尝试使用Application.Visible调试：= True;如果有任何弹出窗口，那么您将看到它们并进行更改并采取措施以防止它们出现。

Answer 3

尝试使用CoInitializeEx拨打COINIT_MULTITHREADED，因为MSDN声明：

多线程（也称为自由线程）允许调用此线程创建的对象的方法在任何线程上运行。

Answer 4

'编组'从一个线程到另一个线程的接口可以通过使用CoMarshalInterThreadInterfaceInStream将接口放入流中，将流移动到另一个线程然后使用CoGetInterfaceAndReleaseStream来获取接口来完成从溪流回来。请参阅Delphi中的here for an example。

Answer 5

Lars的回答是我认为的正确答案。他建议的另一种方法是使用GIT（全局接口表），它可以用作接口的跨线程存储库。

请参阅此SO线程here以获取与GIT交互的代码，我在其中发布了一个Delphi单元，可以轻松访问GIT。

这应该只是一个问题，即从主线程中将Excel接口注册到GIT中，然后使用GetInterfaceFromGlobal方法从TOfficeHangThread线程中单独引用接口。

该应用程序调用了一个为不同线程编组的接口

5 个答案: