pointerscannerfrm.pas

冒险岛吸怪源码ＵＣＥ的制作材料 用于冒险岛游戏的外挂

unit pointerscannerfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls,disassembler,cefuncproc,newkernelhandler,
  syncobjs,syncobjs2, Menus, virtualmemory, symbolhandler;


const staticscanner_done=wm_user+1;
const rescan_done=wm_user+2;
const open_scanner=wm_user+3;



type TMatches = array of ttreenode;
type tpath = array of dword;

type TDissectData = class(tthread)
  private
    output: array [0..63] of string;
    addresses: array [0..63] of dword;
    ispointer: array [0..64] of boolean;

    outputpos: integer;
//    procedure flushoutput;
//    procedure alreadydissected;
  public
    dissectaddress: dword;
    treenode: ttreenode;
    structsize,structsize0: dword;
    automatic: boolean;
    maxlevel: integer;
    filterstart,filterstop: integer;
    unalligned: boolean;
//    procedure execute; override;
end;

type trescanpointers=class(tthread)
  public
    progressbar: tprogressbar;
    oldpointerlist: tmemorystream;
    newpointerlist: tmemorystream;
    address: dword;
    procedure execute; override;
end;

type
  toffsetlist = array of dword;
  TStaticscanner = class;
  TMethod2scanner = class (tthread)
  private
    results: tmemorystream;
    resultsfile: tfilestream;


    pathlist: array of dword;

//    procedure updatelist;
    function haspossiblepath(level: integer; address: dword;var recnr: integer):boolean;
    procedure addpossiblepath(address:dword; level: integer);
    procedure ScanAddress(saddress:dword; currentlevel: integer);
  public

    method3: boolean;
    startworking: tevent;
    isdone: boolean;
    stop: boolean;


    //--------------
    address: dword;
    addresstofind: dword;
    maxlevel: integer;
    structsize,structsize0: integer;
    filterstart,filterstop: integer;
    unalligned: boolean;
    paintlevel: integer;
    offsetlist: toffsetlist;
    fast: boolean;
    psychotic: boolean;

    filename: string;
    procedure flushresults;

    procedure execute; override;
    constructor create(suspended: boolean);
    destructor destroy; override;
  end;

  TStaticscanner = class(TThread)
  private
    updateline: integer; //not used for addentry

    memoryregion: array of tmemoryregion;
    lasttreenodeadded: ttreenode;
    addnode: ttreenode;
    addnodeextension: tmatches;

    method2scanners: array of tmethod2scanner;

//    procedure UpdateList;
    //procedure done;
//    procedure automaticfinish;
//    procedure addentry;
    procedure method2scan(address:dword);
  public
    automatic: boolean;
    automaticaddress: dword;
    filterstart:dword;
    filterstop:dword;
    start: dword;
    stop: dword;
    progressbar: TProgressbar;
    sz,sz0: integer;
    maxlevel: integer;
    unalligned: boolean;
    codescan: boolean;
    method2: boolean;
    method3: boolean;

    fast: boolean;
    psychotic: boolean;
    writableonly: boolean;
    unallignedbase: boolean;

    threadcount: integer;
    scannerpriority: TThreadPriority;

    filenames: array of string;
    procedure execute; override;
    destructor destroy; override;
  end;

type
  Tfrmpointerscanner = class(TForm)
    Label9: TLabel;
    ProgressBar1: TProgressBar;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Button1: TButton;
    TreeView2: TTreeView;
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    N2: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Pointerscanner1: TMenuItem;
    Method3Fastspeedandaveragememoryusage1: TMenuItem;
    N1: TMenuItem;
    Rescanmemory1: TMenuItem;
    Showresults1: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Method3Fastspeedandaveragememoryusage1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Showresults1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Rescanmemory1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure TreeView2DblClick(Sender: TObject);
  private
    { Private declarations }
    start:tdatetime;
    pointerlist: tmemorystream;
    rescan: trescanpointers;
    cewindowhandle: thandle;
    procedure m_staticscanner_done(var message: tmessage); message staticscanner_done;
    procedure rescandone(var message: tmessage); message rescan_done;
    procedure openscanner(var message: tmessage); message open_scanner;
    procedure drawtreeview;
    procedure doneui;
    procedure loadpointers;
  public
    { Public declarations }
    Staticscanner:TStaticScanner;
  end;

type TExecuter = class(tthread)
  public
    procedure execute; override;
end;

type tarraypath= array of tpath;

var
  frmPointerScanner: TfrmPointerScanner;
  staticlist: array of dword;
  dissectedstatics: dword=0;

  dissectedpointersLevelpos:array of integer;
  dissectedpointersLevel: array of array of dword;
  dissectedpointersLevelMREWS: array of TMultiReadExclusiveWriteSynchronizer; //every level has it's own lock


  treenodeswithchildrenpos: integer;
  treenodeswithchildren: array of ttreenode;
  treenodeswithchildrencs: tcriticalsection;

  matchednodescs: tcriticalsection;
  matchednodes: array of Tmatches;
  matchednodespos: integer;


  PossiblepathsLevelMREWS: array of TMultiReadExclusiveWriteSynchronizer;
  possiblepathsLevel: array of array of dword; //all addresses that finished in a address
  possiblepathsLevelpos: array of integer;

  method2semaphore: tsemaphore;
  


  totalpointers: integer;
  lastlevel: integer;

  pointersfound: dword=0;
  foundbyappending: dword=0;
  skipped: dword;

  lastaddress: dword;
  cpucount: integer;

  scanaddresscount: dword;
  incorrectresult: dword;
  continued: dword;


  vm: tvirtualmemory;

