api - Delphi 匿名函数与 SetTimer API 抛出 "privileged instruction"异常

Question

我正在努力解决 Delphi 中的一些匿名方法。

当调用 Execute 方法并且该方法内创建的计时器超时时，它会抛出“特权指令”异常。

这是因为我的匿名函数超出了范围吗？

unit OneShotTimerReloaded;

interface

uses
  System.SysUtils, System.Classes;

type
  IOneShotTimerReloaded = interface
    ['{51DE72F0-4784-4CEB-A065-0B64D6EEA626}']

    procedure Execute(Proc: TProc; TimeOut: Cardinal = 1000); overload;
    procedure Execute(Proc: TProcedure; TimeOut: Cardinal = 1000); overload;
    procedure Execute(Event: TNotifyEvent; TimeOut: Cardinal = 1000; Sender: TObject = nil); overload;
  end;

  TOneShotTimerReloaded = class(TInterfacedObject, IOneShotTimerReloaded)
  public
    procedure Execute(Proc: TProc; TimeOut: Cardinal = 1000); overload;
    procedure Execute(Proc: TProcedure; TimeOut: Cardinal = 1000); overload;
    procedure Execute(Event: TNotifyEvent; TimeOut: Cardinal = 1000; Sender: TObject = nil); overload;
  end;

implementation

uses
  Winapi.Windows;

{ TOneShotTimerReloaded }

procedure TOneShotTimerReloaded.Execute(Proc: TProc; TimeOut: Cardinal);
var
  TimerID: UIntPtr;

begin
  TimerID := SetTimer(HWND(0), 0, TimeOut, @procedure
    begin
      if (Assigned(Proc)) then
        Proc;

      KillTimer(HWND(0), TimerID);
    end
  );
end;

procedure TOneShotTimerReloaded.Execute(Proc: TProcedure; TimeOut: Cardinal);
var
  TimerID: UIntPtr;

begin
  TimerID := SetTimer(HWND(0), 0, TimeOut, @procedure
    begin
      if (Assigned(Proc)) then
        Proc;

      KillTimer(HWND(0), TimerID);
    end
  );
end;

procedure TOneShotTimerReloaded.Execute(Event: TNotifyEvent; TimeOut: Cardinal; Sender: TObject);
var
  TimerID: UIntPtr;

begin
  TimerID := SetTimer(HWND(0), 0, TimeOut, @procedure
    begin
      if (Assigned(Event)) then
        Event(Sender);

      KillTimer(HWND(0), TimerID);
    end
  );
end;

end.

我目前使用此类的方式是:

procedure TForm1.FormCreate(Sender: TObject);
var
  t1: TOneShotTimerReloaded;
  t2: TOneShotTimerReloaded;

begin
  t1 := TOneShotTimerReloaded.Create;
  t2 := TOneShotTimerReloaded.Create;

  t1.Execute(btn1Click, 5000, btn1);
  t2.Execute(procedure begin ShowMessage('Anonymous'); end, 2000);

  // Not worried with t1 and t2 memory leaks yet!!! ;)
end;

如有任何想法或建议，我们将不胜感激。谢谢!

Answer 1

您不能对 Win32 API 回调使用匿名过程，就像您不能使用非静态类方法(不编写代理 stub )或本地内部函数(不安全)一样， 反正)。匿名过程作为编译器生成的引用计数接口(interface)实现，该接口(interface)具有隐藏的 Invoke() 方法，每当调用该过程时都会执行该方法。这与 SetTimer()(或任何其他 API)期望回调的签名不匹配。

您的代码本质上(但不完全)在幕后执行以下操作:

type
  TOneShotTimerReloaded_Execute_AnonProc = interface(IInterface)
    procedure Invoke;
  end;

  TOneShotTimerReloaded_Execute_AnonProc_Impl = class(TInterfacedObject, TOneShotTimerReloaded_Execute_AnonProc)
  public
    Captured_Proc: ^TProc;
    Captured_TimerID: ^UIntPtr;
    procedure Invoke;
  end;

procedure TOneShotTimerReloaded_Execute_AnonProc_Impl.Invoke;
begin
  if (Assigned(Captured_Proc^)) then
    Captured_Proc^();

  KillTimer(HWND(0), Captured_TimerID^);
end

procedure TOneShotTimerReloaded.Execute(Proc: TProcedure; TimeOut: Cardinal);
var
  TimerID: UIntPtr;
  AnonProc: TOneShotTimerReloaded_Execute_AnonProc;
begin
  AnonProc := TOneShotTimerReloaded_Execute_AnonProc_Impl.Create;
  AnonProc.Captured_Proc := @Proc;
  AnonProc.Captured_TimerID := @TimerID;
  TimerID := SetTimer(HWND(0), 0, TimeOut, @AnonProc);
end;

明白为什么它永远无法工作吗？

即使可能，您的匿名过程也缺少 SetTimer() 传递给其回调的输入参数，以及 stdcall 调用约定，因此您无论如何都会对调用堆栈管理不善。

您使用@ 地址运算符会向您隐藏编译器错误。去掉@，让编译器失败。这应该是你做错事的第一个迹象。

要执行您尝试的操作，您必须创建一个动态代理 stub (类似于 Classes.MakeObjectInstance() 所做的)，因此 SetTimer()可以(几乎)直接调用您的 Proc 处理程序。匿名程序不会帮助你。