507 lines
12 KiB
ObjectPascal
507 lines
12 KiB
ObjectPascal
unit frmMemoryViewExUnit;
|
|
|
|
{$mode delphi}
|
|
|
|
interface
|
|
|
|
uses
|
|
windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
|
ExtCtrls, StdCtrls, ComCtrls, Menus, memdisplay, newkernelhandler, cefuncproc,
|
|
syncobjs, math, savedscanhandler, foundlisthelper, CustomTypeHandler,
|
|
symbolhandler, inputboxtopunit, commonTypeDefs;
|
|
|
|
|
|
type TMVCompareMethod=(cmOr, cmXor, cmAnd);
|
|
|
|
type
|
|
TMemoryDataSource=class(TThread)
|
|
private
|
|
cs: TCriticalSection;
|
|
address: ptruint;
|
|
buf: pbytearray;
|
|
bufsize: integer;
|
|
faddresslistonly: boolean;
|
|
fcompareagainstsavedscan: boolean;
|
|
fvartype: TVariableType;
|
|
fvarsize: integer;
|
|
|
|
comparemethod: TMVCompareMethod;
|
|
|
|
temppagebuf: pbytearray;
|
|
|
|
addresslist: TFoundList;
|
|
previousvaluelist: TSavedScanHandler;
|
|
ct: TCustomtype;
|
|
|
|
|
|
|
|
public
|
|
procedure lock;
|
|
procedure unlock;
|
|
procedure setRegion(address: ptruint; buf: pointer; size: integer);
|
|
procedure execute; override;
|
|
procedure fetchmem;
|
|
procedure setaddresslist(state: boolean; listname: string);
|
|
procedure setcompare(state: boolean; compareMethod: TMVCompareMethod; listname: string);
|
|
constructor create(suspended: boolean);
|
|
end;
|
|
|
|
{ TfrmMemoryViewEx }
|
|
|
|
TfrmMemoryViewEx = class(TForm)
|
|
cbAddresslistOnly: TCheckBox;
|
|
cbCompare: TCheckBox;
|
|
cbAddresslist: TComboBox;
|
|
cbSavedList: TComboBox;
|
|
cbColor: TComboBox;
|
|
edtPitch: TEdit;
|
|
Label3: TLabel;
|
|
lblAddress: TLabel;
|
|
Label2: TLabel;
|
|
MenuItem1: TMenuItem;
|
|
Panel1: TPanel;
|
|
pmMemview: TPopupMenu;
|
|
rbOr: TRadioButton;
|
|
rbAnd: TRadioButton;
|
|
rbXor: TRadioButton;
|
|
Timer1: TTimer;
|
|
tbPitch: TTrackBar;
|
|
procedure cbAddresslistChange(Sender: TObject);
|
|
procedure cbAddresslistOnlyChange(Sender: TObject);
|
|
procedure cbAddresslistDropDown(Sender: TObject);
|
|
procedure cbCompareChange(Sender: TObject);
|
|
procedure cbSavedListChange(Sender: TObject);
|
|
procedure cbColorChange(Sender: TObject);
|
|
|
|
procedure edtPitchChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure MenuItem1Click(Sender: TObject);
|
|
procedure Panel1DblClick(Sender: TObject);
|
|
procedure Timer1Timer(Sender: TObject);
|
|
procedure tbPitchChange(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
buf: pbytearray;
|
|
bufsize: integer;
|
|
datasource: TMemoryDataSource;
|
|
history: TStringList;
|
|
|
|
function getCompareMethod: TMVCompareMethod;
|
|
function ondata(newAddress: ptruint; PreferedMinimumSize: integer; var newbase: pointer; var newsize: integer): boolean;
|
|
public
|
|
{ public declarations }
|
|
md: TMemDisplay;
|
|
end;
|
|
|
|
var
|
|
frmMemoryViewEx: TfrmMemoryViewEx;
|
|
|
|
implementation
|
|
|
|
uses MemoryBrowserFormUnit, MainUnit, ProcessHandlerUnit;
|
|
|
|
{$R *.lfm}
|
|
|
|
resourcestring
|
|
rsGotoAddress = 'Goto Address';
|
|
rsFillInTheAddressYouWantToGoTo = 'Fill in the address you want to go to';
|
|
|
|
|
|
{ TMemoryDataSource }
|
|
|
|
constructor TMemoryDataSource.create(suspended: boolean);
|
|
begin
|
|
cs:=tcriticalsection.create;
|
|
|
|
getmem(temppagebuf, 4096); //so it doesn't need to be allocated/freed each fetchmem call
|
|
|
|
inherited create(suspended);
|
|
end;
|
|
|
|
procedure TMemoryDataSource.setcompare(state: boolean; compareMethod: TMVCompareMethod; listname: string);
|
|
begin
|
|
if state then
|
|
begin
|
|
|
|
cs.Enter;
|
|
try
|
|
if previousvaluelist<>nil then
|
|
freeandnil(previousvaluelist);
|
|
|
|
previousvaluelist:=TSavedScanHandler.create(mainform.memscan.GetScanFolder, listname);
|
|
previousvaluelist.AllowNotFound:=true;
|
|
previousvaluelist.AllowRandomAccess:=true;
|
|
|
|
self.compareMethod:=comparemethod;
|
|
|
|
finally
|
|
cs.Leave;
|
|
end;
|
|
|
|
end;
|
|
|
|
fcompareagainstsavedscan:=state;
|
|
end;
|
|
|
|
procedure TMemoryDataSource.setaddresslist(state: boolean; listname: string);
|
|
begin
|
|
if state then
|
|
begin
|
|
//Open a "PreviousValue object for the current memscan results.
|
|
|
|
cs.Enter;
|
|
|
|
try
|
|
if addresslist<>nil then
|
|
freeandnil(addresslist);
|
|
|
|
addresslist:=TFoundList.create(nil, mainform.memscan, listname);
|
|
addresslist.Initialize;
|
|
fvartype:=mainform.memscan.VarType;
|
|
ct:=mainform.memscan.CustomType;
|
|
fvarsize:=mainform.memscan.Getbinarysize div 8;
|
|
|
|
finally
|
|
cs.leave;
|
|
end;
|
|
end;
|
|
|
|
|
|
faddresslistonly:=state;
|
|
|
|
fetchmem; //update now
|
|
end;
|
|
|
|
procedure TMemoryDataSource.fetchmem;
|
|
var x: ptrUint;
|
|
a,a2: ptruint;
|
|
s: integer;
|
|
|
|
s2: integer;
|
|
|
|
p: PByteArray;
|
|
i: qword;
|
|
j: integer;
|
|
|
|
|
|
toread: integer;
|
|
begin
|
|
lock;
|
|
|
|
if buf<>nil then //not yet initialized
|
|
begin
|
|
|
|
a:=address;
|
|
if faddresslistonly then
|
|
begin
|
|
i:=addresslist.FindClosestAddress(address-fvarsize+1); //all following accesses will be sequential
|
|
|
|
end;
|
|
|
|
|
|
toread:=bufsize;
|
|
|
|
|
|
//while a<address+bufsize do
|
|
|
|
while toread>0 do
|
|
begin
|
|
s:=minX((address+bufsize)-a, 4096-(a mod 4096)); //the number of bytes left in this page or for this buffer
|
|
|
|
x:=0;
|
|
if faddresslistonly then
|
|
begin
|
|
//check if this page has any addresses.
|
|
zeromemory(@buf[a-address], s);
|
|
|
|
if int64(i)<>-1 then
|
|
begin
|
|
a2:=addresslist.GetAddress(i);
|
|
//get the first addresses that belong to this page (or has bytes in it)
|
|
while (i<addresslist.count-1) and (a2<a-fvarsize+1) do
|
|
begin
|
|
inc(i);
|
|
a2:=addresslist.GetAddress(i)
|
|
end;
|
|
|
|
while (i<addresslist.count-1) and (a2<a+s) do
|
|
begin
|
|
//render to the buffer
|
|
s2:=fvarsize;
|
|
if integer(a2-a)<0 then //cut off if it falls before the region
|
|
begin
|
|
dec(s2, integer(a2-a));
|
|
inc(a2, integer(a2-a));
|
|
end;
|
|
|
|
if (a2-a+s2)>s then //cut off if it falls after the region
|
|
begin
|
|
s2:=s-(a2-a);
|
|
end;
|
|
|
|
if s2>0 then
|
|
begin
|
|
x:=0;
|
|
ReadProcessMemory(processhandle, pointer(a2), @buf[a2-address], s2, x);
|
|
|
|
if fcompareagainstsavedscan and (previousvaluelist<>nil) then
|
|
begin
|
|
//get the saved scan
|
|
p:=previousvaluelist.getpointertoaddress(a2, fvartype, ct);
|
|
if p<>nil then
|
|
begin
|
|
case comparemethod of
|
|
cmor: for j:=0 to x-1 do buf[a2-address+j]:=buf[a2-address+j] or p[j];
|
|
cmxor: for j:=0 to x-1 do buf[a2-address+j]:=buf[a2-address+j] xor p[j];
|
|
cmand: for j:=0 to x-1 do buf[a2-address+j]:=buf[a2-address+j] and p[j];
|
|
|
|
end;
|
|
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
inc(i);
|
|
a2:=addresslist.GetAddress(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end
|
|
else
|
|
begin
|
|
ReadProcessMemory(processhandle, pointer(a), @buf[a-address], s, x);
|
|
if x<s then //zero the unread bytes
|
|
zeromemory(@buf[a-address], s-x);
|
|
end;
|
|
|
|
dec(toread,s);
|
|
|
|
a:=a+s; //next page
|
|
end;
|
|
|
|
end;
|
|
unlock;
|
|
end;
|
|
|
|
procedure TMemoryDataSource.execute;
|
|
begin
|
|
while not terminated do
|
|
begin
|
|
sleep(100);
|
|
|
|
fetchmem;
|
|
end;
|
|
end;
|
|
|
|
procedure TMemoryDataSource.lock;
|
|
begin
|
|
cs.enter
|
|
end;
|
|
|
|
procedure TMemoryDataSource.unlock;
|
|
begin
|
|
cs.leave;
|
|
end;
|
|
|
|
procedure TMemoryDataSource.setRegion(address: ptruint; buf: pointer; size: integer);
|
|
begin
|
|
lock;
|
|
self.address:=address;
|
|
self.buf:=buf;
|
|
bufsize:=size;
|
|
|
|
fetchmem;
|
|
unlock;
|
|
|
|
|
|
end;
|
|
|
|
{ TfrmMemoryViewEx }
|
|
function TfrmMemoryViewEx.ondata(newAddress: ptruint; PreferedMinimumSize: integer; var newbase: pointer; var newsize: integer): boolean;
|
|
var x: dword;
|
|
begin
|
|
|
|
//todo: Pre-buffer when going up. (allocate 4096 bytes in front, and give a pointer to 4096 bytes after. Only when the newaddress becomes smaller than the base realloc
|
|
|
|
// label1.caption:=inttohex(newaddress,8);
|
|
|
|
datasource.lock;
|
|
if bufsize<PreferedMinimumSize then
|
|
begin
|
|
try
|
|
ReAllocMem(buf, PreferedMinimumSize+4096);
|
|
except
|
|
beep;
|
|
end;
|
|
|
|
if buf=nil then
|
|
bufsize:=0
|
|
else
|
|
bufsize:=PreferedMinimumSize+4096;
|
|
end;
|
|
|
|
datasource.setRegion(newaddress, buf, bufsize);
|
|
datasource.unlock;
|
|
|
|
|
|
newbase:=buf;
|
|
newsize:=bufsize;
|
|
result:=newsize>=PreferedMinimumSize; //allow the move if allocated enough memory
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.FormCreate(Sender: TObject);
|
|
begin
|
|
//create a datasource thread
|
|
history:=tstringlist.create;
|
|
|
|
datasource:=TMemoryDataSource.create(true); //possible to add multiple readers in the future
|
|
|
|
md:=TMemDisplay.Create(self);
|
|
md.onData:=ondata;
|
|
|
|
getmem(buf,4096);
|
|
bufsize:=4096;
|
|
|
|
datasource.setRegion(MemoryBrowser.hexview.Address and ptruint(not $FFF), buf, bufsize);
|
|
md.setPointer(MemoryBrowser.hexview.Address and ptruint(not $FFF), buf, bufsize);
|
|
md.Align:=alClient;
|
|
md.parent:=panel1;
|
|
md.PopupMenu:=pmMemview;
|
|
|
|
md.OnDblClick:=Panel1DblClick;
|
|
|
|
|
|
|
|
datasource.Start;
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.edtPitchChange(Sender: TObject);
|
|
var newpitch: integer;
|
|
begin
|
|
try
|
|
newpitch:=strtoint(edtpitch.Caption);
|
|
md.setPixelsPerLine(newpitch);
|
|
edtPitch.Font.Color:=clDefault;
|
|
except
|
|
edtPitch.Font.Color:=clred;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.cbAddresslistOnlyChange(Sender: TObject);
|
|
begin
|
|
cbAddresslist.enabled:=cbAddresslistOnly.checked;
|
|
cbCompare.Enabled:=cbAddresslistOnly.checked;
|
|
cbSavedList.enabled:=cbAddresslistOnly.checked;
|
|
|
|
if datasource<>nil then
|
|
datasource.setaddresslist(cbAddresslistOnly.checked, 'TMP');
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.cbAddresslistChange(Sender: TObject);
|
|
begin
|
|
if cbAddresslist.ItemIndex=0 then
|
|
datasource.setaddresslist(cbAddresslistOnly.checked, 'TMP')
|
|
else
|
|
datasource.setaddresslist(cbAddresslistOnly.checked, cbAddresslist.text);
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.cbAddresslistDropDown(Sender: TObject);
|
|
begin
|
|
TComboBox(sender).Items.Clear;
|
|
TComboBox(sender).DropDownCount:=mainform.memscan.getsavedresults(TComboBox(sender).Items)+1;
|
|
TComboBox(sender).Items.Insert(0,'Current scanlist');
|
|
end;
|
|
|
|
function TfrmMemoryViewEx.getCompareMethod: TMVCompareMethod;
|
|
//returns the compare method currently selected
|
|
begin
|
|
result:=cmOr;
|
|
if rbxor.checked then
|
|
result:=cmxOr
|
|
else
|
|
if rbAnd.checked then
|
|
result:=cmAnd;
|
|
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.cbCompareChange(Sender: TObject);
|
|
begin
|
|
cbSavedList.enabled:=cbCompare.checked;
|
|
rbOr.enabled:=cbCompare.checked;
|
|
rbAnd.enabled:=cbCompare.checked;
|
|
rbXor.enabled:=cbCompare.checked;
|
|
|
|
datasource.setcompare(cbCompare.checked, getCompareMethod, 'TMP');
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.cbSavedListChange(Sender: TObject);
|
|
begin
|
|
if cbSavedList.ItemIndex=0 then
|
|
datasource.setcompare(cbCompare.checked, getCompareMethod, 'TMP')
|
|
else
|
|
datasource.setcompare(cbCompare.checked, getCompareMethod, cbSavedList.text);
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.cbColorChange(Sender: TObject);
|
|
var i: integer;
|
|
begin
|
|
case cbcolor.itemindex of
|
|
0: md.setFormat($1900);
|
|
1: md.setFormat($1907);
|
|
2: md.setFormat($1908);
|
|
end;
|
|
|
|
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.FormDestroy(Sender: TObject);
|
|
begin
|
|
if datasource<>nil then
|
|
begin
|
|
datasource.Terminate;
|
|
datasource.WaitFor;
|
|
freeandnil(datasource);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.MenuItem1Click(Sender: TObject);
|
|
var newaddress: string;
|
|
canceled: boolean;
|
|
begin
|
|
newaddress:=inputboxtop(rsGotoAddress, rsFillInTheAddressYouWantToGoTo, IntTohex(md.getTopLeftAddress, 8), true, canceled, History);
|
|
|
|
if not canceled then
|
|
begin
|
|
md.MoveTo(0,0);
|
|
md.setPointer(symhandler.getAddressFromName(newaddress));
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.Panel1DblClick(Sender: TObject);
|
|
var c: tpoint;
|
|
address: ptruint;
|
|
begin
|
|
c:=md.ScreenToClient(mouse.cursorpos);
|
|
|
|
address:=md.getAddressFromScreenPosition(c.x, c.y);
|
|
|
|
MemoryBrowser.hexview.Address:=address;
|
|
MemoryBrowser.show;
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.Timer1Timer(Sender: TObject);
|
|
begin
|
|
lbladdress.caption:='Address : '+inttohex(md.getTopLeftAddress,8)+' zoom : '+floattostr(md.zoom);
|
|
end;
|
|
|
|
procedure TfrmMemoryViewEx.tbPitchChange(Sender: TObject);
|
|
begin
|
|
edtPitch.caption:=inttostr(tbPitch.position);//inttostr(trunc(2**tbPitch.position));
|
|
end;
|
|
|
|
end.
|
|
|