advancedoptionsunit.pas

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

unit AdvancedOptionsUnit;

interface

uses
  symbolhandler,tlhelp32,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,debugger, Menus,cefuncproc, ExtCtrls,disassembler,
  SyncObjs,registry, ComCtrls{$ifdef net},netapis{$else},newkernelhandler{$endif};



type
  TAdvancedOptions = class(TForm)
    PopupMenu2: TPopupMenu;
    CC1: TMenuItem;
    CC2: TMenuItem;
    Remove1: TMenuItem;
    Rename1: TMenuItem;
    Findoutwhatthiscodechanges1: TMenuItem;
    Openthedisassemblerhere1: TMenuItem;
    codelist: TListBox;
    Findthiscodeinsideabinaryfile1: TMenuItem;
    OpenDialog1: TOpenDialog;
    N1: TMenuItem;
    N2: TMenuItem;
    SaveDialog1: TSaveDialog;
    Replaceall1: TMenuItem;
    Timer1: TTimer;
    Panel1: TPanel;
    Button1: TButton;
    Button4: TButton;
    Button2: TButton;
    Panel2: TPanel;
    Pausebutton: TSpeedButton;
    SaveButton: TSpeedButton;
    Label1: TLabel;
    procedure codelistDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormShow(Sender: TObject);
    procedure PopupMenu2Popup(Sender: TObject);
    procedure CC2Click(Sender: TObject);
    procedure CC1Click(Sender: TObject);
    procedure Remove1Click(Sender: TObject);
    procedure Findoutwhatthiscodechanges1Click(Sender: TObject);
    procedure Rename1Click(Sender: TObject);
    procedure Openthedisassemblerhere1Click(Sender: TObject);
    procedure Findthiscodeinsideabinaryfile1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
    procedure PausebuttonClick(Sender: TObject);
    procedure PausebuttonMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure codelistMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Replaceall1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure codelistKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    plabel:string;

    red: boolean;

    procedure hotkey(var Message: TMessage); message WM_HOTKEY;
  public
    { Public declarations }
    pausehotkeystring: string;
    pausedbyhotkey: boolean;

    reader: boolean;
    numberofcodes: integer;
    code: array of record
            before: array of byte;
            actualopcode: array of byte;
            after: array of byte;
            changed:boolean;
            modulename: string;
            offset: dword;
            Address: dword; //in case module offsets dont work
          end;

    function AddToCodeList(address: Dword; sizeofopcode: integer; changed:boolean):boolean;
    procedure UpdateAdvancedOptions;
  end;

procedure unpause;

var
  AdvancedOptions: TAdvancedOptions;

resourcestring
  strnotreadable='This address is not readable';
  strNotWhatitshouldbe='The memory at this address is''nt what it should be! Continue?';

implementation

uses {$ifdef net}ceclient,unit2{$else}MainUnit{$endif},
  inputboxtopunit,
  {$ifndef net}
  formChangedAddresses,
  formhotkeyunit,
  frmDissectwindowUnit,
  frmCapturedTimersUnit,
  frmDirectXUnit,
//  frmOpenglUnit,
  {$endif}
  MemoryBrowserFormUnit,
  frmFindCodeInFileUnit,
  standaloneunit,
  formsettingsunit,
  mainunit2;



{$R *.dfm}

procedure unpause;
begin
  if advancedoptions.Pausebutton.Down then
  begin
    advancedoptions.Pausebutton.Down:=false;
    advancedoptions.Pausebutton.Click;
  end;
end;


procedure TAdvancedOptions.hotkey(var Message: TMessage);
begin
  if Message.wparam=0 then  //pause
  begin
    pausebutton.down:=not pausebutton.down;
    pausebutton.Click;
  end;
end;

procedure TadvancedOptions.UpdateAdvancedOptions;
begin

end;


function TAdvancedOptions.AddToCodeList(address: dword; sizeofopcode: integer;changed: boolean):boolean;
resourcestring
  stralreadyinthelist = 'This byte is already part of another opcode already present in the list';
  strPartOfOpcodeInTheList='At least one of these bytes is already in the list';
  strAddressAlreadyInTheList='This address is already in the list';
  strCECode='Cheat Engine code:';
  strNameCECode='What name do you want to give this code?';
  strChangeOf='Change of ';
  strCode='Code :';
var i: integer;
    bread: dword;
    toread,toread2: dword;
    backupbytes: array[0..4] of byte;
    ignore: string;
    address2:dword;

    starta,stopa,startb,stopb: dword;
    modulename,modulebaseaddress:dword;

    ths: thandle;
    me32:MODULEENTRY32;
    x: pchar;
