mainunit.pas.svn-base

这是一段游戏修改工具的源代码.ring3功能由dephi开发,驱动是C开发.希望对大家有帮助

unit mainunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ComCtrls, StdCtrls,syncobjs,syncobjs2,symbolhandlerlite,globals;

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

const wm_drawtreeviewdone=wm_user+4;
const wm_drawtreeviewAddToList=wm_user+5;


type TDrawTreeview=class(tthread)
  private
    st: string;
    offset: dword;
    offsetlist: array of dword;
    offsetsize: integer;
  public
    treeview: ttreeview;
    pointerlist: tmemorystream;
    progressbar: tprogressbar;
    procedure execute; override;
    procedure done;
    procedure AddToList;
end;

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;
  public
    dissectaddress: dword;
    treenode: ttreenode;
    structsize,structsize0: dword;
    automatic: boolean;
    maxlevel: integer;
    filterstart,filterstop: integer;
    unalligned: boolean;
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;
    phase: integer;
    currentpos: ^Dword;

    starttime: dword;

    procedure execute; override;
    destructor destroy; override;
  end;

type
  Tfrmpointerscanner = class(TForm)
    Label9: TLabel;
    ProgressBar1: TProgressBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    N2: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Pointerscanner1: TMenuItem;
    Method1Fastbuttakesuptoomuchmemory1: TMenuItem;
    Method2Takesuplittlememoryandtakesyears1: TMenuItem;
    Method3Fastspeedandaveragememoryusage1: TMenuItem;
    N1: TMenuItem;
    Rescanmemory1: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Timer1: TTimer;
    Timer2: TTimer;
    TreeView2: TTreeView;
    Panel1: TPanel;
    Label10: TLabel;
    Label11: TLabel;
    Showresults1: TMenuItem;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label19: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    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);
    procedure New1Click(Sender: TObject);
  private
    { Private declarations }
    start:tdatetime;
    
    rescan: trescanpointers;
    cewindowhandle: thandle;
    drawtreeviewthread: TDrawTreeview;

    procedure drawtreeviewdone(var message: tmessage); message wm_drawtreeviewdone;
    procedure drawtreeviewAddToList(var message: tmessage); message wm_drawtreeviewAddToList;

    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 }
    pointerlist: tmemorystream;
    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;

implementation

{$R *.dfm}

uses settings;

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;

procedure TDrawTreeview.done;
begin
  if frmpointerscanner<>nil then
  begin
    frmpointerscanner.treeview2.Items.EndUpdate;
    frmpointerscanner.progressbar1.position:=0;
    frmpointerscanner.file1.Enabled:=true;
    frmpointerscanner.Pointerscanner1.Enabled:=true;
  end;
end;

procedure TDrawtreeView.AddToList;
var y: ttreenode;
    i,j: integer;
begin
  y:=treeview.Items.Add(nil,st+inttohex(offset,8));

  for j:=0 to offsetsize-1 do
    treeview.Items.AddChild(y,inttohex(offsetlist[j],1));
end;

procedure TDrawTreeview.execute;
var total: integer;
    s: pchar;
    ssize: dword;
    stringlength: dword;
begin
//frmpointerscanner can nevr be closed while this routine is running. See the onclose event for why

  try
    pointerlist.Seek(0,sofrombeginning);

    treeview.items.clear;
    total:=0;
    setlength(offsetlist,10);

    getmem(s,100);
    ssize:=100;

    progressbar.Position:=0;
    progressbar.Max:=pointerlist.Size;

    try
      while (not terminated) and (frmpointerscanner.pointerlist.Position<>pointerlist.Size) do
      begin
        pointerlist.ReadBuffer(stringlength,sizeof(stringlength));
        if ssize<=stringlength then
        begin
          freemem(s);
          getmem(s,stringlength+1);
          ssize:=stringlength+1;
        end;

        pointerlist.ReadBuffer(s^,stringlength);
        s[stringlength]:=#0;
        st:=s;

        pointerlist.readbuffer(offset,sizeof(offset));

        pointerlist.ReadBuffer(offsetsize,sizeof(offsetsize));
        if length(offsetlist)<(offsetsize) then
          setlength(offsetlist,offsetsize*2);
        pointerlist.ReadBuffer(offsetlist[0],(offsetsize)*sizeof(offsetlist[0]));

        if st<>'' then st:=st+'+';

        if not terminated then
          sendmessage(frmpointerscanner.Handle,wm_drawtreeviewAddToList,0,0);

        inc(total);

        if (total mod 50)=0 then
          progressbar.Position:=pointerlist.Position;
      end;
    except
      //done, eof
    end;

    pointersfound:=total;
    
  finally
    freemem(s);
  end;

  if not terminated then
    sendmessage(frmpointerscanner.Handle,wm_drawtreeviewdone,0,0);
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;