denuvo-ref/cheat-engine
1
0
Fork 0
mirror of https://github.com/cheat-engine/cheat-engine synced 2026-08-15 02:26:08 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions
cheat-engine/Cheat Engine/formChangedAddresses.pas
Dark Byte 68e0399a4d add a gdbserver interface
2023-10-20 17:32:15 +02:00

1541 lines
41 KiB
ObjectPascal
Executable file
Raw Permalink Blame History

unit formChangedAddresses;
{$MODE Delphi}
interface
uses
{$ifdef darwin}
macport,
{$endif}
{$ifdef windows}
windows,
{$endif}
LCLIntf, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,CEFuncProc, ExtCtrls, ComCtrls, Menus, NewKernelHandler, LResources,
disassembler, symbolhandler, byteinterpreter, CustomTypeHandler, maps, math, Clipbrd,
addressparser, commonTypeDefs, DBK32functions, vmxfunctions, betterControls,
syncobjs, contexthandler;
const
cbDisplayTypeIndexByte=0;
cbDisplayTypeIndexWord=1;
cbDisplayTypeIndexDword=2;
cbDisplayTypeIndexQword=3;
cbDisplayTypeIndexSingle=4;
cbDisplayTypeIndexDouble=5;
cbDisplayTypeIndexPointer=6;
type
TfrmChangedAddresses=class;
TAddressEntry=class
private
fcontext: Pointer;
contexthandler: TContextInfo;
procedure setContext(c: pointer);
public
address: ptruint; //for whatever reason it could be used in the future
base: ptruint;
stack: record
stack: pbyte;
savedsize: PtrUInt;
end;
{$IFDEF WINDOWS}
ipt: record
log: pointer;
size: integer;
end;
{$ENDIF}
count: integer;
group: integer;
owner: TfrmChangedAddresses;
changed: boolean;
procedure fillBase;
procedure savestack;
constructor create(AOwner: TfrmChangedAddresses);
destructor destroy; override;
property context: pointer read fContext write setContext;
end;
{ TfrmChangedAddresses }
{$ifdef windows}
TDBVMWatchExecutePollThread=class(TThread)
private
results: PPageEventListDescriptor;
resultsize: integer;
cr3disassembler: Tcr3Disassembler;
procedure addEntriesToList;
public
id: integer;
fca: TfrmChangedAddresses;
procedure execute; override;
end;
{$endif}
TfrmChangedAddresses = class(TForm)
caImageList: TImageList;
editCodeAddress: TEdit;
labelCodeAddress: TLabel;
lblInfo: TLabel;
miShowIPTLog: TMenuItem;
micbShowAsSigned: TMenuItem;
miCodeAddressCopy: TMenuItem;
miCopyValueToClipboard: TMenuItem;
miCopyAddressToClipboard: TMenuItem;
MenuItem2: TMenuItem;
miChangeValue: TMenuItem;
miSetFilter: TMenuItem;
miCodeAddressDisassembleMemoryRegion: TMenuItem;
miCodeAddressBrowseMemoryRegion: TMenuItem;
N1: TMenuItem;
miCommonalitiesSubgroup: TMenuItem;
miMarkAsGroup1: TMenuItem;
miMarkAsGroup2: TMenuItem;
miScanForCommonalities: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
miGroupClear: TMenuItem;
miResetCount: TMenuItem;
miDeleteSelectedEntries: TMenuItem;
miCopyToAddresslist: TMenuItem;
miDissect: TMenuItem;
micbShowAsHexadecimal: TMenuItem;
Panel1: TPanel;
OKButton: TButton;
Changedlist: TListView;
cbDisplayType: TComboBox;
PanelContent: TPanel;
PanelAddressInfo: TPanel;
pmCodeAddress: TPopupMenu;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
Showregisterstates1: TMenuItem;
Browsethismemoryregion1: TMenuItem;
procedure ChangedlistColumnClick(Sender: TObject; Column: TListColumn);
procedure ChangedlistCompare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
procedure ChangedlistCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure miCodeAddressBrowseMemoryRegionClick(Sender: TObject);
procedure miCodeAddressCopyClick(Sender: TObject);
procedure miCodeAddressDisassembleMemoryRegionClick(Sender: TObject);
procedure miCopyAddressToClipboardClick(Sender: TObject);
procedure miChangeValueClick(Sender: TObject);
procedure miCopyValueToClipboardClick(Sender: TObject);
procedure miSetFilterClick(Sender: TObject);
procedure miGroupClearClick(Sender: TObject);
procedure miMarkAsGroupClick(Sender: TObject);
procedure miDeleteSelectedEntriesClick(Sender: TObject);
procedure micbShowAsHexadecimalClick(Sender: TObject);
procedure miDissectClick(Sender: TObject);
procedure miResetCountClick(Sender: TObject);
procedure miScanForCommonalitiesClick(Sender: TObject);
procedure miShowIPTLogClick(Sender: TObject);
procedure OKButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ChangedlistDblClick(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Showregisterstates1Click(Sender: TObject);
procedure Browsethismemoryregion1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
hassetsizes: boolean;
faddress: ptruint;
defaultcolor: TColor;
fdebuggerinterfacewatchid: integer;
{$ifdef windows}
dbvmwatchpollthread: TDBVMWatchExecutePollThread;
{$endif}
currentFilter: string;
currentFilterFunc: integer;
filterExtraRegs: boolean;
function checkFilter(entry: TaddressEntry): boolean;
procedure rebuildListWithFilter;
procedure stopdbvmwatch;
procedure refetchValues(specificaddress: ptruint=0;countonly: boolean=false);
procedure setAddress(a: ptruint);
procedure setdebuggerinterfacewatchid(id: integer);
public
{ Public declarations }
equation: string;
foundcodedialog: pointer;
dbvmwatch_unlock: qword;
breakpoint: pointer;
addresslist: TMap;
addresslistCS: TCriticalSection;
foundcount: integer;
newRecord: TaddressEntry;
procedure clearFilter;
procedure AddRecord;
property address: ptruint read fAddress write setAddress;
property debuggerinterfacewatchid: integer read fdebuggerinterfacewatchid write setdebuggerinterfacewatchid;
end;
implementation
uses CEDebugger, MainUnit, frmRegistersunit, MemoryBrowserFormUnit, debughelper,
debugeventhandler, debuggertypedefinitions, FoundCodeUnit, StructuresFrm2,
ProcessHandlerUnit, Globals, Parsers, frmStackViewUnit, frmSelectionlistunit,
frmChangedAddressesCommonalityScannerUnit, LastDisassembleData, lua, lauxlib,
lualib, luahandler, BreakpointTypeDef, DebuggerInterfaceAPIWrapper, iptlogdisplay;
resourcestring
rsStop='Stop';
rsClose='Close';
rsNoDescription = 'No Description';
rsChangedAddressesBy = 'Accessed addresses by %x';
rsDesignateSomeAddresses = 'Please designate a group to at least some '
+'addresses';
rsNoAddressesLeftForGroup = 'There are no addresses left for group %d';
rsInvalidGroups = 'Invalid groups';
rsDeleteAddresses = 'Delete addresses';
rsAreYouWishToDelete = 'Are you sure you wish to delete these entries(s)?';
rsCodeAccessesSingleAddress = 'This address has been accessed by the code '
+'you selected';
rsCodeAccessesAddresses = 'The following %d addresses have been accessed by '
+'the code you selected';
rsValueChange = 'Value Change';
rsGiveTheNewValue = 'Give the new value';
rsFilter = 'Filter';
rsEnterLuaFormula = 'Enter a Lua formula to use to filter. E.g RCX==0x2301'
+'adc0. Empty for no filter';
rsNeedsIPTFindWhat = 'The debugger did not collect any IPT data. This may be due to the Intel PT feature not being enabled in settings/malfunctioning, or that the option to also log the trace in "find what..." results was disabled. Do you wish to enable this for this debugging session? You will need to recollect this information again though.'#13#10'(This is for this session only. If you wish to always turn it on from the start, go to settings->debugger options, and enable "Use Intel-PT feature" and the suboption for recording elements in "find what ..." routines)';
destructor TAddressEntry.destroy;
begin
if stack.stack<>nil then
freememandnil(stack.stack);
{$IFDEF WINDOWS}
if ipt.log<>nil then
freememandnil(ipt.log);
{$ENDIF}
if fcontext<>nil then
freememandnil(fcontext);
inherited destroy;
end;
constructor TAddressEntry.create(AOwner: TfrmChangedAddresses);
begin
owner:=aowner;
end;
procedure TAddressEntry.setContext(c: pointer);
begin
if fcontext<>nil then
freememandnil(fcontext);
contexthandler:=getBestContextHandler;
fcontext:=contexthandler.getcopy(c);
end;
procedure TAddressEntry.fillBase;
var ap: TAddressParser;
begin
if (base=0) and (owner<>nil) then
begin
ap:=TAddressParser.Create;
ap.setSpecialContext(fcontext);
base:=ap.getBaseAddress(owner.equation);
ap.free;
end;
end;
procedure TAddressEntry.savestack;
var stackbase: ptruint;
begin
getmem(stack.stack, savedStackSize);
stackbase:=contexthandler.StackPointerRegister^.getValue(fcontext);
if ReadProcessMemory(processhandle, pointer(stackbase), stack.stack, savedStackSize, stack.savedsize)=false then
begin
//for some reason this sometimes returns 0 bytes read even if some of the bytes are readable.
stack.savedsize:=4096-(stackbase mod 4096);
ReadProcessMemory(processhandle, pointer(stackbase), stack.stack, stack.savedsize, stack.savedsize);
end;
end;
//-----------------------------
{$IFDEF windows}
procedure TDBVMWatchExecutePollThread.addEntriesToList;
var
c: TContext;
i,j: integer;
opcode,desc: string;
li: TListItem;
ldi: TLastDisassembleData;
basicinfo: TPageEventBasic;
basic: PPageEventBasicArray;
extended: PPageEventExtendedArray absolute basic;
basics: PPageEventBasicWithStackArray absolute basic;
extendeds: PPageEventExtendedWithStackArray absolute basic;
address, address2: ptruint;
skip: boolean;
debug,debug2: pointer;
x: TaddressEntry;
haserror: boolean;
s: string;
begin
outputdebugstring('addEntriesToList ('+inttostr(results^.numberOfEntries)+')');
try
basic:=PPageEventBasicArray(ptruint(results)+sizeof(TPageEventListDescriptor));
for i:=0 to results^.numberOfEntries-1 do
begin
case results^.entryType of
0: basicinfo:=basic^[i];
1: basicinfo:=extended^[i].basic;
2: basicinfo:=basics^[i].basic;
3: basicinfo:=extendeds^[i].basic;
end;
ZeroMemory(@c,sizeof(c));
c.{$ifdef cpu64}Rax{$else}Eax{$endif}:=basicinfo.RAX;
c.{$ifdef cpu64}Rbx{$else}Ebx{$endif}:=basicinfo.RBX;
c.{$ifdef cpu64}Rcx{$else}Ecx{$endif}:=basicinfo.RCX;
c.{$ifdef cpu64}Rdx{$else}Edx{$endif}:=basicinfo.RDX;
c.{$ifdef cpu64}Rsi{$else}Esi{$endif}:=basicinfo.RSI;
c.{$ifdef cpu64}Rdi{$else}Edi{$endif}:=basicinfo.RDI;
c.{$ifdef cpu64}Rbp{$else}Ebp{$endif}:=basicinfo.RBP;
c.{$ifdef cpu64}Rsp{$else}Esp{$endif}:=basicinfo.Rsp;
c.{$ifdef cpu64}Rip{$else}Eip{$endif}:=basicinfo.Rip;
{$ifdef cpu64}
c.R8:=basicinfo.R8;
c.R9:=basicinfo.R9;
c.R10:=basicinfo.R10;
c.R11:=basicinfo.R11;
c.R12:=basicinfo.R12;
c.R13:=basicinfo.R13;
c.R14:=basicinfo.R14;
c.R15:=basicinfo.R15;
{$endif}
address:=symhandler.getAddressFromName(fca.equation, false, haserror, @c);
if haserror=false then
begin
//check if address is in the list
if fca.addresslist.GetData(address,x) then
begin
inc(x.count,basicinfo.Count+1);
fca.refetchValues(x.address, true);
continue;
end;
//still here so not in the list, get more info and add it
c.EFlags:=basicinfo.FLAGS;
c.SegCs:=basicinfo.CS;
c.SegSs:=basicinfo.SS;
c.SegDs:=basicinfo.DS;
c.SegEs:=basicinfo.ES;
c.SegFs:=basicinfo.FS;
c.SegGs:=basicinfo.GS;
x:=TAddressEntry.Create(fca);
x.address:=address;
x.count:=basicinfo.Count+1;
case results^.entryType of
1:
begin
//fpu
copymemory(@c.{$ifdef cpu64}FltSave{$else}ext{$endif}, @extended^[i].fpudata, sizeof(c.{$ifdef cpu64}FltSave{$else}ext{$endif}));
end;
2:
begin
//stack
getmem(x.stack.stack, 4096);
copymemory(x.stack.stack, @basics^[i].stack[0], 4096);
x.stack.savedsize:=4096;
end;
3:
begin
//fpu/stack
copymemory(@c.{$ifdef cpu64}FltSave{$else}ext{$endif}, @extended^[i].fpudata, sizeof(c.{$ifdef cpu64}FltSave{$else}ext{$endif}));
getmem(x.stack.stack, 4096);
copymemory(x.stack.stack, @basics^[i].stack[0], 4096);
x.stack.savedsize:=4096;
end;
end;
x.context:=@c;
OutputDebugString('adding to the lists');
s:=inttohex(address,8);
fca.addresslist.Add(address, x);
if fca.checkFilter(x) then
begin
li:=fca.changedlist.Items.add;
li.caption:=s;
li.SubItems.Add('');
li.subitems.add('1');
li.Data:=x;
end;
fca.refetchValues(x.address);
end
else
begin
OutputDebugString(fca.equation+' did not end up into an address');
end;
end;
except
on e: exception do
outputdebugstring('TDBVMWatchPollThread.addEntriesToList error: '+e.message);
end;
end;
procedure TDBVMWatchExecutePollThread.execute;
var
i: integer;
size: integer;
begin
cr3disassembler:=TCR3Disassembler.create;
getmem(results,4096);
resultsize:=4096;
zeromemory(results,resultsize);
try
while not terminated do
begin
size:=resultsize;
i:=dbvm_watch_retrievelog(id, results, size);
if i=0 then
begin
//OutputDebugString('TDBVMWatchExecutePollThread returned 0. results^.numberOfEntries='+inttostr(results^.numberOfEntries));
//process data
if results^.numberOfEntries>0 then
begin
//OutputDebugString('calling addEntriesToList');
synchronize(addEntriesToList);
sleep(10);
end
else
sleep(50);
end
else
if i=2 then
begin
//not enough memory. Allocate twice the needed amount
outputdebugstring(inttostr(resultsize)+' is too small for the buffer. It needs to be at least '+inttostr(size));
freememandnil(results);
resultsize:=size*2;
getmem(results, resultsize);
zeromemory(results,resultsize);
continue; //try again, no sleep
end else
begin
outputdebugstring('dbvm_watch_retrievelog returned '+inttostr(i)+' which is not supported');
exit;
end;
end;
except
on e: exception do
outputdebugstring('TDBVMWatchExecutePollThread crash:'+e.Message);
end;
freememandnil(results);
freeandnil(cr3disassembler);
end;
{$ENDIF}
//-----------------------------
procedure TfrmChangedAddresses.AddRecord;
var
li: tlistitem;
begin
inc(foundcount);
if checkFilter(newRecord) then
begin
li:=changedlist.Items.add;
li.caption:=inttohex(newRecord.address,8);
li.SubItems.Add('');
li.subitems.add('1');
li.Data:=newRecord;
end;
refetchValues(newRecord.address);
if foundcodedialog<>nil then
begin
//TFoundCodeDialog(foundcodedialog).setChangedAddressCount(contexthan
TFoundCodeDialog(foundcodedialog).setChangedAddressCount(newRecord.contexthandler.InstructionPointerRegister^.getValue(newrecord.context));
if (changedlist.Items.Count>=8) then //remove this breakpoint
debuggerthread.FindWhatCodeAccessesStop(self);
end;
debuggerthread.guiupdate:=true;
end;
procedure TfrmChangedAddresses.OKButtonClick(Sender: TObject);
var temp: dword;
i: integer;
begin
stopdbvmwatch;
if OKButton.caption=rsStop then
begin
debuggerthread.FindWhatCodeAccessesStop(self);
okButton.Caption:=rsClose;
end
else
close;
end;
procedure TfrmChangedAddresses.micbShowAsHexadecimalClick(Sender: TObject);
begin
refetchvalues;
end;
procedure TfrmChangedAddresses.miDissectClick(Sender: TObject);
var
i: integer;
ae: TAddressEntry;
ap: TAddressParser;
address: ptruint;
s: tstringlist;
f: TfrmSelectionList;
structurefrm: TfrmStructures2;
new: boolean;
maxoffset: dword;
begin
ap:=TAddressParser.Create;
if changedlist.SelCount>0 then
begin
//find out which data dissect windows are open
s:=tstringlist.create;
if frmStructures2=nil then
raise exception.create(rsTheStructuresListIsBroken);
for i:=0 to frmStructures2.Count-1 do
s.add(TfrmStructures2(frmStructures2[i]).Caption);
s.add(rsNewWindow);
f:=TfrmSelectionList.Create(self, s);
f.caption:=rsLockAndAddToStructureDissect;
f.label1.Caption:=rsSelectTheStructureDissectWindowYouWishToAddThisReg;
if f.showmodal=mrok then
begin
if f.itemindex=-1 then f.itemindex:=0;
if f.itemindex>=frmStructures2.Count then //new window
begin
structurefrm:=tfrmstructures2.create(application);
structurefrm.show;
end
else
structurefrm:=TfrmStructures2(frmStructures2[f.itemindex]);
//add the addresses
maxoffset:=4096;
for i:=0 to changedlist.Items.Count-1 do
begin
if changedlist.Items[i].Selected then
begin
ae:=changedlist.items[i].data;
ap.setSpecialContext(ae.fcontext);
address:=ap.getBaseAddress(equation);
maxoffset:=max(maxoffset, 8+strtoint64('$'+changedlist.Items[i].Caption)-address);
if address<>0 then
structurefrm.addColumn.Address:=address;
end;
end;
structurefrm.show;
if structurefrm.mainStruct=nil then //if no structure is selected define it then
structurefrm.DefineNewStructure(maxoffset);
end;
end;
ap.free;
end;
procedure TfrmChangedAddresses.ChangedlistColumnClick(Sender: TObject;
Column: TListColumn);
begin
changedlist.SortColumn:=Column.Index;
changedlist.SortType:=stData;
end;
procedure TfrmChangedAddresses.ChangedlistCompare(Sender: TObject; Item1,
Item2: TListItem; Data: Integer; var Compare: Integer);
var i1, i2: TAddressEntry;
hex, hex2: qword;
s: single absolute hex;
s2: single absolute hex2;
d: double absolute hex;
d2: double absolute hex2;
x: PtrUInt;
varsize: integer;
signedcompare: boolean;
begin
signedcompare:=micbShowAsSigned.checked;
compare:=0;
i1:=TAddressEntry(item1.data);
i2:=TAddressEntry(item2.data);
if (i1=nil) or (i2=nil) then exit;
case changedlist.SortColumn of
0: //sort by address
begin
compare:=CompareValue(i1.address, i2.address);
end;
1: //sort by value
begin
hex:=0;
hex2:=0;
case cbDisplayType.itemindex of
cbDisplayTypeIndexByte: varsize:=1;
cbDisplayTypeIndexWord: varsize:=2;
cbDisplayTypeIndexDword: varsize:=4;
cbDisplayTypeIndexQword: varsize:=8;
cbDisplayTypeIndexSingle: varsize:=4;
cbDisplayTypeIndexDouble: varsize:=8;
cbDisplayTypeIndexPointer:
begin
if processhandler.is64Bit then
varsize:=8
else
varsize:=4;
end
else
begin
Compare:=0;
exit;
end;
end;
if not ReadProcessMemory(processhandle, pointer(i1.address), @hex, VarSize, x) then
begin
compare:=-1;//1<2
exit;
end;
if not ReadProcessMemory(processhandle, pointer(i2.address), @hex2, VarSize, x) then
begin
compare:=1;//1>2
exit;
end;
if micbShowAsHexadecimal.checked then
begin
compare:=hex-hex2;
end
else
begin
case cbDisplayType.itemindex of
cbDisplayTypeIndexByte: compare:=ifthen(signedcompare, CompareValue(Int8(hex), Int8(hex2)), CompareValue(Uint8(hex),Uint8(hex2)));
cbDisplayTypeIndexWord: compare:=ifthen(signedcompare, CompareValue(Int16(hex), Int16(hex2)), CompareValue(Uint16(hex),Uint16(hex2)));
cbDisplayTypeIndexDword: compare:=ifthen(signedcompare, CompareValue(Int32(hex), Int32(hex2)), CompareValue(Uint32(hex),Uint32(hex2)));
cbDisplayTypeIndexQword: compare:=ifthen(signedcompare, CompareValue(Int64(hex), Int64(hex2)), CompareValue(Uint64(hex),Uint64(hex2)));
cbDisplayTypeIndexPointer:
begin
if processhandler.is64Bit then
compare:=ifthen(signedcompare, CompareValue(Int64(hex), Int64(hex2)), CompareValue(Uint64(hex),Uint64(hex2)))
else
compare:=ifthen(signedcompare, CompareValue(Int32(hex), Int32(hex2)), CompareValue(Uint32(hex),Uint32(hex2)));
end;
cbDisplayTypeIndexSingle:
begin
try
if s>s2 then
compare:=1
else
if s=s2 then
compare:=0
else
compare:=-1;
except
compare:=-1;
end;
end;
cbDisplayTypeIndexDouble:
begin
try
if d>d2 then
compare:=1
else
if d=d2 then
compare:=0
else
compare:=-1;
except
compare:=-1;
end;
end;
end;
end;
end;
2: //sort by count
begin
compare:=CompareValue(i1.count, i2.count);
end;
end;
end;
procedure TfrmChangedAddresses.ChangedlistCustomDrawItem(
Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
e: TAddressEntry;
i: integer;
begin
i:=item.index;
if tobject(item.Data) is TAddressEntry then
begin
e:=TAddressEntry(item.data);
case e.group of
1: sender.Canvas.Font.color:=clBlue;
2: sender.Canvas.Font.color:=clRed;
else
sender.Canvas.Font.color:=clWindowtext;
end;
end
else
begin
asm
nop
end;
end;
DefaultDraw:=true;
end;
procedure TfrmChangedAddresses.miCodeAddressCopyClick(Sender: TObject);
begin
clipboard.AsText:=editCodeAddress.Text;
end;
procedure TfrmChangedAddresses.miCodeAddressBrowseMemoryRegionClick(
Sender: TObject);
begin
memorybrowser.hexview.address := faddress;
memorybrowser.Show;
end;
procedure TfrmChangedAddresses.miCodeAddressDisassembleMemoryRegionClick(
Sender: TObject);
begin
memorybrowser.disassemblerview.SelectedAddress := faddress;
memorybrowser.Show;
end;
procedure TfrmChangedAddresses.miCopyAddressToClipboardClick(Sender: TObject);
var
list: Tstringlist;
i: integer;
begin
list:=tstringlist.create;
for i:=0 to changedlist.Items.Count-1 do
if changedlist.Items[i].Selected then
list.add(changedlist.Items[i].Caption);
clipboard.AsText:=list.text;
list.free;
end;
procedure TfrmChangedAddresses.miCopyValueToClipboardClick(Sender: TObject);
var
list: Tstringlist;
i: integer;
begin
list:=tstringlist.create;
for i:=0 to changedlist.Items.Count-1 do
if changedlist.Items[i].Selected then
list.add(changedlist.Items[i].SubItems[0]);
clipboard.AsText:=list.text;
list.free;
end;
procedure TfrmChangedAddresses.miChangeValueClick(Sender: TObject);
var
i: integer;
a: ptruint;
value: string;
vartype: TVariableType;
ct: TCustomType;
begin
value:='';
if changedlist.ItemIndex<>-1 then
value:=changedlist.Items[changedlist.ItemIndex].SubItems[0];
if InputQuery(rsValueChange, rsGiveTheNewValue, value)=false then exit;
for i:=0 to changedlist.Items.Count-1 do
begin
if changedlist.items[i].Selected then
begin
a:=symhandler.getAddressFromName(changedlist.items[i].Caption);
vartype:=vtDword;
ct:=nil;
ct:=TCustomType(cbDisplayType.Items.Objects[cbDisplayType.ItemIndex]);
if ct=nil then
begin
case cbDisplayType.ItemIndex of
cbDisplayTypeIndexByte: vartype:=vtByte;
cbDisplayTypeIndexWord: vartype:=vtWord;
cbDisplayTypeIndexDword: vartype:=vtDWord;
cbDisplayTypeIndexQword: vartype:=vtQWord;
cbDisplayTypeIndexSingle: vartype:=vtSingle;
cbDisplayTypeIndexDouble: vartype:=vtDouble;
cbDisplayTypeIndexPointer:
begin
if processhandler.is64Bit then
vartype:=vtQWord
else
vartype:=vtDWord;
end
end;
end
else
vartype:=vtCustom;
ParseStringAndWriteToAddress(value,a, vartype,false,ct);
end;
end;
end;
function TfrmChangedAddresses.checkFilter(entry: TaddressEntry): boolean;
begin
if currentFilterFunc=-1 then exit(true);
LUA_SetCurrentContextState(0,entry.fcontext, filterExtraRegs);
lua_rawgeti(LuaVM, LUA_REGISTRYINDEX, currentFilterFunc);
if lua_pcall(LuaVM,0,1,0)=0 then
begin
result:=lua_toboolean(LuaVM,-1);
lua_pop(LuaVM,1);
end
else
begin
lua_settop(LuaVM,0);
result:=false;
end;
end;
procedure TfrmChangedAddresses.rebuildListWithFilter;
var
mi: TMapIterator;
entry: TaddressEntry;
address: ptruint;
li: TListItem;
begin
changedlist.Clear; //don't delete the data
mi:=tmapiterator.Create(addresslist);
mi.First;
while not mi.eom do
begin
mi.GetData(entry);
if checkFilter(entry) then
begin
mi.GetID(address);
li:=changedlist.Items.add;
li.caption:=inttohex(address,8);
li.SubItems.Add('');
li.subitems.add(inttostr(entry.count));
li.Data:=entry;
end;
mi.Next;
end;
refetchValues;
end;
procedure TfrmChangedAddresses.clearFilter;
begin
if currentFilterFunc<>-1 then
begin
luaL_unref(luaVM, LUA_REGISTRYINDEX, currentFilterFunc);
currentFilterFunc:=-1;
end;
currentFilter:='';
miSetFilter.Caption:=rsFilter;
end;
procedure TfrmChangedAddresses.miSetFilterClick(Sender: TObject);
var
f: string;
i: integer;
begin
f:=currentFilter;
if InputQuery(rsFilter, rsEnterLuaFormula, f) then
begin
if trim(f)<>'' then
begin
//parse it
if luaL_loadstring(LuaVM,pchar('return '+f))=0 then
begin
clearfilter;
filterExtraRegs:=(pos('XMM',f)>0);
if filterExtraRegs=false then
begin
i:=pos('FP',f);
filterExtraRegs:=(i>0) and (i+2<=length(f)) and (f[i+2] in ['0'..'7']);
end;
currentFilterFunc:=luaL_ref(LuaVM,LUA_REGISTRYINDEX);
currentFilter:=f;
miSetFilter.Caption:=rsFilter+' : '+currentFilter;
end
else
MessageDlg('"'+f+'" is invalid',mtError,[mbOK],0);
lua_settop(LuaVM,0);
end
else
clearfilter;
rebuildlistwithfilter;
end;
end;
procedure TfrmChangedAddresses.miGroupClearClick(Sender: TObject);
var
i: integer;
e: TAddressEntry;
begin
for i:=0 to Changedlist.Items.count-1 do
begin
e:=TAddressEntry(changedlist.items[i].Data);
e.group:=0;
end;
end;
procedure TfrmChangedAddresses.miMarkAsGroupClick(Sender: TObject);
var
i: integer;
e: TAddressEntry;
begin
for i:=0 to Changedlist.Items.count-1 do
if changedlist.items[i].Selected then
begin
e:=TAddressEntry(changedlist.items[i].Data);
e.group:=tmenuitem(sender).tag;
end;
changedlist.Refresh;
end;
procedure TfrmChangedAddresses.miResetCountClick(Sender: TObject);
var
i: integer;
ae: TAddressEntry;
begin
for i:=changedlist.items.Count-1 downto 0 do
begin
ae:=TAddressEntry(changedlist.Items[i].Data);
ae.count:=0;
end;
refetchValues;
end;
procedure TfrmChangedAddresses.miScanForCommonalitiesClick(Sender: TObject);
var
i,j,k: integer;
g0: array of TAddressEntry;
g1: array of TAddressEntry;
g2: array of TAddressEntry;
e: TAddressEntry;
gs: array of TAddressEntry;
f:TfrmChangedAddressesCommonalityScanner;
begin
setlength(g0,0);
setlength(g1,0);
setlength(g2,0);
setlength(gs,0);
for i:=0 to changedlist.items.Count-1 do
begin
e:=TAddressEntry(changedlist.items[i].data);
e.fillBase;
case e.group of
0:
begin
setlength(g0,length(g0)+1);
g0[length(g0)-1]:=e;
end;
1:
begin
setlength(g1,length(g1)+1);
g1[length(g1)-1]:=e;
end;
2:
begin
setlength(g2,length(g2)+1);
g2[length(g2)-1]:=e;
end;
else raise exception.create(rsInvalidGroups);
end;
if changedlist.items[i].Selected then
begin
setlength(gs,length(gs)+1);
gs[length(gs)-1]:=e;
end;
end;
if (length(g1)=0) and (length(g2)=0) then
begin
if length(gs)>1 then //nothing marked, but more than 1 address selected
begin
g1:=gs;
//delete all g0 entries that are in g1(gs)
for i:=0 to length(g1)-1 do
begin
for j:=0 to length(g0)-1 do
if g0[j]=g1[i] then
begin
//found one
for k:=j to length(g0)-2 do
g0[k]:=g0[k+1];
setlength(g0,length(g0)-1);
end;
end;
end
else
raise exception.create(rsDesignateSomeAddresses);
end;
if (length(g1)>0) and (length(g2)=0) then
begin
if length(g0)=0 then raise exception.create(format(rsNoAddressesLeftForGroup, [1]));
g2:=g0;
end
else
if (length(g1)=0) and (length(g2)>0) then
begin
if length(g0)=0 then raise exception.create(format(rsNoAddressesLeftForGroup, [1]));
g2:=g0;
end;
//process g1 and g2
f:=TfrmChangedAddressesCommonalityScanner.Create(application); //don't destroy when you close this window
f.setgroup(1, g1);
f.setgroup(2, g2);
f.show;
f.initlist;
end;
procedure TfrmChangedAddresses.miShowIPTLogClick(Sender: TObject);
var
f: TfrmIPTLogDisplay;
ae: TAddressEntry;
begin
{$IFDEF WINDOWS}
if changedlist.Selected=nil then exit;
ae:=TAddressEntry(changedlist.Selected.Data);
if (ae.ipt.log=nil) then
begin
if debuggerthread<>nil then
begin
if (useintelptfordebug=false) or (inteliptlogfindwhatroutines=false) then
begin
if messagedlg(rsNeedsIPTFindWhat, mtConfirmation, [mbyes,mbno],0)=mryes then
begin
useintelptfordebug:=true;
inteliptlogfindwhatroutines:=true;
debuggerthread.initIntelPTTracing;
end;
end;
end;
end
else
begin
f:=TfrmIPTLogDisplay.create(application);
f.show;
f.loadlog('log'+faddress.ToHexString+GetTickCount64.ToHexString, ae.ipt.log, ae.ipt.size, faddress);
end;
{$ENDIF}
end;
procedure TfrmChangedAddresses.miDeleteSelectedEntriesClick(Sender: TObject);
var
i: integer;
ae: TAddressEntry;
begin
if changedlist.SelCount>=1 then
begin
if MessageDlg(rsDeleteAddresses, rsAreYouWishToDelete, mtConfirmation, [mbyes,mbno],0) = mryes then
begin
i:=0;
while i<changedlist.items.Count do
begin
if changedlist.items[i].Selected then
begin
ae:=TAddressEntry(changedlist.Items[i].Data);
if addresslist<>nil then
addresslist.Delete(ae.address);
if ae<>nil then
ae.free;
changedlist.Items[i].data:=nil;
changedlist.Items[i].Delete;
end
else
inc(i);
end;
end;
end;
end;
procedure TfrmChangedAddresses.FormClose(Sender: TObject;
var Action: TCloseAction);
var temp:dword;
i: integer;
ae: TAddressEntry;
x: array of integer;
begin
if OKButton.caption=rsStop then
OKButton.Click;
if breakpoint=nil then
action:=caFree
else
begin
dec(pbreakpoint(breakpoint).referencecount);
action:=cahide;
end;
setlength(x,3);
x[0]:=changedlist.Column[0].Width;
x[1]:=changedlist.Column[1].Width;
x[2]:=changedlist.Column[2].Width;
saveformposition(self,x);
try
//rename so that the next created dialog can have this name
self.name:=self.name+'_tobedeleted'+inttohex(random(65535),4)+inttohex(random(65535),4)+inttohex(random(65535),4)+inttohex(random(65535),4)+'_'+inttohex(GetTickCount64,1);
except
end;
end;
procedure TfrmChangedAddresses.FormShow(Sender: TObject);
begin
// defaultcolor:=
defaultcolor:=Changedlist.GetDefaultColor(dctFont);
OKButton.Caption:=rsStop;
if not hassetsizes then
begin
changedlist.Column[0].Width:=max(changedlist.Column[0].Width, canvas.TextWidth('DDDDDDDDFFFFF'));
changedlist.Column[1].Width:=max(changedlist.Column[1].Width, canvas.TextWidth('9999999.999'));
changedlist.Column[2].Width:=max(changedlist.Column[2].Width, canvas.TextWidth('999999'));
ClientWidth:=max(clientwidth, integer(changedlist.Column[0].Width+changedlist.Column[1].Width+changedlist.Column[2].Width+20));
hassetsizes:=true;
end;
end;
procedure TfrmChangedAddresses.ChangedlistDblClick(Sender: TObject);
var i: integer;
ad: dword;
vartype: TVariableType;
ct: TCustomType;
begin
vartype:=vtDword;
ct:=nil;
ct:=TCustomType(cbDisplayType.Items.Objects[cbDisplayType.ItemIndex]);
if ct=nil then
begin
case cbDisplayType.ItemIndex of
cbDisplayTypeIndexByte: vartype:=vtByte;
cbDisplayTypeIndexWord: vartype:=vtWord;
cbDisplayTypeIndexDword: vartype:=vtDword;
cbDisplayTypeIndexQword: vartype:=vtQWord;
cbDisplayTypeIndexSingle: vartype:=vtSingle;
cbDisplayTypeIndexDouble: vartype:=vtDouble;
cbDisplayTypeIndexPointer:
begin
if processhandler.is64Bit then
vartype:=vtQWord
else
vartype:=vtDWord;
end
end;
end
else
vartype:=vtCustom;
for i:=0 to changedlist.Items.Count-1 do
if changedlist.Items[i].Selected then
mainform.addresslist.addaddress(rsNoDescription, changedlist.Items[i].caption, [], 0, vartype, cbDisplayType.Text );
end;
procedure TfrmChangedAddresses.PopupMenu1Popup(Sender: TObject);
begin
Showregisterstates1.enabled:=changedlist.selected<>nil;
Browsethismemoryregion1.enabled:=changedlist.selected<>nil;
miDeleteSelectedEntries.enabled:=changedlist.SelCount>0;
miDissect.enabled:=changedlist.SelCount>0;
micbShowAsSigned.Visible:=cbDisplayType.ItemIndex in [cbDisplayTypeIndexByte, cbDisplayTypeIndexWord, cbDisplayTypeIndexDword, cbDisplayTypeIndexQword];
micbShowAsSigned.Enabled:=not micbShowAsHexadecimal.checked;
end;
procedure TfrmChangedAddresses.refetchValues(specificaddress: ptruint=0; countonly: boolean=false);
var i: integer;
s: string;
handled: boolean;
startindex: integer;
stopindex: integer;
e: TAddressEntry;
begin
s:='';
if changedlist.Items.Count>0 then
begin
if Changedlist.TopItem=nil then exit;
startindex:=Changedlist.TopItem.Index;
stopindex:=min(Changedlist.TopItem.Index+changedlist.VisibleRowCount, Changedlist.Items.Count-1);
for i:=startindex to stopindex do
begin
e:=TAddressEntry(changedlist.items[i].Data);
if (specificaddress<>0) and (e.address <> specificaddress) then //check if this is the line to update, if not, don't read and parse
continue;
if countonly=false then
begin
case cbDisplayType.ItemIndex of
cbDisplayTypeIndexByte: s:=ReadAndParseAddress(e.address, vtByte, nil, micbShowAsHexadecimal.checked, micbShowAsSigned.checked);
cbDisplayTypeIndexWord: s:=ReadAndParseAddress(e.address, vtWord, nil, micbShowAsHexadecimal.checked, micbShowAsSigned.checked);
cbDisplayTypeIndexDword: s:=ReadAndParseAddress(e.address, vtDWord, nil, micbShowAsHexadecimal.checked, micbShowAsSigned.checked);
cbDisplayTypeIndexQword: s:=ReadAndParseAddress(e.address, vtQWord, nil, micbShowAsHexadecimal.checked, micbShowAsSigned.checked);
cbDisplayTypeIndexSingle: s:=ReadAndParseAddress(e.address, vtSingle,nil, micbShowAsHexadecimal.checked);
cbDisplayTypeIndexDouble: s:=ReadAndParseAddress(e.address, vtDouble,nil, micbShowAsHexadecimal.checked);
cbDisplayTypeIndexPointer:
begin
if processhandler.is64Bit then
s:=ReadAndParseAddress(e.address, vtQWord, nil, true)
else
s:=ReadAndParseAddress(e.address, vtDWord, nil, true);
end;
else
begin
//custom type
s:=ReadAndParseAddress(e.address, vtCustom, TCustomType(cbDisplayType.Items.Objects[cbDisplayType.ItemIndex]), micbShowAsHexadecimal.checked, micbShowAsSigned.checked);
end;
end;
end;
while Changedlist.Items[i].SubItems.Count<2 do
Changedlist.Items[i].SubItems.Add('');
changedlist.items[i].SubItems[1]:=inttostr(TAddressEntry(changedlist.items[i].Data).count);
if countonly=false then
Changedlist.Items[i].SubItems[0]:=s;
end;
end;
end;
procedure TfrmChangedAddresses.Timer1Timer(Sender: TObject);
var
c: integer;
s: string;
begin
refetchValues;
c:=changedlist.Items.Count;
if c=1 then
s:=rsCodeAccessesSingleAddress
else
s:=format(rsCodeAccessesAddresses, [c]);
lblInfo.caption:=s;
end;
procedure TfrmChangedAddresses.Showregisterstates1Click(Sender: TObject);
var ae: TAddressEntry;
begin
if changedlist.Selected<>nil then
begin
with TRegisters.create(self) do
begin
//borderstyle:=bsSingle;
ae:=TAddressEntry(changedlist.Selected.Data);
SetContextPointer(ae.context, ae.stack.stack, ae.stack.savedsize);
show;
end;
end;
end;
procedure TfrmChangedAddresses.Browsethismemoryregion1Click(
Sender: TObject);
begin
if changedlist.Selected<>nil then
begin
memorybrowser.memoryaddress:=StrToQWordEx('$'+changedlist.Selected.Caption);
if not memorybrowser.visible then
memorybrowser.show;
end;
end;
procedure TfrmChangedAddresses.setAddress(a: ptruint);
var
a2: ptruint;
ins: string;
begin
faddress:=a;
caption:=format(rsChangedAddressesBy, [a]);
a2:=a;
disassemble(a2);
ins:=defaultDisassembler.LastDisassembleData.opcode+defaultDisassembler.LastDisassembleData.parameters;
editCodeAddress.Text:=format('%x',[a]);
end;
procedure TfrmChangedAddresses.FormDestroy(Sender: TObject);
var
i: integer;
ae: TAddressEntry;
begin
stopDBVMWatch();
for i:=0 to changedlist.Items.Count-1 do
begin
ae:=TAddressEntry(changedlist.Items[i].Data);
ae.free;
end;
if addresslist<>nil then
freeandnil(addresslist);
if addresslistCS<>nil then
freeandnil(addresslistCS);
end;
procedure TfrmChangedAddresses.FormCreate(Sender: TObject);
var x: array of integer;
i: integer;
begin
fdebuggerinterfacewatchid:=-1;
currentFilterFunc:=-1;
okbutton.caption:=rsStop;
setlength(x, 0);
if loadformposition(self,x) then
begin
if length(x)>0 then
begin
changedlist.Column[0].Width:=x[0];
changedlist.Column[1].Width:=x[1];
changedlist.Column[2].Width:=x[2];
hassetsizes:=true;
end;
end;
//fill in the custom types
for i:=0 to customTypes.count-1 do
cbDisplayType.Items.AddObject(TCustomType(customTypes[i]).name, customTypes[i]);
addresslistCS:=TCriticalSection.Create;
addresslist:=TMap.Create(ituPtrSize,sizeof(pointer));
miShowIPTLog.Visible:=systemSupportsIntelPT and not hideiptcapability and (CurrentDebuggerInterface<>nil) and CurrentDebuggerInterface.canUseIPT;
end;
procedure TfrmChangedAddresses.stopdbvmwatch;
begin
{$IFDEF windows}
if dbvmwatchpollthread<>nil then
begin
dbvmwatchpollthread.Terminate;
dbvmwatchpollthread.WaitFor;
freeandnil(dbvmwatchpollthread);
end;
if debuggerinterfacewatchid<>-1 then
begin
dbvm_watch_delete(debuggerinterfacewatchid);
debuggerinterfacewatchid:=-1;
end;
if dbvmwatch_unlock<>0 then
begin
UnlockMemory(dbvmwatch_unlock);
dbvmwatch_unlock:=0;
end;
{$ENDIF}
end;
procedure TfrmChangedAddresses.setdebuggerinterfacewatchid(id: integer);
begin
{$IFDEF windows}
fdebuggerinterfacewatchid:=id;
if id<>-1 then
begin
if dbvmwatchpollthread<>nil then
freeandnil(dbvmwatchpollthread);
dbvmwatchpollthread:=TDBVMWatchExecutePollThread.Create(true);
dbvmwatchpollthread.id:=id;
dbvmwatchpollthread.fca:=self;
dbvmwatchpollthread.Start;
end;
{$ENDIF}
end;
initialization
{$i formChangedAddresses.lrs}
end.
Reference in a new issue View git blame Copy permalink