Delphi x64：如何将本地过程作为过程参数（回调）传递答案

【问题标题】：Delphi x64: How to pass local procedure as a procedural parameter (callback)Delphi x64：如何将本地过程作为过程参数（回调）传递
【发布时间】：2020-06-10 05:48:52
【问题描述】：

几年前，我将一个旧的 unix 应用程序移植到 Delphi 5。对于链表迭代，它使用通过地址传递给全局“迭代器”函数的本地过程。

下面是一个简化的例子：

type TPerformProc = procedure;

procedure Perform(proc:TPerformProc);
begin
  proc;
end;

procedure Test;
var loc_var:integer;

  procedure loc_proc;
  begin
    loc_var:=loc_var+10;
  end;

begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  Perform(addr(loc_proc));
  writeln('loc var: ',loc_var);
  writeln('-----');
end;

示例程序在 Delphi 中崩溃，但在 unix 上运行良好。

在一些帮助下，我已经能够让它像这样工作：

type TPerformProc = procedure;

var loc_bp:integer;

procedure Perform(proc:TPerformProc);
begin
  asm
    push loc_bp
  end;
  proc;
  asm
    pop eax
  end;
end;

procedure Test;
var loc_var:integer;

  procedure loc_proc;
  begin
    loc_var:=loc_var+10;
  end;

begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  asm
    mov loc_bp,ebp
  end;
  Perform(addr(loc_proc));
  writeln('loc var: ',loc_var);
  writeln('-----');
end;

为了解决这个问题，我存储了对本地过程的堆栈帧的引用，然后我调用了本地过程。

我很清楚，上面的解决方案不是一个正确的解决方案，而是一个 hack，我知道新的 Delphi 版本可能会以不同的方式处理本地程序并破坏 hack。幸运的是，这部分 Delphi 保持不变，即使在最新的德里，代码也能正常工作。

但是，我想将应用程序编译为 64 位应用程序，并且该 hack 不再有效。到目前为止，我无法找到类似的解决方案，但对于 64 位。这里有人可以帮忙吗？

谢谢。

【问题讨论】：

您应该使用匿名方法来实现它。那么就不需要破解了。
如果你跳过Addr，你会得到一个很好的错误信息。我的 10.3 编译器显示“E2094 本地过程/函数 'loc_proc' 分配给过程变量”。正如@DavidHeffernan 建议的那样，最好的最小努力解决方案可能是使用匿名方法。
伙计们，我知道这不受官方支持，但我正在寻找如何让它工作的技巧。我同意，匿名方法是一种可能的解决方案（但是在 Delphi 5 时代它不是一个选项），但是经常使用本地过程进行回调（1200 多次），所以你可以想象多长时间需要将其转换为匿名方法。
@David David，我刚刚注意到您关闭了这个问题并将其标记为另一个问题的副本。这不正确，请重新打开它。我很清楚这样一个事实，即官方不支持我的要求 - 但是有一个不受支持的 32 位解决方案（参见我的示例），也许有一个 64 位解决方案 - 这实际上是什么我在找
会有一个 hack，您需要检查 asm 以查看这些方法所需的隐藏额外参数是如何在 x64 中传递的。不会很难。困难的是转换你做这个黑客的所有地方。正确的解决方案是使用匿名方法，考虑到您目前采用的方法是非常愚蠢的。

标签： delphi callback 64-bit 32bit-64bit

【解决方案1】：

这里最干净的解决方案是使用匿名方法。没有一点重构就没有办法解决这个问题，但你可以像这样合理地轻松地做到这一点：

program Project1;    
{$APPTYPE CONSOLE}    
uses
  SysUtils;

procedure Perform(proc:TProc);
begin
  WriteLn('doing something else important...');
  proc;
end;

procedure Test;
var
  loc_var:integer;

  procedure PerformExt;
  begin
    Perform(procedure
            begin
              loc_var := loc_var+10;
            end);
  end;    
begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  PerformExt;
  writeln('loc var: ',loc_var);
  writeln('-----');
end;    

begin
  Test; ReadLn;
end.

这会产生输出：

 loc var: 0  
 doing something else important...  
 loc var: 10  
 -----

请注意，Perform 的定义必须更改为接受 TProc 而不是您的自定义 procedure 别名。

【讨论】：

感谢您的帮助。我同意这是一个不错且干净的解决方案，但是有 1200 多个地方我需要更改代码，所以我希望有人可以帮助我找到 64 位版本的 hack
当我在 Q 中阅读您的代码时，您仍然有 1200 个地方可以应用该 hack
@Palka 可能会编写一个实用程序来扫描您的源文件并修补它们。我曾经使用过这种技术。
@David 更准确地说，有 1200 多个地方我必须将本地程序更改为匿名程序，但只有大约 11 个执行程序 - 所以我必须修补 12 个地方总计与 1200+ 相比。不过我会分析是否有可能编写一个实用程序来扫描代码并将本地程序转换为匿名程序，因为与 hack 相比，这种方法绝对是未来的证明
问题中的代码在您调用Perform的位置具有内联asm。

【解决方案2】：

@J... 的答案的变体，也使用匿名方法。

program Project163;

{$APPTYPE CONSOLE}

uses
  SysUtils;

procedure Perform(proc:TProc);
begin
  WriteLn('doing something else important...');
  proc;
end;

procedure Test;
var
  loc_var:integer;

  function _LocalProc : TProc;
  begin
    Result :=
      procedure
      begin
        loc_var := loc_var+10;
      end;
  end;

begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  Perform(_LocalProc());
  writeln('loc var: ',loc_var);
  writeln('-----');
end;

begin
  Test; ReadLn;
end.

_LocalProc 变成一个函数，返回一个匿名方法，与原来的本地过程相同。

注意调用Perform(_LocalProc()) 中的额外括号，以使编译器理解将生成的匿名方法作为参数传递。

【讨论】：

【解决方案3】：

我在原始帖子中的编辑因请求将其发布为答案而被回滚，所以我们开始吧。

经过进一步摆弄，以下似乎适用于 32 位和 64 位平台：

type TPerformProc = procedure;

var my_bp:NativeInt;

procedure SimpleFixPerform(proc:TPerformProc);
asm
  {$ifdef WIN64}
    mov rax,proc
    push rbp
    mov rbp,my_bp
    mov rcx,my_bp
    call rax
    pop rbp
  {$else}
    push my_bp
    call proc
    pop eax
  {$endif}
end;

procedure SetupBP;
asm
  {$ifdef WIN64}
    mov my_bp,rbp
  {$else}
    mov my_bp,ebp
  {$endif}
end;

procedure SimpleFixTest;
var loc_var:integer;

  procedure loc_proc;
  begin
    loc_var:=loc_var+10;
  end;

begin
  loc_var:=0;
  loc_proc;
  writeln('SimpleFix var: ',loc_var);
  SetupBP;
  SimpleFixPerform(@loc_proc);
  writeln('SimpleFix var: ',loc_var);
  writeln('-----');
end;

我的汇编技能有点生疏，所以如果你在代码代码中看到了陷阱，请评论

【讨论】：