implementation

{$R *.dfm}

uses PointerscannerSettingsFrm;


function IsBadReadPtr(x: pointer;size: integer):boolean;
var mbi: memory_basic_information;
begin
  //replacement for isbadreadptr to fix this consecutional exception crap while debugging
  result:=true;
  if virtualqueryex(processhandle,x,mbi,sizeof(mbi))=sizeof(mbi) then
  begin
    if (mbi.State=mem_commit) and (mbi.Protect<>page_noaccess) then result:=false;
  end;

end;

function IsBadWritePtr(currentpos: pointer; size: integer):boolean;
var mbi: memory_basic_information;
begin
  result:=true;
  if virtualqueryex(processhandle,currentpos,mbi,sizeof(mbi))=sizeof(mbi) then
    if ((mbi.Protect and PAGE_READWRITE)=PAGE_READWRITE) or ((mbi.Protect and PAGE_EXECUTE_READWRITE)=PAGE_EXECUTE_READWRITE) then result:=false;
end;


procedure TExecuter.execute;
begin
  try
    frmpointerscanner:=tfrmpointerscanner.Create(nil);
    frmpointerscanner.ShowModal;

    messagebox(0,'Exit pointerscan','exit',mb_ok);

    FreeLibraryAndExitThread(getmodulehandle('pscan.dll'),0);
  except
    on e: exception do
    begin
      messagebox(0,pchar('pointerscan crash.'),'error',mb_ok);
      messagebox(0,pchar('pointerscan crash. '+e.message),'error',mb_ok);
    end;

  end;
end;

function isdissected(level: integer; address: dword;var recnr: integer):boolean;
var i: integer;
    first,last: integer;
begin
  result:=false;
  recnr:=0;
  first:=0;

  if level>0 then
  begin
    result:=isdissected(level-1,address,recnr); //recnr is only used when it is NOT found
    if result then exit;
  end;

  //no need for a critical section, it doesnt become shorter, only thing that can happen is a address being added twice, but thats not the end of the world
  last:=dissectedpointerslevelpos[level];

  while first<last do
  begin
    i:=first+((last-first) div 2);
    if (i=first) or (i=last) then
    begin
      for i:=first to last-1 do
      begin
        if dissectedpointerslevel[level][i]=address then
        begin
          recnr:=i;
          result:=true;
          exit;
        end;
        if dissectedpointerslevel[level][i]>address then break;
      end;

      break;
    end;

    if dissectedpointerslevel[level][i]=address then
    begin
      recnr:=i;
      result:=true;
      exit;
    end;

    if address<dissectedpointerslevel[level][i] then
      last:=i
    else
      first:=i;
  end;
  recnr:=last;
end;


procedure adddisectedaddress(level:integer; dissectedaddress:dword);
var i,j: integer;
begin
  if not isdissected(level,dissectedaddress,i) then
  begin
    dissectedpointersLevelMREWS[level].beginwrite;
    try

      if dissectedpointerslevelpos[level]+1>=length(dissectedpointerslevel[level]) then //reallocate array
        setlength(dissectedpointerslevel[level],length(dissectedpointerslevel[level])*2); //double the memory (4mb, 8mb, 16mb,32mb,64mb,128mb,256mb,512mb,1024mb.....)

      //not found so add , i is a good indication of where
      dec(i);
      while (i>=0) and (dissectedpointerslevel[level][i]>dissectedaddress) do dec(i);
      if i=-1 then i:=0;

      while (i<dissectedpointerslevelpos[level]) and (dissectedpointerslevel[level][i]<dissectedaddress) do inc(i);

      //add it to the spot of i

      //first move evrything else to the right
      for j:=dissectedpointerslevelpos[level]-1 downto i do
        dissectedpointerslevel[level][j+1]:=dissectedpointerslevel[level][j];

      dissectedpointerslevel[level][i]:=dissectedaddress;

      dissectedpointerslevelpos[level]:=dissectedpointerslevelpos[level]+1;
    finally
      dissectedpointersLevelMREWS[level].EndWrite;
    end;
  end;

end;

//----------------------- scanner info --------------------------


//----------------------- method2scanner-------------------------

procedure TMethod2scanner.flushresults;
begin
  resultsfile.WriteBuffer(results.Memory^,results.Size);
  results.Seek(0,sofrombeginning);
  results.Clear;
end;


function TMethod2scanner.haspossiblepath(level: integer; address: dword;var recnr: integer):boolean;
var i: integer;
    first,last: integer;
begin
  result:=false;
  recnr:=0;
  first:=0;


  //check possible paths in higher levels
  if level<self.maxlevel then
  begin
    result:=haspossiblepath(level+1,address,recnr); //recnr is only used when it is NOT found
    if result then exit;
  end;

  //no need for a critical section, it doesnt become shorter, only thing that can happen is a address being added twice, but thats not the end of the world
  last:=possiblepathslevelpos[level];

  while first<last do
  begin
    i:=first+((last-first) div 2);
    if (i=first) or (i=last) then
    begin
      for i:=first to last-1 do
      begin
        if possiblepathslevel[level][i]=address then
        begin
          recnr:=i;
          result:=true;
          exit;
        end;
        if possiblepathslevel[level][i]>address then break;
      end;

      break;
    end;

    if possiblepathslevel[level][i]=address then
    begin
      recnr:=i;
      result:=true;
      exit;
    end;

    if address<possiblepathslevel[level][i] then
      last:=i
    else
      first:=i;
  end;
  recnr:=last;
end;



procedure TMethod2scanner.addpossiblepath(address: dword; level: integer);
var x,y: dword;