memorytrainerunit.pas.svn-base

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

unit MemoryTrainerUnit;

interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,settingsunit,tlhelp32,shellapi,math,extratrainercomponents,
  userdefinedformunit, XPMan,newkernelhandler, symbolhandler,frmautoinjectunit,
  cefuncproc,autoassembler,hotkeyhandler;



type TBytes= array of integer;

type TcodeEntry = record
  address: dword;
  modulename: string;
  moduleoffset: dword;
  originalopcode: array of byte;
end;

type TCEPointer=record
  Address: Dword;  //only used when last pointer in list
  interpretableaddress: string;
  offset: integer;
end;

type TAddressEntry = record
  address: dword;
  interpretableaddress: string;
  ispointer: boolean;
  pointers: array of TCEPointer;
  bit: byte;
  memtyp: integer;
  frozen: boolean;
  frozendirection: byte;
  setvalue: boolean;
  userinput: boolean;
  value: string;

  valuei: int64;
  valuef: double;
  valuea: array of byte;
  valuelength: integer;

  autoassemblescript: string;
  allocs: TCEAllocArray;
end;

type Ttrainerdata = record
  description: string;
  hotkeytext: string;
  hotkey: TKeyCombo;
  active: boolean;
  codeentrys: array of TCodeEntry;
  addressentrys: array of TAddressEntry;
end;


type
  TfrmMemoryTrainer = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    ScrollBox1: TScrollBox;
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;
    Image1: TImage;
    btnLaunch: TButton;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    Freezer: TTimer;
    Button2: TButton;
    XPManifest1: TXPManifest;
    Button3: TButton;
    Timer2: TTimer;
    Timer3: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnLaunchClick(Sender: TObject);
    procedure FreezerTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure CheatClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }

    reinitializedesired: boolean;

    procedure redefinecodeentries;
    procedure reinterpretaddresses;
    
    procedure hotkeyhandler(var Message: TWMHotKey); message WM_HOTKEY2;
    procedure checkforprocess;
    procedure executecheat(sender: tobject);
  public
    { Public declarations }
    filename,process: string;
    autolaunch:boolean;

    aboutboxtext: string;
    viewdefault: boolean;
    trainerdata: array of TTrainerdata;
    clist: tcheatlist;
  end;



type TSetColorThread = class(TThread)
  private
    recordnr: integer;
    procedure setcolor;
  public

    Constructor MyCreate(recnr: integer);
    procedure Execute; override;
  end;



var
  frmMemoryTrainer: TfrmMemoryTrainer;

implementation

{$R *.DFM}

function StrToFloat(const S: string): Extended;
begin
  //gets rid of international confusion

  DecimalSeparator:='.';
  try
    result:=sysutils.StrToFloat(s);
  except
    DecimalSeparator:=',';
    result:=sysutils.StrToFloat(s);
  end;
end;

function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;  nSize: DWORD; var lpNumberOfBytesRead: DWORD): BOOL; stdcall;
var c: _context;
    y: ^byte;
begin
  if protect then
  begin
    c.ContextFlags:=CONTEXT_FULL or CONTEXT_FLOATING_POINT or CONTEXT_DEBUG_REGISTERS;
    getthreadcontext(getcurrentthread,c);
    if (c.dr6<>0) or (c.dr7<>0) then exit;

    y:=@newkernelhandler.readprocessMemory;
    if y^=$cc then exit;

    if dword(@newkernelhandler.ReadProcessMemory)>dword(WindowsKernel) then
      newkernelhandler.ReadProcessMemory(hProcess,lpBaseAddress,lpBuffer,nSize, lpNumberOfBytesRead);
  end
  else
    newkernelhandler.ReadProcessMemory(hProcess,lpBaseAddress,lpBuffer,nSize, lpNumberOfBytesRead);
end;

function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; stdcall;
var c: _context;
    y: ^byte;
begin
  if protect then
  begin
    c.ContextFlags:=CONTEXT_FULL or CONTEXT_FLOATING_POINT or CONTEXT_DEBUG_REGISTERS;
    getthreadcontext(getcurrentthread,c);
    if (c.dr6<>0) or (c.dr7<>0) then exit;

    y:=@newkernelhandler.writeprocessMemory;
    if y^=$cc then exit;


    if dword(@newkernelhandler.writeprocessMemory)>dword(WindowsKernel) then
      newkernelhandler.writeprocessMemory(hProcess,lpBaseAddress,lpBuffer,nSize, lpNumberOfBytesWritten);
  end
  else
    newkernelhandler.writeprocessMemory(hProcess,lpBaseAddress,lpBuffer,nSize, lpNumberOfBytesWritten);
end;

procedure setbit(bitnr: integer; var bt: Byte;state:integer);
{
 pre: bitnr=bit between 0 and 7
         bt=pointer to the byte
 post: bt has the bit set specified in state
 result: bt has a bit set or unset
}
begin
  if state=1 then
    bt:=bt or trunc(power(2,bitnr))  //set that bit to 1
  else
    bt:=bt and ($ff xor trunc(power(2,bitnr))); //set the bit to 0
end;

function getbit(bitnr: integer; bt: Byte):integer;
begin
  if (trunc(power(2,bitnr)) and bt)>0 then result:=1 else result:=0;
end;



constructor TSetColorThread.MyCreate(recnr: integer);
begin
  recordnr:=recnr;
  inherited create(false);
end;

