For reference - following is my code, where I am getting StackOverflow exception in NewLoadResString function. The case is like I have creted two stringlist i.e. RecStrNameIdMap and NewStringValueList. Here RecStrNameIdMap is hash string list to store name and string Identifier mapping. So that I can refer Resource string name for its Identifier i.e ID.
NewStringValueList is a string list which contains new values for few of the Resourcestrings.
I have hooked up NewLoadResString method on system.LoadResString method. In new method I am checking if I have new value for given resourcestring in NewStringValueList then get that value and return new instead of old declared value.
Stack Overflow exception occurs on line *
if RecStrNameIdMap.IndexOfName(IntToStr(ResStringRec^.Identifier)) > -1 then
* Can anyone please check why I am getting this error.
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.
It seems that the replacing procedure cannot be a nested routine.
As stated in the 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.
A procedural type is a Pointer. While a nested routine cannot be used as procedural type, I assume that a Pointer to a nested routine cannot be used as a procedure parameter or this action may have unpredictable result like in this case.
The procedure is hooked correctly (you did); I extracted the procedure NewLoadResString and the stackoverflow error does not happen anymore.
The resourcestring which pops up is always the old one but I made no changes in the NewLoadResString procedure.
The entire edited unit follows.
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.