delphi - 在新 Hook 的 LoadEr String 方法中读取字符串列表时出现堆栈溢出异常

Question

供引用 - 以下是我的代码，我在 NewLoadResString 函数中遇到 StackOverflow 异常。这种情况就像我创建了两个字符串列表，即 RecStrNameIdMap 和 NewStringValueList。这里RecStrNameIdMap是存储名称和字符串标识符映射的哈希字符串列表。这样我就可以引用资源字符串名称作为其标识符，即 ID。

NewStringValueList 是一个字符串列表，其中包含一些资源字符串的新值。

我已将 NewLoadResString 方法连接到 system.LoadResString 方法上。在新方法中，我检查 NewStringValueList 中给定资源字符串是否有新值，然后获取该值并返回新值而不是旧声明值。

线上发生Stack Overflow异常*

if RecStrNameIdMap.IndexOfName(IntToStr(ResStringRec^.Identifier)) > -1 then

*谁能检查一下我为什么会收到此错误。

unit UnitTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


type
  TMethodHook = class
  private
    aOriginal : packed array[ 0..4 ] of byte;
    pOldProc, pNewProc : pointer;
    pPosition : PByteArray;
  public
    constructor Create( pOldProc, pNewProc : pointer );
    destructor Destroy; override;
  end;


var
  Form2: TForm2;

implementation

{$R *.dfm}

ResourceString
  RS_1 = 'ABC';
  RS_2 = 'XYZ';

procedure TForm2.Button1Click(Sender: TObject);
var
  aMethodHook: TMethodHook;
  RecStrNameIdMap: THashedStringList;
  NewStringValueList: TStringList;

  {Hookup aNewProcedure on aOriginalProcedure}
  procedure RegisterProcedures(aOriginalProcedure, aNewProcedure: pointer);
  begin
    if Assigned(aOriginalProcedure) and Assigned(aNewProcedure) then
      aMethodHook := TMethodHook.Create( aOriginalProcedure, aNewProcedure);
  end;

  {Replacement for System.LoadResString}
  function NewLoadResString(ResStringRec: PResStringRec): String;
  var
    Buffer: array [0..4095] of char;
  begin
    if ResStringRec = nil then Exit;
    if ResStringRec.Identifier >= 64 * 1024 then
    begin
      Result := PChar(ResStringRec.Identifier);
    end
    else
    begin
      if RecStrNameIdMap.IndexOfName(IntToStr(ResStringRec^.Identifier)) > -1 then
      begin
        Result := NewStringValueList.Values[
          RecStrNameIdMap.Values[IntToStr(ResStringRec^.Identifier)]];
      end
      else
      begin
        SetString(Result, Buffer,
          LoadString(FindResourceHInstance(ResStringRec.Module^),
            ResStringRec.Identifier, Buffer, SizeOf(Buffer)));
      end;
    end;
  end;

  procedure CreateNameIdMapping;
  begin
    {This is done to get string name from ID}
    RecStrNameIdMap.CaseSensitive := False;
    RecStrNameIdMap.Add(Inttostr(PResStringRec(RS_2)^.Identifier)+'='+'XYZ');
  end;

begin
  aMethodHook := nil;
  try
    RecStrNameIdMap := THashedStringList.Create;
    NewStringValueList := TStringList.Create;

    CreateNameIdMapping;

    {Create new value list for ResourceStrings}
    NewStringValueList.Add('XYZ'+'='+'new value for ResourceString RS_2');
    RegisterProcedures(@System.LoadResString, @NewLoadResString);

    {This should return 'new value for ResourceString RS_2' instead of 'XYZ'}
    ShowMessage(RS_2);

    {This should return 'ABC' - no change in value}
    ShowMessage(RS_1);
  finally
    aMethodHook.Free;
    RecStrNameIdMap.Free;
    NewStringValueList.Free;
  end;
end;

{ TMethodHook }

constructor TMethodHook.Create(pOldProc, pNewProc: pointer);
var
  iOffset : integer;
  iMemProtect : cardinal;
  i : integer;
begin
  Self.pOldProc := pOldProc;
  Self.pNewProc := pNewProc;

  pPosition := pOldProc;
  iOffset := integer( pNewProc ) - integer( pointer( pPosition ) ) - 5;

  for i := 0 to 4 do aOriginal[ i ] := pPosition^[ i ];

  VirtualProtect( pointer( pPosition ), 5, PAGE_EXECUTE_READWRITE,
    @iMemProtect );

  pPosition^[ 0 ] := $E9;
  pPosition^[ 1 ] := byte( iOffset );
  pPosition^[ 2 ] := byte( iOffset shr 8 );
  pPosition^[ 3 ] := byte( iOffset shr 16 );
  pPosition^[ 4 ] := byte( iOffset shr 24 );
end;

destructor TMethodHook.Destroy;
var
  i : integer;
