Delphi 2010 如何全局补丁/重定向RTL记录TValue.TryCast方法

完全支持对RTL中定义的记录类型任意方法做补丁/重定向操作。记录的静态方法、实例方法在编译后都会生成全局唯一的函数入口，和普通全局函数的内存布局、调用规则没有本质区别，只要拿到正确的函数入口地址，就可以通过内存改写的方式完成跳转重定向。
你当前需求（先执行原始TValue.TryCast逻辑，再追加自定义校验）的实现思路是可行的，现有代码的核心问题是获取方法地址的语法错误，以及内联汇编跳转的写法存在致命逻辑隐患。

1. 核心错误：获取记录方法地址的正确方式 #

你代码里写的@@TValue.TryCast是非法语法，Delphi中要获取已定义类型（包括RTL的TValue、你自己写的record helper方法）的入口地址，直接用@TValue.TryCast、@TValueHelper.TryCastFixed即可，不需要加双@。

注意：如果你的代码单元没有引用System.Rtti单元，需要先在uses列表里添加该单元，否则编译器识别不到TValue类型。

2. 现有代码的逻辑隐患修正 #

你写的TryCastFixed里直接用裸JMP跳转到原函数的写法完全不可行：JMP是直接跳转不会保存返回地址，跳转到原函数执行完后不会回到当前函数，后面你写的自定义校验逻辑永远不会执行。需要改成显式调用原函数，执行完返回当前函数后再跑后续自定义逻辑。

类型与变量声明部分 #

uses
  System.Rtti, System.SysUtils, Winapi.Windows;

type
  TValueHelper = record helper for TValue
  public
    function TryCastFixed(ATypeInfo: PTypeInfo; out AResult: TValue): Boolean;
  end;

var
  TValueTryCastOrgAddr: Pointer;
  // 定义原函数的签名类型，方便类型安全调用
  TTryCastOrgProc = function(Self: Pointer; ATypeInfo: PTypeInfo; out AResult: TValue): Boolean;

自定义补丁方法实现 #

function TValueHelper.TryCastFixed(ATypeInfo: PTypeInfo; out AResult: TValue): Boolean;
begin
  // 先调用原始TryCast函数，拿到原始返回结果
  Result := TTryCastOrgProc(TValueTryCastOrgAddr)(@Self, ATypeInfo, AResult);
  // 执行自定义补充逻辑
  if not Result and (ATypeInfo <> nil) and (ATypeInfo = System.TypeInfo(TValue)) then
  begin
    AResult := TValue.From<TValue>(Self);
    Exit(True);
  end;
end;

内存补丁基础函数 #

type
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25 间接跳转指令
    Addr: ^Pointer;
  end;

function WriteProtectedMemory(BaseAddress, Buffer: Pointer; Size: Cardinal; out WrittenBytes: Cardinal): Boolean;
var
  OldProtect, Dummy: Cardinal;
begin
  WrittenBytes := 0;
  if Size > 0 then
  begin
    OldProtect := 0;
    Result := VirtualProtect(BaseAddress, Size, PAGE_EXECUTE_READWRITE, OldProtect);
    if Result then
    try
      Move(Buffer^, BaseAddress^, Size);
      WrittenBytes := Size;
      FlushInstructionCache(GetCurrentProcess, BaseAddress, Size);
    finally
      VirtualProtect(BaseAddress, Size, OldProtect, Dummy);
    end;
  end;
  Result := WrittenBytes = Size;
end;

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure RedirectFunction(OldP, DestP: Pointer);
type
  TJump = packed record
    Jmp: Byte; // $E9 32位近跳转指令
    Offset: Integer;
  end;
var
  Jump: TJump;
  WrittenBytes: Cardinal;
begin
  if IsLibrary then
    raise Exception.Create('RedirectFunction: 不支持在DLL中使用该方法');
  OldP := GetActualAddr(OldP);
  TValueTryCastOrgAddr := OldP; // 保存原始函数入口
  DestP := GetActualAddr(DestP);
  Jump.Jmp := $E9;
  Jump.Offset := Integer(NativeInt(DestP) - NativeInt(OldP) - SizeOf(TJump));
  if not WriteProtectedMemory(OldP, @Jump, SizeOf(TJump), WrittenBytes) then
    RaiseLastOSError;
end;

补丁初始化入口 #

procedure PatchTValueHelper_TryCast;
begin
  // 直接用@取类型方法的地址即可
  RedirectFunction(@TValue.TryCast, @TValueHelper.TryCastFixed);
end;

• 补丁操作必须在所有调用TValue.TryCast的逻辑执行前完成，一般建议放在程序初始化段最早的位置执行。
• 不同Delphi版本下如果TValue.TryCast的函数签名有变化，需要对应调整TTryCastOrgProc的定义，否则调用原函数时会出现栈错位导致崩溃。
• 如果是64位编译环境，需要替换跳转指令写法：32位下的5字节E9跳转在64位下如果目标地址超过2GB范围会失效，建议换成14字节的间接跳转方案。

内容的提问来源于stack exchange，提问作者NevTon