advancedoptionsunit.pas.svn-base

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

  index:=codelist.itemindex;
  a:=code[index].Address;
  codelength:=length(code[index].actualopcode);

  //read the opcode currently at the address
  setlength(nops,codelength);
  readprocessmemory(processhandle,pointer(a),@nops[0],codelength,b);
  if b<>dword(codelength) then
    raise exception.Create(strNotReadable);

  //compare it with what is in the actualopcode array
  if not comparemem(@nops[0],@code[index].actualopcode[0],codelength) then
    if messagedlg(strNotWhatitshouldbe,mtWarning,[mbyes,mbno],0)=mrno then exit;



  for i:=0 to codelength-1 do
    nops[i]:=$90;  //$90=nop

 // get old security and set new security
  VirtualProtectEx(processhandle,pointer(a),codelength,PAGE_EXECUTE_READWRITE,original);  //I want to execute this, read it and write it. (so, full access)

  writeprocessmemory(processhandle,pointer(a),@nops[0],codelength,written);
  if written<>dword(codelength) then
  begin
    messagedlg(strcouldntwrite,mtError,[mbok],0);
    exit;
  end;


  //set old security back
  VirtualProtectEx(processhandle,pointer(a),codelength,original,a);  //ignore a

  FlushInstructionCache(processhandle,pointer(a),codelength);

  code[index].changed:=true;
  codelist.Repaint;
end;

procedure TAdvancedOptions.Remove1Click(Sender: TObject);
var i,index: integer;
begin

  index:=codelist.ItemIndex;
  if messagedlg('Delete '+codelist.Items[index]+' ?',mtConfirmation,[mbyes,mbno],0) = mrno then exit;


  setlength(code[index].before,0);
  setlength(code[index].actualopcode,0);
  setlength(code[index].after,0);

  for i:=index to numberofcodes-2 do
  begin
    code[i].before:=code[i+1].before;
    code[i].actualopcode:=code[i+1].actualopcode;
    code[i].after:=code[i+1].after;
    code[i].Address:=code[i+1].Address;
    code[i].changed:=code[i+1].changed;
    code[i].modulename:=code[i+1].modulename;
    code[i].offset:=code[i+1].offset;
  end;

  dec(numberofcodes);
  setlength(code,numberofcodes);  

  codelist.Items.Delete(index);
end;

procedure TAdvancedOptions.Findoutwhatthiscodechanges1Click(
  Sender: TObject);
{var temp: dword;
    int3: byte;
    original: dword;}
var i: integer;
begin
{$ifndef net}
  //New method:
  if not startdebuggerifneeded then exit;
  if debuggerthread.userisdebugging then raise exception.create('You can''t use this function while you are debugging the application yourself. (Close the memory view window)');

  frmChangedAddresses:=TfrmChangedAddresses.Create(self);
  debuggerthread.Suspend;

  debuggerthread.DRRegs.ContextFlags:=CONTEXT_DEBUG_REGISTERS;
  debuggerthread.DRRegs.Dr0:=code[codelist.ItemIndex].Address;
  debuggerthread.DRRegs.Dr7:=reg0set or reg1set or reg2set or reg3set;

  for i:=0 to length(debuggerthread.threadlist)-1 do
  begin
    suspendthread(debuggerthread.threadlist[i][1]);
    if not setthreadcontext(debuggerthread.threadlist[i][1],debuggerthread.DRRegs) then showmessage('failed 1');
    resumethread(debuggerthread.threadlist[i][1]);
  end;


  debuggerthread.breakpointaddress:=code[codelist.ItemIndex].Address;
  debuggerthread.breakpointset:=true;

  debuggerthread.Resume;
  frmChangedAddresses.showmodal;

  {$endif}
end;

procedure TAdvancedOptions.Rename1Click(Sender: TObject);
var index: integer;
begin
  index:=codelist.ItemIndex;
  codelist.Items[index]:=inputbox('New name','Give the new name of this entry',codelist.Items[index]);
end;

procedure TAdvancedOptions.Openthedisassemblerhere1Click(Sender: TObject);
begin
  memorybrowser.Disassembleraddress:=code[codelist.itemindex].Address;
  if memorybrowser.Height<(memorybrowser.Panel1.Height+100) then memorybrowser.height:=memorybrowser.Panel1.Height+100;
  memorybrowser.panel1.visible:=true;
  memorybrowser.show;
end;

procedure TAdvancedOptions.Findthiscodeinsideabinaryfile1Click(
  Sender: TObject);
begin
  formFindCodeInFile:=TformFindCodeInFile.create(self);
  if formFindcodeInfile.ok then formFindCodeInFile.showmodal;
end;

procedure TAdvancedOptions.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TAdvancedOptions.SaveButtonClick(Sender: TObject);
begin
  StandAlone.filename:=SaveDialog1.filename;
  standAlone.showmodal;