begin
  for i := 0 to 4 do pPosition^[ i ] := aOriginal[ i ];
  inherited;
end;

end.

Answer 1

看来替换过程不能是嵌套例程。
如 documentation 中所述:

Procedural types allow you to treat procedures and functions as values that can be assigned to variables or passed to other procedures and functions.

...

Nested procedures and functions (routines declared within other routines) cannot be used as procedural values, nor can predefined procedures and functions.

过程类型是指针。虽然嵌套例程不能用作过程类型，但我假设指向嵌套例程的指针不能用作过程参数，否则此操作可能会产生不可预测的结果，如本例所示。
该程序已正确 Hook (您已这样做)；我提取了过程 NewLoadResString 并且 stackoverflow 错误不再发生。
弹出的 resourcestring 始终是旧的，但我在 NewLoadResString 过程中没有进行任何更改。
整个编辑的单元如下。

unit UnitTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    RecStrNameIdMap: THashedStringList;
    NewStringValueList: TStringList;
  public
    { Public declarations }
  end;


type
  TMethodHook = class
  private
    aOriginal : packed array[ 0..4 ] of byte;
    pOldProc, pNewProc : pointer;
    pPosition : PByteArray;
  public
    constructor Create( pOldProc, pNewProc : pointer );
    destructor Destroy; override;
  end;


var
  Form2: TForm2;

implementation

{$R *.dfm}

ResourceString
  RS_1 = 'ABC';
  RS_2 = 'XYZ';


{Replacement for System.LoadResString}
function NewLoadResString(ResStringRec: PResStringRec): String;
var
  Buffer: array [0..4095] of char;
begin
  if ResStringRec = nil then Exit;
  if ResStringRec.Identifier >= 64 * 1024 then
  begin
    Result := PChar(ResStringRec.Identifier);
  end
  else
  begin
    if RecStrNameIdMap.IndexOfName(IntToStr(ResStringRec^.Identifier)) > -1 then
    begin
      Result := NewStringValueList.Values[
        RecStrNameIdMap.Values[IntToStr(ResStringRec^.Identifier)]];
    end
    else
    begin
      SetString(Result, Buffer,
        LoadString(FindResourceHInstance(ResStringRec.Module^),
          ResStringRec.Identifier, Buffer, SizeOf(Buffer)));
    end;
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  aMethodHook: TMethodHook;

  {Hookup aNewProcedure on aOriginalProcedure}
  procedure RegisterProcedures(aOriginalProcedure, aNewProcedure: pointer);
  begin
    if Assigned(aOriginalProcedure) and Assigned(aNewProcedure) then
      aMethodHook := TMethodHook.Create( aOriginalProcedure, aNewProcedure);
  end;

  procedure CreateNameIdMapping;
  begin
    {This is done to get string name from ID}
    RecStrNameIdMap.CaseSensitive := False;
    RecStrNameIdMap.Add(Inttostr(PResStringRec(RS_2)^.Identifier)+'='+'XYZ');
  end;

begin
  aMethodHook := nil;
  RecStrNameIdMap := THashedStringList.Create;
  NewStringValueList := TStringList.Create;
  try
    CreateNameIdMapping;

    {Create new value list for ResourceStrings}
    NewStringValueList.Add('XYZ'+'='+'new value for ResourceString RS_2');
    RegisterProcedures(@System.LoadResString, @NewLoadResString);

    {This should return 'new value for ResourceString RS_2' instead of 'XYZ'}
    ShowMessage(RS_2);

    {This should return 'ABC' - no change in value}
    ShowMessage(RS_1);
  finally
    aMethodHook.Free;
    RecStrNameIdMap.Free;
    NewStringValueList.Free;
  end;
end;

{ TMethodHook }

constructor TMethodHook.Create(pOldProc, pNewProc: pointer);
var
  iOffset : integer;
  iMemProtect : cardinal;
  i : integer;
begin
  Self.pOldProc := pOldProc;
  Self.pNewProc := pNewProc;

  pPosition := pOldProc;
  iOffset := integer( pNewProc ) - integer( pointer( pPosition ) ) - 5;

  for i := 0 to 4 do aOriginal[ i ] := pPosition^[ i ];

  VirtualProtect( pointer( pPosition ), 5, PAGE_EXECUTE_READWRITE,
    @iMemProtect );

  pPosition^[ 0 ] := $E9;
  pPosition^[ 1 ] := byte( iOffset );
  pPosition^[ 2 ] := byte( iOffset shr 8 );
  pPosition^[ 3 ] := byte( iOffset shr 16 );
  pPosition^[ 4 ] := byte( iOffset shr 24 );
end;

destructor TMethodHook.Destroy;
var
  i : integer;
begin
  for i := 0 to 4 do pPosition^[ i ] := aOriginal[ i ];
  inherited;
end;

end.