function RealReadFromProcessMemory64(const AhProcess: THANDLE; const AqwBaseAddress:Int64; const AlpBuffer: Pointer; const ASize: DWORD; var ANumberOfBytesRead: DWORD):BOOL;stdcall;
var
  st  : DWORD;
begin
   Result := ReadProcessMemory(AhProcess, Pointer(AqwBaseAddress), AlpBuffer, ASize, st);
   ANumberOfBytesRead := st;
end;

function RealReadFromProcessMemory32(const AhProcess: THANDLE; const AqwBaseAddress:DWORD; const AlpBuffer: Pointer; const ASize: DWORD; var ANumberOfBytesRead: DWORD):BOOL;stdcall;
var
  st  : DWORD;
begin
   Result := ReadProcessMemory(AhProcess, Pointer(AqwBaseAddress), AlpBuffer, ASize, st);
   ANumberOfBytesRead := st;
end;


function GetStackFrame(var dwRetArray :StackframeArr):Integer;
var
 ContextRecord:TContext;
 StackFrame:TSTACKFRAME64;
begin
 ContextRecord.ContextFlags:=CONTEXT_FULL;
 if GetThreadContext(GetCurrentThread,ContextRecord) then
 begin
  SetLength(dwRetArray,0);    Result:=0;
  FillChar(StackFrame, sizeof(StackFrame), 0);
  StackFrame.AddrPC.Offset := ContextRecord.Eip;
  StackFrame.AddrStack.Offset := ContextRecord.Esp;
  StackFrame.AddrFrame.Offset := ContextRecord.Ebp;
  StackFrame.AddrPC.Mode :=AddrModeFlat;
  StackFrame.AddrStack.Mode :=AddrModeFlat;
  StackFrame.AddrFrame.Mode := AddrModeFlat;


   while StackWalk64(IMAGE_FILE_MACHINE_I386,GetCurrentProcess, GetCurrentThread,StackFrame,@ContextRecord,@RealReadFromProcessMemory64,nil,nil,nil) do
   //while StackWalk(IMAGE_FILE_MACHINE_I386,GetCurrentProcess, GetCurrentThread,StackFrame,@ContextRecord,@RealReadFromProcessMemory32,nil,nil,nil) do
   begin
     if (StackFrame.AddrReturn.Offset <> 0) then
     begin
       //FLogManager.Log('Stack frame:' + IntToHex(Cardinal(Pointer(StackFrame.AddrPC.Offset)), 8));
       SetLength(dwRetArray,High(dwRetArray)+2);
       dwRetArray[High(dwRetArray)]:=StackFrame.AddrReturn.Offset;
       Inc(Result);
     end;
   end;
 end;
end;

procedure fun3;
var
 StackframeArr1:StackframeArr;
 count,I:Integer;
begin

 count:=GetStackFrame(StackframeArr1);
 if count>0 then
 begin
  for I := 0 to count - 1 do
  begin
    Form1.Memo1.Lines.Add(IntToHex(StackframeArr1[I],8)); //显示
  end;
 end;
end;

procedure fun2;
begin
  fun3;
end;

procedure fun1;
begin
  fun2;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  fun1;
end;

[注意]传递专业知识、拓宽行业人脉——看雪讲师团队等你加入！