procedure TSetColorThread.setcolor;
var i: integer;
begin
  if userdefinedform<>nil then
  begin
    for i:=0 to length(userdefinedform.cheat)-1 do
      if userdefinedform.cheat[i].cheatnr=recordnr then
        userdefinedform.cheat[i].activated:=frmMemoryTrainer.trainerdata[recordnr].active;

    for i:=0 to length(userdefinedform.cheatlist)-1 do
      userdefinedform.cheatlist[i].Items[recordnr].activated:=frmMemoryTrainer.trainerdata[recordnr].active;

  end;
  frmMemoryTrainer.clist.Items[recordnr].activated:=frmMemoryTrainer.trainerdata[recordnr].active;
end;

procedure TSetColorThread.Execute;
begin
  FreeOnTerminate:=true;
  sleep(500);
  synchronize(setcolor);
end;

//copy/paste from the ce source
procedure ConvertStringToBytes(scanvalue:string; hex:boolean;var bytes: TBytes);
var i,j,k: integer;
    helpstr:string;
begin
  while scanvalue[length(scanvalue)]=' ' do
    scanvalue:=copy(scanvalue,1,length(scanvalue)-1);

  if (pos('-',scanvalue)>0) or (pos(' ',scanvalue)>0) then
  begin
    //syntax is xx-xx-xx or xx xx xx
    j:=1;
    k:=0;
    scanvalue:=scanvalue+' ';

    for i:=1 to length(scanvalue) do
    begin
      if (scanvalue[i]=' ') or (scanvalue[i]='-') then
      begin
        helpstr:=copy(scanvalue,j,i-j);
        j:=i+1;
        setlength(bytes,k+1);
        try
          if hex then bytes[k]:=strtoint64('$'+helpstr)
                 else bytes[k]:=strtoint64(helpstr);
        except
          bytes[k]:=-1;
          //if it is not a '-' or ' ' or a valid value then I assume it is a wildcard.(
        end;
        inc(k);
      end;
    end;
  end else
  begin
    //syntax is xxxxxx
    k:=0;
    j:=1;
    for i:=1 to length(scanvalue) do
    begin
      if (i mod 2)=0 then
      begin
        helpstr:=copy(scanvalue,j,i-j+1);
        j:=i+1;
        setlength(bytes,k+1);
        try
          bytes[k]:=strtoint64('$'+helpstr);
        except
          bytes[k]:=-1;
        end;
        inc(k);
      end;
    end;
  end;
end;

procedure TFrmMemoryTrainer.reinterpretaddresses;
var i,j: integer;
begin
  reinitializedesired:=false;
  for i:=0 to length(trainerdata)-1 do
  begin
    for j:=0 to length(trainerdata[i].addressentrys)-1 do
    begin
      if trainerdata[i].addressentrys[j].interpretableaddress<>'' then
      begin
        try
          trainerdata[i].addressentrys[j].address:=symhandler.getAddressFromName(trainerdata[i].addressentrys[j].interpretableaddress);
        except
          reinitializedesired:=true;
        end;
      end;
    end;
  end;
  {

  //update reinterpetable addresses
  for i:=0 to numberofrecords-1 do
  begin
    if memrec[i].interpretableaddress<>'' then
    begin
      try
        memrec[i].address:=symhandler.getAddressFromName(memrec[i].interpretableaddress,false); //don't wait for symbols here
      except

      end;
    end;

    if memrec[i].IsPointer and (memrec[i].pointers[length(memrec[i].pointers)-1].interpretableaddress<>'') then
      memrec[i].pointers[length(memrec[i].pointers)-1].Address:=symhandler.getAddressFromName(memrec[i].pointers[length(memrec[i].pointers)-1].interpretableaddress,false);
  end; }
end;

procedure TFrmMemoryTrainer.redefinecodeentries;
var i,j: integer;
begin
  symhandler.loadmodulelist;

  for i:=0 to length(trainerdata)-1 do
  begin
    for j:=0 to length(trainerdata[i].codeentrys)-1 do
    begin
      if trainerdata[i].codeentrys[j].modulename<>'' then //make sure a modulename was filled in otherwise keep the old address
        trainerdata[i].codeentrys[j].address:=symhandler.getaddressfromname(trainerdata[i].codeentrys[j].modulename)+trainerdata[i].codeentrys[j].moduleoffset
    end;
  end;
end;

procedure TFrmMemoryTrainer.checkforprocess;
Var SNAPHandle: THandle;
    ProcessEntry: ProcessEntry32;
    Check: Boolean;
    FullProcessName,ProcessName: String;
    I: Integer;
begin
  SNAPHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  If SnapHandle>0 then
  begin
    ProcessEntry.dwSize:=SizeOf(ProcessEntry);
    Check:=Process32First(SnapHandle,ProcessEntry);
    while check=true do
    begin
      ProcessName:='';
      FullProcessName:='';
      FullProcessName:=processentry.szExeFile;
      i:=Length(FullProcessName);
      while (i>0) and (FullProcessname[i-1]<>'\') do dec(i);
      processname:=copy(FullProcessName,i,length(FullProcessname)-i+1);

      if uppercase(processname)=uppercase(process) then
      begin
        ProcessID:=ProcessEntry.th32ProcessID;
        btnLaunch.Enabled:=false;

        if processhandle=0 then
          processhandle:=openprocess(process_all_access,false,processid);

        symhandler.showmodules:=true;
        symhandler.showsymbols:=true;
        symhandler.reinitialize;

        reinterpretaddresses;        
        exit;
      end;

      check:=Process32Next(SnapHandle,ProcessEntry);
    end;
  end;

  if processhandle<>0 then closehandle(processhandle);
  processhandle:=0;
  btnLaunch.Enabled:=true;