- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我想实现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
被声明为接口(interface),例如IOleMessageFilter
。
var
Filter: IOleMessageFilter;
Filter := TOleMessageFilter.Create as IOleMessageFilter;
Filter.RegisterFilter;
...
Filter.RevokeFilter;
Filter := nil;
并具有自动释放TInterfacedObject
的优点。
如何创建一个新的 IOleMessageFilter
,它“派生”自 IMessageFilter
,但仍然具有新方法 RegisterFilter()
和 RevokeFilter ()
,实现为 TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter)
,并且仍然能够与需要 的
(在 CoRegisterMessageFilter()
一起使用IMessageFilterRegisterFilter()
方法中使用)?
我试图声明:
IOleMessageFilter = interface(IMessageFilter)
procedure RegisterFilter;
procedure RevokeFilter;
end;
TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter)
...
end;
但是调用CoRegisterMessageFilter
会抛出错误:
Interface not supported.
编辑:
我还尝试将 TOleMessageFilter
声明为:
TOleMessageFilter = class(TInterfacedObject, IMessageFilter, IOleMessageFilter)
这“似乎”有效,但我不确定这是正确的方法。
最佳答案
拆分两个接口(interface)并让 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.
关于delphi - 如何使用 TInterfacedObject 扩展现有接口(interface) IMessageFilter?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/46913922/
我有一个基于 TInterfacedObject 的类。我将其添加到 TTreeNode 的 Data 属性中。 TFacilityTreeItem=class(TInterfacedObject)
我需要一个像TInterfacedObject这样的基类,但没有引用计数(所以是一种TNonRefCountedInterfacedObject)。 这实际上是我第n次需要这样的类(class),不知
According to the Delphi docs ,我可以使用 as 运算符将 TInterfacedObject 转换为接口(interface)。 但这对我不起作用。强制转换会产生编译错误
我正在基于:How can I allow a form to accept file dropping without handling Windows messages? 实现我的 IDropTa
我知道一个接口(interface)对象是引用计数的,所以不需要手动释放它。但是如果它有一个 TObject 继承的成员,我应该在析构函数中手动释放这个成员吗? 考虑以下代码: program Pro
我想实现IOleMessageFilter,如下所述: How to: Fix 'Application is Busy' and 'Call was Rejected By Callee' Erro
博客文章“Application Development with C++Builder and Delphi”说的是 Almost anything you write in Delphi can
我想知道 TInterfacedObject 派生类的实例何时被销毁以及谁调用析构函数。我写了一个ScopedLock类,它应该自动调用Release当实例超出范围时同步对象的方法。这是 C++ 中已
我需要一个类实现没有引用计数的接口(interface)。我做了以下事情: IMyInterface = interface(IInterface) ['{B84904DF-9E8A-
以下示例展示了如何开始针对接口(interface)进行编码: 来自 TMyObject = class function Add(a, b: integer): integer; end; 到
我是一名优秀的程序员,十分优秀!