使用SetTimer API的Delphi匿名函数会抛出"特权指令"异常

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回调,只能使用非静态类方法(无需编写代理存根)或本地内部函数(无论如何都不安全).匿名过程是作为编译器生成的引用计数接口实现的,该接口具有在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调用约定,因此您无论如何都会对调用堆栈进行错误管理.

您使用@地址运算符会隐藏编译器错误.摆脱@并让编译器失败.这应该是你第一次表明你做错了什么.

要做你正在尝试的事情,你将不得不创建一个动态代理存根(类似于什么Classes.MakeObjectInstance()),因此SetTimer()可以Proc直接调用你的处理程序(几乎).匿名程序对您没有帮助.