cheat-engine/frmstacktraceunit.pas
cheatengine@gmail.com 4d297adfd2
2011-07-04 19:52:19 +00:00

114 lines
3.2 KiB
ObjectPascal

unit frmstacktraceunit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,newkernelhandler, cefuncproc, ComCtrls,imagehlp,debugger, kerneldebugger,
Menus;
type
TfrmStacktrace = class(TForm)
ListView1: TListView;
PopupMenu1: TPopupMenu;
Refresh1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Refresh1Click(Sender: TObject);
private
{ Private declarations }
procedure refreshtrace;
public
{ Public declarations }
procedure stacktrace(threadhandle:thandle;context:_context);
end;
var
frmStacktrace: TfrmStacktrace;
implementation
{$R *.dfm}
procedure TfrmStacktrace.stacktrace(threadhandle:thandle;context:_context);
var stackframe: PStackframe;
cxt:_context;
a,b,c,d: dword;
sa,sb,sc,sd:string;
begin
cxt:=context;
getmem(stackframe,sizeof(tstackframe));
zeromemory(stackframe,sizeof(tstackframe));
stackframe^.AddrPC.Offset:=context.eip;
stackframe^.AddrPC.mode:=AddrModeFlat;
stackframe^.AddrStack.Offset:=context.Esp;
stackframe^.AddrStack.Mode:=addrmodeflat;
stackframe^.AddrFrame.Offset:=context.Ebp;
stackframe^.AddrFrame.Mode:=addrmodeflat;
listview1.items.clear;
//because I provide a readprocessmemory the threadhandle just needs to be the unique for each thread. e.g threadid instead of threadhandle
while stackwalk(IMAGE_FILE_MACHINE_I386,processhandle,threadhandle,stackframe,@cxt, newkernelhandler.readprocessmemory ,SymFunctionTableAccess,SymGetModuleBase,nil) do
begin
listview1.Items.Add.Caption:=inttohex(stackframe^.AddrPC.Offset,8);
listview1.items[listview1.Items.Count-1].SubItems.add(inttohex(stackframe^.AddrStack.Offset,8));
listview1.items[listview1.Items.Count-1].SubItems.add(inttohex(stackframe^.AddrFrame.Offset,8));
listview1.items[listview1.Items.Count-1].SubItems.add(inttohex(stackframe^.AddrReturn.Offset,8));
a:=stackframe^.Params[0];
b:=stackframe^.Params[1];
c:=stackframe^.Params[2];
d:=stackframe^.Params[3];
if integer(a)>$400000 then sa:='0x'+inttohex(a,8) else sa:=inttostr(integer(a));
if integer(b)>$400000 then sb:='0x'+inttohex(b,8) else sb:=inttostr(integer(b));
if integer(c)>$400000 then sc:='0x'+inttohex(c,8) else sc:=inttostr(integer(c));
if integer(d)>$400000 then sd:='0x'+inttohex(d,8) else sd:=inttostr(integer(d));
listview1.items[listview1.Items.Count-1].SubItems.add(sa+','+sb+','+sc+','+sd+',...');
end;
end;
procedure TfrmstackTrace.refreshtrace;
var c: _CONTEXT;
begin
if debuggerthread<>nil then
stacktrace(debuggerthread.pausedthreadhandle,debuggerthread.context)
else
begin
if kdebugger <> nil then
begin
Kdebugger.GetContext(c);
stacktrace(0, c);
end;
end;
end;
procedure TfrmStacktrace.FormCreate(Sender: TObject);
begin
refreshtrace;
end;
procedure TfrmStacktrace.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
frmstacktrace:=nil;
action:=cafree;
end;
procedure TfrmStacktrace.Refresh1Click(Sender: TObject);
begin
refreshtrace;
end;
end.