end;

procedure TAdvancedOptions.PausebuttonClick(Sender: TObject);
var i: integer;
    ct: _Context;
begin
  {$ifndef net}

  if hypermode<>nil then
  begin
    pausebutton.down:=not pausebutton.down;
    exit;
  end;

  if processhandle=0 then
  begin
    pausebutton.down:=false;
    exit;
  end;


  if pausebutton.down then
  begin
    if processid=getcurrentprocessid then
    begin
      pausebutton.down:=false;
      exit;
    end;


    if (debuggerthread=nil) and (@ntsuspendprocess<>nil) then
    begin
      if ntsuspendprocess(processhandle)<>0 then //failed somehow, try the debugger from now on
      begin
        @ntsuspendprocess:=nil;
        pausebuttonclick(sender);
        exit;
      end;
    end
    else
    begin
      if not startdebuggerifneeded(not pausedbyhotkey) then
      begin
        pausebutton.Down:=false;
        exit;
      end;



      debuggerthread.Suspend;
      for i:=0 to length(debuggerthread.threadlist)-1 do
        suspendthread(debuggerthread.threadlist[i][1]);
    end;
    pausebutton.Hint:='Resume the game'+pausehotkeystring;
    pausebutton.down:=true;

    red:=false;
    mainform.ProcessLabel.font.Color:=clred;

    plabel:=mainform.ProcessLabel.Caption;
    mainform.ProcessLabel.Caption:=mainform.ProcessLabel.Caption+' (paused)';
    timer1.Enabled:=true;
  end
  else
  begin
    //resume
    if (debuggerthread=nil) and (@ntresumeprocess<>nil) then
    begin
      ntresumeprocess(processhandle);
    end
    else
    begin
      for i:=length(debuggerthread.threadlist)-1 downto 0 do
        resumethread(debuggerthread.threadlist[i][1]);

      debuggerthread.Resume;
    end;

    pausebutton.Hint:='Pause the game'+pausehotkeystring;

    timer1.Enabled:=false;
    mainform.ProcessLabel.Font.Color:=clMenuText;
    mainform.ProcessLabel.Caption:=plabel;


    pausebutton.Down:=false;
  end;

  {$else}
  //network version
  if pausebutton.down then
  begin
    if not startdebuggerifneeded then
    begin
      pausebutton.Down:=false;
      exit;
    end;

    output[0]:=CS_SuspenProcess;
    sendbuf(1);
    pausebutton.Hint:='Resume the game'+pausehotkeystring;
    pausebutton.down:=true;
  end
  else
  begin
    output[0]:=CS_ResumeProcess;
    sendbuf(1);
    pausebutton.Hint:='Pause the game';
    pausebutton.Down:=false;
  end;
{$endif}
end;

procedure TAdvancedOptions.PausebuttonMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if pausebutton.Down then
    pausebutton.hint:='Resume the game'+pausehotkeystring
  else
    pausebutton.hint:='Pause the game'+pausehotkeystring;
end;

procedure TAdvancedOptions.codelistMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var tp: tpoint;
begin
  tp.x:=x;
  tp.y:=y;
  if codelist.ItemAtPos(tp,true)<>-1 then codelist.ItemIndex:=codelist.ItemAtPos(tp,true);
end;

procedure TAdvancedOptions.Replaceall1Click(Sender: TObject);
var codelength: integer;
    written: dword;
    j,i,index: integer;
    nops: array of byte;
    a,b: dword;
    original: dword;
begin
  //search dselected in the addresslist
  for j:=0 to codelist.Items.Count-1 do
  begin
    index:=j;
    if code[index].changed then continue;

    a:=code[index].Address;
    codelength:=length(code[index].actualopcode);

    //read the opcode currently at the address
    setlength(nops,codelength);
    readprocessmemory(processhandle,pointer(a),@nops[0],codelength,b);
    if b<>dword(codelength) then
      raise exception.Create(strNotReadable);

    //compare it with what is in the actualopcode array
    if not comparemem(@nops[0],@code[index].actualopcode[0],codelength) then
      if messagedlg(strNotWhatitshouldbe,mtWarning,[mbyes,mbno],0)=mrno then exit;

    //-------



    for i:=0 to codelength-1 do
      nops[i]:=$90;  //$90=nop

   // get old security and set new security
    VirtualProtectEx(processhandle,pointer(a),codelength,PAGE_EXECUTE_READWRITE,original);  //I want to execute this, read it and write it. (so, full access)

    writeprocessmemory(processhandle,pointer(a),@nops[0],codelength,written);
    if written<>dword(codelength) then
    begin
      messagedlg('The memory at this address couldn''t be written',mtError,[mbok],0);
      exit;
    end;


    //set old security back
    VirtualProtectEx(processhandle,pointer(a),codelength,original,a);  //ignore a

    FlushInstructionCache(processhandle,pointer(a),codelength);

    code[index].changed:=true;
  end;
  codelist.Repaint;
