Delphi 如何获取当前函数的名称？

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