GetEIP

 

uses System.Classes, System.SysUtils, System.Rtti;
 
procedure GetEIP(); stdcall;
 
function GetCurrentFuncName(const frm: TObject): string;
implementation
 
var
g_CurrentFuncEIP: NativeUInt;
 
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;
 
function cmpint(List: TStringList; Index1, Index2: Integer): Integer;
begin
Index1 := StrToIntDef(List[Index1], 0);
Index2 := StrToIntDef(List[Index2], 0);
Result := Index1 - Index2;
end;
 
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;