Delphi 如何获取当前函数的名称?
原理是先获取本函数的入口地址,EIP。
再通过RTTI枚举类的所有成员函数名称,和成员函数入口地址。根据入口地址和EIP比较,找到成员函数名称。
不用担心RTTI关闭。因为新版本的DELPHI是关不掉这些基础的RTTI信息。都被编译到程序中去了。
所以可以使用RTTI的方式。
本函数只能用于类的成员函数,不能用于非类的函数。
unit untGetFuncName;
interface
uses System.Classes, System.SysUtils, System.Rtti;
{ 获取当前函数的当前 EIP 当前运行地址 }
procedure GetEIP(); stdcall;
{ 获取当前函数名称 }
function GetCurrentFuncName(const frm: TObject): string;
implementation
{ 当前运行地址 }
var
g_CurrentFuncEIP: NativeUInt;
{ 获取当前函数的当前 EIP 当前运行地址 }
procedure GetEIP(); stdcall;
asm
{$IFDEF WIN32}
POP EAX;
MOV g_CurrentFuncEIP,EAX;
PUSH EAX;
{$ELSE}
POP RAX;
MOV g_CurrentFuncEIP,RAX;
PUSH RAX;
{$ENDIF}
end;
{ TStringList 按整数排序 }
function cmpint(List: TStringList; Index1, Index2: Integer): Integer;
begin
Index1 := StrToIntDef(List[Index1], 0);
Index2 := StrToIntDef(List[Index2], 0);
Result := Index1 - Index2;
end;
{ 枚举 frm 所有函数名称和函数入口地址,与 intEIP 对比,从而得到函数名称 }
function CheckEIP(const intEIP: Cardinal; const frm: TObject): string;
type
PMethodInfo = ^TMethodInfo;
TMethodInfo = record
strAddress: ShortString;
strFunName: ShortString;
end;
var
rc : TRttiContext;
rt : TRttiType;
rm : TRttiMethod;
sl : TStringList;
pmi : PMethodInfo;
intIndex: Integer;
III : Integer;
begin
rc := TRttiContext.Create;
sl := TStringList.Create;
try
sl.Sorted := False;
rt := rc.GetType(frm.ClassInfo);
for rm in rt.GetMethods do
begin
pmi := AllocMem(SizeOf(TMethodInfo));
pmi^.strAddress := ShortString(Format('%d', [Cardinal(rm.CodeAddress)]));
pmi^.strFunName := ShortString(Format('%s', [rm.ToString]));
sl.AddObject(String(pmi.strAddress), TObject(pmi));
end;
{ 加到列表中 }
sl.Append(IntToStr(intEIP));
{ 按整数排序 }
sl.CustomSort(cmpint);
{ 检索刚加入的在什么位置 }
intIndex := sl.IndexOf(IntToStr(intEIP));
{ 返回函数名称 }
if intIndex = 0 then
Result := string(PMethodInfo(sl.Objects[intIndex + 1])^.strFunName)
else
Result := string(PMethodInfo(sl.Objects[intIndex - 1])^.strFunName);
{ 释放内存 }
for III := 0 to sl.Count - 1 do
begin
FreeMem(PMethodInfo(sl.Objects[III]));
end;
finally
sl.Free;
rc.Free;
end;
end;
{ 获取当前函数名称 }
function GetCurrentFuncName(const frm: TObject): string;
begin
Result := CheckEIP(g_CurrentFuncEIP, frm);
end;
end.
调用方法:
uses untGetFuncName;
procedure TForm1.btn1Click(Sender: TObject);
begin
GetEIP;
btn1.Caption := GetCurrentFuncName(Self);
end;
支持X86, X64平台。