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