begin
  //check if the address is already in the list
  for i:=0 to numberofcodes-1 do
  begin
    if (code[i].Address=address) then raise exception.create(strAddressAlreadyInTheList);

    //I want to see if address to address+sizeofopcode-1 is overlapping with addresses[i] to length(actualopcode[i])-1
    starta:=code[i].Address;
    stopa:=code[i].Address+length(code[i].actualopcode)-1;

    startb:=address;
    stopb:=address+sizeofopcode-1;

    if ((starta>startb) and (starta<stopb)) or
       ((startb>starta) and (startb<stopa)) then
      if sizeofopcode=1 then
        raise exception.Create(stralreadyinthelist)
      else
        raise exception.Create(strPartOfOpcodeInTheList);

  end;


  address2:=address;

  inputboxtop:=TInputboxtop.Create(self);
  inputboxtop.cpt:=strCECode;
  inputboxtop.question:=strNameCECode;
  if changed then inputboxtop.default:=strChangeOf+disassemble(address2,ignore)
             else inputboxtop.default:=strCode+disassemble(address2,ignore);
  inputboxtop.position:=poScreenCenter;
  result:=inputboxtop.showmodal=mrok;

  if not result then exit;


  if inputboxtop.default='' then
    codelist.items.add(strNoDescription) else
    codelist.Items.Add(inputboxtop.default);

  inputboxtop.Free;

  inc(numberofcodes);
  setlength(advancedoptions.code,numberofcodes);

  //before
  bread:=0;
  toread:=5;
  toread2:=5;
  while bread<toread do
  begin
    toread:=toread2;
    readprocessmemory(processhandle,pointer(address-5+(5-toread)),addr(backupbytes[0]),toread,bread);
    if bread=toread then
    begin

      setlength(AdvancedOptions.code[numberofcodes-1].before,toread);
      for i:=0 to toread-1 do AdvancedOptions.code[numberofcodes-1].before[i]:=backupbytes[i];
    end;
    dec(toread2);
  end;

  //actualopcode

  setlength(AdvancedOptions.code[numberofcodes-1].actualopcode,sizeofopcode);
  readprocessmemory(processhandle,pointer(address),addr(AdvancedOptions.code[numberofcodes-1].actualopcode[0]),sizeofopcode,bread);

  //after
  readprocessmemory(processhandle,pointer(address+sizeofopcode),@backupbytes[0],5,bread);

  setlength(AdvancedOptions.code[numberofcodes-1].after,bread);
  for i:=0 to bread-1 do AdvancedOptions.code[numberofcodes-1].after[i]:=backupbytes[i];

  code[numberofcodes-1].changed:=changed;
  code[numberofcodes-1].Address:=address;
  code[numberofcodes-1].modulename:='';
  code[numberofcodes-1].offset:=0;

  //get the module this code is in
  ths:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,processid);
  me32.dwSize:=sizeof(MODULEENTRY32);
  if ths<>0 then
  begin
    try
      if module32first(ths,me32) then
      repeat
        if (address>=dword(me32.modBaseAddr)) and (address<dword(me32.modBaseAddr)+me32.modBaseSize) then
        begin
          x:=me32.szExePath;
          code[numberofcodes-1].modulename:=extractfilename(x);
          code[numberofcodes-1].offset:=address-dword(me32.modBaseAddr);
          break;
        end;
      until not module32next(ths,me32);
    finally
      closehandle(ths);
    end;
  end;
end;


procedure TAdvancedOptions.codelistDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{copy/paste from example in help}
var
  Bitmap: TBitmap;      { temporary variable for the item抯 bitmap }
  Offset: Integer;      { text offset width }
  origcolor: tcolor;
begin
  origcolor:=clBlack;

  with codelist.Canvas do  { draw on control canvas, not on the form }
  begin
    FillRect(Rect);       { clear the rectangle }
    Offset := 2;          { provide default offset }
    Bitmap := TBitmap(codelist.Items.Objects[Index]); { get the bitmap }
    if Bitmap <> nil then
    begin
      Draw(Rect.Left + Offset, Rect.Top, Bitmap); {render bitmap}
      Offset := Bitmap.width + 6;    { add four pixels between bitmap and text}
    end;

    if (code[index].changed) then
    begin
      origcolor:=font.color;
      font.Color:=clRed;
    end;
    TextOut(Rect.Left + Offset, Rect.Top, codelist.Items[Index]);  { display the text }

    if (code[index].changed) then font.color:=origcolor;
  end;
end;

procedure TAdvancedOptions.FormShow(Sender: TObject);
begin

  UpdateAdvancedOptions;
end;

procedure TAdvancedOptions.PopupMenu2Popup(Sender: TObject);
var offset: dword;
    opcode,desc: string;
    fb,nb: integer;
    seperator: integer;

    mi: tmoduleinfo;
resourcestring
  strFindWhatCodeaccesses='Find out what addresses this code accesses';
  strFindWhatCodeReads='Find out what addresses this code reads from';
  strFindWhatCodeWrites='Find out what addresses this code writes to';
