cheat-engine/Cheat Engine/frmSortPointerlistUnit.pas

354 lines
7.4 KiB
ObjectPascal

unit frmSortPointerlistUnit;
{$mode delphi}
interface
uses
windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, PointerscanresultReader, maps, ComCtrls, math;
type
{ TfrmSortPointerlist }
TPointerListSortThread=class(tthread)
private
procedure sortdone;
procedure sorterror;
public
initialtime: dword;
position, maxposition: qword;
pointerscanresults: TPointerscanresultReader;
callback: TNotifyEvent;
callbackOnError: TNotifyEvent;
column: integer;
error: string;
tempname: string;
tempfilelist: tstrings;
destructor destroy; override;
procedure execute; override;
end;
TfrmSortPointerlist = class(TForm)
Button1: TButton;
Label1: TLabel;
lblTimeLeft: TLabel;
ProgressBar1: TProgressBar;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
sorter: TPointerListSortThread;
procedure done(sender: TObject);
procedure error(sender: TObject);
public
{ public declarations }
function dowork(column: integer; ptrfile: string; var tempname: string; tempfilelist: tstrings): boolean;
end;
implementation
{$R *.lfm}
uses pointerscannerfrm;
resourcestring
rstimeLeft='Estimated time left';
procedure TPointerListSortThread.sortdone;
begin
if assigned(callback) then
callback(self);
end;
procedure TPointerListSortThread.sorterror;
begin
if assigned(callbackOnError) then
callbackOnError(self);
end;
destructor TPointerListSortThread.destroy;
begin
if pointerscanresults<>nil then
freeandnil(pointerscanresults);
end;
procedure TPointerListSortThread.execute;
var i: qword;
j: integer;
p: PPointerscanResult;
v: qword;
files: TMap;
keytype: TMapIdType;
f: Tfilestream;
entrysize: integer;
mi: TMapIterator;
temp: dword;
tempstring: string;
mb: qword;
begin
try
entrysize:=pointerscanresults.entrySize;
if column=0 then
keytype:=ituPtrSize
else
keytype:=its4; //max offset size (signed 32-bit, max relative address)
files:=tmap.Create(keytype, sizeof(TFilestream));
tempname:=Pointerscanresults.filename+'.sorted';
position:=0;
maxposition:=Pointerscanresults.count;
initialtime:=gettickcount;
try
i:=0;
while i<Pointerscanresults.count do
begin
if terminated then exit;
position:=i;
p:=pointerscanresults.getPointer(i);
if column=0 then //modules are limited to 32-bit length, so seperate them by the modulenr
begin
if p.modulenr>=0 then
begin
mb:=pointerscanresults.getModuleBase(p.modulenr);
if mb>0 then
v:=mb+p.moduleoffset
else
v:=qword(qword(p.modulenr+1) shl 32) or dword(p.moduleoffset)
end
else
v:=p.moduleoffset;
end
else
begin
if column>p.offsetcount then
v:=p.offsetcount-column //-1 //p.offsets[0]
else
v:=p.offsets[p.offsetcount-column];
end;
if files.GetData(v, f)=false then //create this pointerfile.
begin
f:=tfilestream.Create(tempname+'.'+inttohex(v,1), fmcreate);
files.Add(v, f);
end;
p:=pointerscanresults.LastRawPointer;
f.Write(p^, entrysize);
inc(i);
end;
finally
mi:=TMapIterator.Create(files);
i:=0;
if files.count>0 then
begin
mi.first;
while not mi.EOM do
begin
f:=nil;
mi.GetData(f);
if f<>nil then
begin
tempfilelist.Add(f.filename);
inc(i);
f.free;
end;
mi.Next;
end;
end;
mi.free;
files.free;
end;
if pointerscanresults<>nil then
freeandnil(pointerscanresults);
synchronize(sortdone);
except
on e:exception do
begin
error:=e.Message;
synchronize(sorterror);
end;
end;
end;
{
begin
try
for i:=0 to Pointerscanresults.count-1 do
begin
p:=pointerscanresults.getPointer(i);
if c=0 then
v:=pointerscanresults.getModuleBase(p.modulenr)+p.moduleoffset
else
begin
if c>p.offsetcount then
v:=p.offsets[0]
else
v:=p.offsets[p.offsetcount-c];
end;
if files.GetData(v, f)=false then //create this pointerfile.
begin
f:=tfilestream.Create(basefilename+'.'+inttohex(v,1), fmcreate);
files.Add(v, f);
end;
f.Write(p^, entrysize);
end;
finally
s:='';
mi:=TMapIterator.Create(files);
i:=0;
if files.count>0 then
begin
mi.first;
while not mi.EOM do
begin
f:=nil;
mi.GetData(f);
if f<>nil then
begin
s:=s+f.filename+#13#10;
f.free;
end;
mi.Next;
end;
end;
mi.free;
files.free;
end;
showmessage(s);
end;
}
procedure TfrmSortPointerlist.Button1Click(Sender: TObject);
begin
modalresult:=mrcancel;
end;
procedure TfrmSortPointerlist.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
end;
procedure TfrmSortPointerlist.FormDestroy(Sender: TObject);
begin
if sorter<>nil then
begin
sorter.Terminate;
sorter.WaitFor;
freeandnil(sorter);
end;
end;
procedure TfrmSortPointerlist.Timer1Timer(Sender: TObject);
var
difftime: dword;
timeperpos: double;
totaltime: qword;
timeleft: string;
seconds, minutes, hours: qword;
begin
if sorter<>nil then
begin
difftime:=gettickcount-sorter.initialtime;
if sorter.position>10 then
begin
timeperpos:=difftime/sorter.position;
totaltime:=ceil(timeperpos*(sorter.maxposition-sorter.position)); //time that it will take for the rest
progressbar1.position:=ceil(sorter.position/sorter.maxposition*100);
seconds:=(totaltime div 1000);
minutes:=(seconds div 60);
hours:=(minutes div 60);
seconds:=seconds mod 60;
minutes:=minutes mod 60;
timeleft:=format('%.2d:%.2d:%.2d', [hours, minutes, seconds]);
lblTimeLeft.caption:=format('%s : %s', [rsTimeLeft, timeleft]);
end;
end;
end;
procedure TfrmSortPointerlist.done(sender: TObject);
begin
modalresult:=mrok;
end;
procedure TfrmSortPointerlist.error(sender: TObject);
begin
messagedlg(TPointerListSortThread(sender).error, mtError, [mbok] , 0);
modalresult:=mrcancel;
end;
function TfrmSortPointerlist.dowork(column: integer; ptrfile: string; var tempname: string; tempfilelist: tstrings): boolean;
begin
sorter:=TPointerListSortThread.Create(true);
sorter.callback:=done;
sorter.callbackOnError:=error;
sorter.column:=column;
sorter.pointerscanresults:=TPointerscanresultReader.create(ptrfile);
sorter.tempfilelist:=tempfilelist;
sorter.Start;
result:=showmodal=mrok;
tempname:=sorter.tempname;
end;
end.