Question

我想按照此处所述实施IOleMessageFilter：

How to: Fix 'Application is Busy' and 'Call was Rejected By Callee' Errors

我找到了一个工作正常的Delphi实现：

`EOleException: Call was rejected by callee` while iterating through `Office.Interop.Word.Documents`

（见答案中的更新＃1）

实现如下：

type
  TOleMessageFilter = class(TInterfacedObject, IMessageFilter)
  public
    // IMessageFilter
    function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask;
      dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall;
    function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint;
      dwRejectType: Longint): Longint;stdcall;
    function MessagePending(htaskCallee: HTask; dwTickCount: Longint;
      dwPendingType: Longint): Longint;stdcall;

    // TOleMessageFilter
    procedure RegisterFilter;
    procedure RevokeFilter;
  end;

implementation

function TOleMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint;
begin
  Result := 0;
end;

function TOleMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint;
begin
  Result := 2 //PENDINGMSG_WAITDEFPROCESS
end;        

function TOleMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint;
begin
  Result := -1;
  if dwRejectType = 2 then
    Result := 99;
end;

procedure TOleMessageFilter.RegisterFilter;
var
  OldFilter: IMessageFilter;
  NewFilter: IMessageFilter;
begin
  OldFilter := nil;
  NewFilter := TOleMessageFilter.Create as IMessageFilter;
  CoRegisterMessageFilter(NewFilter,OldFilter);
end;

procedure TOleMessageFilter.RevokeFilter;
var
  OldFilter: IMessageFilter;
  NewFilter: IMessageFilter;
begin
  OldFilter := nil;
  NewFilter := nil;
  CoRegisterMessageFilter(NewFilter,OldFilter);
end;

这个精确的Delphi代码可以在网上的许多其他网站上找到。到现在为止还挺好。我只是将班级名称改为TOleMessageFilter而不是IOleMessageFilter。

然而，使用有点烦人。

var
  Filter: TOleMessageFilter;

Filter := TOleMessageFilter.Create;
Filter.RegisterFilter;    
...    
Filter.RevokeFilter;
Filter.Free;

我想要的是，Filter被声明为接口，例如IOleMessageFilter。

var
  Filter: IOleMessageFilter;

Filter := TOleMessageFilter.Create as IOleMessageFilter;
Filter.RegisterFilter;
...
Filter.RevokeFilter;
Filter := nil;

并享有自动释放TInterfacedObject。

的好处

如何创建新的IOleMessageFilter＆＃34;派生＆＃34;来自IMessageFilter但仍有新方法RegisterFilter()和RevokeFilter()，已实现为TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter)，并且仍然可以将CoRegisterMessageFilter()用于IMessageFilter期望RegisterFilter() 1}}（用于IOleMessageFilter = interface(IMessageFilter) procedure RegisterFilter; procedure RevokeFilter; end; TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter) ... end;方法）？

我试图声明：

CoRegisterMessageFilter

但是然后调用TOleMessageFilter会引发错误：

不支持接口。

修改

我还尝试将TOleMessageFilter = class(TInterfacedObject, IMessageFilter, IOleMessageFilter)声明为：

String url = "jdbc:derby://localhost:1527/db;create=true;user=Administrator";

String driver = "org.apache.derby.jdbc.ClientDriver";

// login and connection details above
try {
    Class.forName("org.apache.derby.jdbc.ClientDriver").newInstance();
    conn = DriverManager.getConnection(url);
    Statement s = conn.createStatement();

    System.out.println("connected!");
} catch (ClassNotFoundException | SQLException e) {
    JOptionPane.showMessageDialog(null, "error in dbConnection " + e);
    System.out.println(e.toString());
} catch (Exception e) {
    JOptionPane.showMessageDialog(null, "Error in DBconnection , consult developers!");
}

＆＃34;似乎＆＃34;工作，但我不确定它是否正确。

Answer 1

拆分两个接口，让TOleMessageFilter保留对实际消息过滤器的引用，作为奖励，您不必再调用RegisterFilter和RevokeFilter，因为这将从构造函数/析构函数中完成：

program SO46913922;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  ActiveX,
  Windows,
  SysUtils;


type
  IOleMessageFilter = interface
  ['{0ECA5DA7-F6C7-4D21-8FD3-872558F88CBE}']
    procedure RegisterFilter;
    procedure RevokeFilter;
  end;

  TMessageFilter = class(TInterfacedObject, IMessageFilter)
  public
    // IMessageFilter
    function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask;
      dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall;
    function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint;
      dwRejectType: Longint): Longint;stdcall;
    function MessagePending(htaskCallee: HTask; dwTickCount: Longint;
      dwPendingType: Longint): Longint;stdcall;
  end;

  TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter)
  private
    Filter : IMessageFilter;
    procedure RegisterFilter;
    procedure RevokeFilter;
  public
    constructor Create;
    destructor Destroy; override;
  end;


function TMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint;
begin
  Result := 0;
end;

function TMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint;
begin
  Result := 2 //PENDINGMSG_WAITDEFPROCESS
end;

function TMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint;
begin
  Result := -1;
  if dwRejectType = 2 then
    Result := 99;
end;

procedure TOleMessageFilter.RegisterFilter;
var
  OldFilter: IMessageFilter;

begin
  OldFilter := nil;
  Filter := TMessageFilter.Create;
  CoRegisterMessageFilter(Filter,OldFilter);
end;

procedure TOleMessageFilter.RevokeFilter;
var
  OldFilter: IMessageFilter;
  NewFilter: IMessageFilter;
begin
  OldFilter := nil;
  NewFilter := nil;
  CoRegisterMessageFilter(NewFilter,OldFilter);
  Filter := nil;
end;

constructor TOleMessageFilter.Create;
begin
 RegisterFilter;
end;

destructor TOleMessageFilter.Destroy;
begin
 RevokeFilter;
 inherited;
end;

var
  Filter :  IOleMessageFilter;

begin
  try
   CoInitialize(nil);
   Filter := TOleMessageFilter.Create;
   Readln; // do something
   Filter := nil;
  finally
   CoUninitialize();
  end;
  Readln;
end.

如何使用TInterfacedObject扩展现有接口IMessageFilter？

1 个答案: