代码之家 › 专栏 › 技术社区 › X-Ray

应用程序调用了为其他线程封送的接口

ole com excel delphi

X-Ray · 技术社区 · 14 年前

我正在写一个与Excel通信的Delphi应用程序。我注意到的一件事是,如果我调用Excel工作簿对象上的Save方法,它可能会挂起,因为Excel为用户打开了一个对话框。我用的是晚装。

我希望我的应用程序能够注意到保存需要几秒钟,然后采取某种操作,如显示一个对话框,告诉这是发生的事情。

我觉得这很容易。我只需要创建一个调用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对象是从另一个线程创建的(绝对)。

我怎样才能解决这个问题?很可能我需要“重新整理马歇尔”才能打这个电话……

有什么想法吗?

5 回复 | 直到 11 年前

Zoë Peterson RRUZ 14 年前

与其从两个线程访问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;

The_Fox 14 年前

这里真正的问题是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,这就是处理这些问题。

编辑: 上面的修复“Call was rejected by Callee”错误,但是您有一个挂起的保存。我怀疑保存会弹出一个需要您注意的弹出窗口(您的工作簿已经有文件名了吗?)。如果是弹出窗口,请尝试以下操作(不在单独的线程中!):

{ 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进行调试;如果有弹出窗口,您将看到它们发生更改,并采取措施防止将来发生这些更改。

Remko 14 年前

试着打电话 CoInitializeEx 具有 COINIT_MULTITHREADED 由于msdn声明:

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

Lars Truijens 14 年前

“封送”可以使用以下方法完成从一个线程到另一个线程的接口 CoMarshalInterThreadInterfaceInStream 要将接口放入流中,请将该流移动到另一个线程,然后使用 CoGetInterfaceAndReleaseStream 从流中获取接口。看见 here for an example 在德尔菲。

Community T.Woody 7 年前

拉尔斯的回答是正确的。他的建议的另一种选择是使用git(全局接口表),它可以用作接口的跨线程存储库。

看到这个所以线程 here 对于与Git交互的代码,我发布了一个Delphi单元,它提供了对Git的简单访问。

只需从主线程将Excel接口注册到Git中,然后使用getInterfaceFromGlobal方法从TofficeChangThread线程中获取对该接口的单独引用。