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平台。