begin
  if codelist.ItemIndex=-1 then
  begin
    cc1.visible:=false;
    cc2.visible:=false;
    rename1.visible:=false;
    remove1.Visible:=false;
    Openthedisassemblerhere1.Visible:=false;
    Findoutwhatthiscodechanges1.visible:=false;
    Findthiscodeinsideabinaryfile1.Visible:=false;
  end else
  begin
    rename1.visible:=true;
    remove1.visible:=true;

    Openthedisassemblerhere1.visible:=true;
    Findthiscodeinsideabinaryfile1.Visible:=true;

    if code[codelist.itemindex].modulename<>'' then
    begin
      symhandler.getmodulebyname(code[codelist.itemindex].modulename,mi);
      code[codelist.itemindex].Address:=mi.baseaddress+code[codelist.itemindex].offset;
    end;

    if code[codelist.itemindex].changed then
    begin
      cc1.visible:=false;
      cc2.visible:=true;
      Findoutwhatthiscodechanges1.visible:=false;
    end else
    begin
      cc1.visible:=true;
      cc2.visible:=false;

      //disassemble this address, and see if it a writer or reader
      //if neither grey it out
      offset:=code[codelist.itemindex].Address;
      opcode:=disassemble(offset,desc);

      Findoutwhatthiscodechanges1.Caption:=strFindWhatCodeAccesses;
      Findoutwhatthiscodechanges1.enabled:=false;
      fb:=pos('[',opcode);
      if fb>0 then
      begin
        nb:=pos(']',opcode);
        if nb>fb then //just a simple check to verify the opcode is ok
        begin
          seperator:=pos(',',opcode);
          if seperator>-1 then
          begin
            if seperator<fb then //reader
            begin
              reader:=true;
              FindOutWhatThisCodeChanges1.caption:=strFindWhatCodeReads
            end
            else
            begin
              reader:=false;
              FindOutWhatThisCodeChanges1.caption:=strfindwhatcodewrites;
            end;


            Findoutwhatthiscodechanges1.enabled:=true;
          end;
        end;
      end;


      Findoutwhatthiscodechanges1.visible:=true;
    end;
  end;

  {$ifdef net}
  Findoutwhatthiscodechanges1.Visible:=false;


  {$endif}

end;

procedure TAdvancedOptions.CC2Click(Sender: TObject);
var i: integer;
    a,original,written: dword;
    lengthactualopcode: dword;
    temp: array of byte;
    temp2: array of byte;

resourcestring strcouldntrestorecode='Error when trying to restore this code!';
               strnotthesame='The memory at this address isn''t what it should be! Continue?';
begin
  i:=codelist.ItemIndex;

  lengthactualopcode:=length(code[i].actualopcode);
  //read the current list, if it isnt a NOP or the actualopcode give a warning
  setlength(temp,lengthactualopcode);
  setlength(temp2,lengthactualopcode);
  for i:=0 to lengthactualopcode-1 do
    temp[i]:=$90;

  i:=codelist.itemindex;
  readprocessmemory(processhandle,pointer(code[i].Address),@temp2[0],lengthactualopcode,original);
  if original<>lengthactualopcode then
    raise exception.Create(strNotReadable);

  //check if it is a nop field
  if not comparemem(@temp[0],@temp2[0],lengthactualopcode) then
  begin
    //NO????????

    //then check if it is the actual opcode, and there was a bug
    if not comparemem(@temp[0],@code[i].actualopcode[0],lengthactualopcode) then
    begin
      //It's also not the original opcode? WTF, This dude must be braindeath...
      if messagedlg(strnotthesame,mtWarning,[mbyes,mbno],0)=mrno then exit;
    end
    else
    begin
      code[i].changed:=false;
      codelist.Repaint;
      exit;
    end;
  end;


  //set to read and write
  VirtualProtectEx(processhandle,pointer(code[i].Address),length(code[i].actualopcode),PAGE_EXECUTE_READWRITE,original);  //I want to execute this, read it and write it. (so, full access)

  //write
  writeprocessmemory(processhandle,pointer(code[i].Address),@code[i].actualopcode[0],length(code[i].actualopcode),written);
  if written<>lengthactualopcode then
  begin
    messagedlg(strCouldntrestorecode,mtWarning,[MBok],0);
    VirtualProtectEx(processhandle,pointer(code[i].Address),lengthactualopcode,original,a);  //ignore a
    exit;
  end;

  //set back
  VirtualProtectEx(processhandle,pointer(code[i].Address),lengthactualopcode,original,a);  //ignore a
  FlushInstructionCache(processhandle,pointer(code[i].Address),lengthactualopcode);

  code[i].changed:=false;

  codelist.Repaint;

end;

procedure TAdvancedOptions.CC1Click(Sender: TObject);
var codelength: integer;
    written: dword;
    i,index: integer;
    nops: array of byte;
    a,b: dword;
    original: dword;
resourcestring strcouldntwrite='The memory at this address couldn''t be written';