end;

procedure TAdvancedOptions.Timer1Timer(Sender: TObject);
begin
  if red then
  begin
    mainform.ProcessLabel.Font.Color:=clred;
    red:=false;
  end
  else
  begin
    mainform.ProcessLabel.Font.Color:=clGreen;
    reD:=true;
  end;
end;

procedure TAdvancedOptions.Button4Click(Sender: TObject);
var i:integer;
    fname,expectedFilename: string;
    oldtitle: string;
resourcestring StrSelectExeFor3D='Select the executable of the Direct-3D game';
begin
  {$ifndef net}
  oldtitle:=opendialog1.Title;
  opendialog1.Title:=StrSelectExeFor3D;

  if Opendialog1.Execute then
  begin
    hyperscanview.HookDirect3d:=true;
    hyperscanview.asktocontinue:=true;

    KeysFileMapping:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,sizeof(tkeys),'CEKEYS');
    if KeysFileMapping=0 then
      raise exception.Create('Error while trying to create the shared key structure! (Which efficiently renders this whole feature useless)');

    keys:=MapViewOfFile(KeysFileMapping,FILE_MAP_ALL_ACCESS,0,0,0);
    if keys=nil then
    begin
      closehandle(KeysFileMapping);
      raise exception.Create('Cheat Engine failed to get into the config of the selected program.');
    end;

    keys.configured:=false;


    HyperscanView.HookDirect3d:=true;
    HyperscanView.HookOpenGL:=false;


    unpause;
    detachIfPossible;
    if Uppercase(extractfileext(opendialog1.FileName))<>'.EXE' then raise Exception.Create('You can only load EXE files');

    Debuggerthread:=TDebugger.MyCreate(opendialog1.FileName);

    while (debuggerthread<>nil) and (debuggerthread.attaching) do sleep(1);

    mainForm.ProcessLabel.caption:=IntToHex(processid,8)+'-'+ExtractFileName(opendialog1.FileName);


    mainform.debugproc:=true;

    if formsettings.cbBreakOnAttach.checked then
      memorybrowser.show;

    mainform.enablegui(false);

    with TFrmDirectx.Create(self) do show;
  end;

  opendialog1.title:=oldtitle;
  {$endif}
end;

procedure TAdvancedOptions.FormCreate(Sender: TObject);
begin
  {$ifdef net}
  button4.Visible:=false;
  savebutton.Visible:=false;
  pausebutton.Left:=savebutton.Left;
  {$endif}
end;

procedure TAdvancedOptions.Button2Click(Sender: TObject);
var i:integer;
    fname,expectedFilename: string;
    oldtitle: string;
resourcestring StrSelectExeForOpenGL3D='Select the executable of the OpenGL game';
begin
  {$ifndef net}
  oldtitle:=opendialog1.Title;
  opendialog1.Title:=StrSelectExeForOpenGL3D;

  if Opendialog1.Execute then
  begin
    hyperscanview.HookDirect3d:=true;
    hyperscanview.asktocontinue:=true;

    KeysFileMapping:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,sizeof(tkeys2),'CEKEYS2');
    if KeysFileMapping=0 then
      raise exception.Create('Error while trying to create the shared key structure! (Which efficiently renders this whole feature useless)');

    keys2:=MapViewOfFile(KeysFileMapping,FILE_MAP_ALL_ACCESS,0,0,0);
    if keys2=nil then
    begin
      closehandle(KeysFileMapping);
      raise exception.Create('Cheat Engine failed to get into the config of the selected program.');
    end;

    keys2.configured:=false;

    HyperscanView.HookDirect3d:=false;
    HyperscanView.HookOpenGL:=true;

    unpause;
    detachIfPossible;
    if Uppercase(extractfileext(opendialog1.FileName))<>'.EXE' then raise Exception.Create('You can only load EXE files');

    Debuggerthread:=TDebugger.MyCreate(opendialog1.FileName);

    while (debuggerthread<>nil) and (debuggerthread.attaching) do sleep(1);

    mainForm.ProcessLabel.caption:=IntToHex(processid,8)+'-'+ExtractFileName(opendialog1.FileName);


    mainform.debugproc:=true;

    if formsettings.cbBreakOnAttach.checked then
      memorybrowser.show;

    mainform.enablegui(false);

//    with TfrmOpenGL.Create(self) do show;
  end;

  opendialog1.title:=oldtitle;
  {$endif}
end;

procedure TAdvancedOptions.Panel1Resize(Sender: TObject);
begin
  button1.Left:=panel1.Width div 2 - button1.width div 2;
end;

procedure TAdvancedOptions.codelistKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_delete then
    Remove1.Click;
end;

end.