memorybrowserformunit.pas

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

  except
    disassembleraddress:=getaddress(newaddress);
  end;

  dselected:=disassembleraddress;
  updatedisassemblerview;
end;

procedure TMemoryBrowser.Search1Click(Sender: TObject);
begin
  {$ifndef net}
  if findwindow=nil then findwindow:=TFindwindow.create(application);
  findwindow.firstscan:=true;
  findwindow.ShowModal;
  {$endif}
end;

procedure TMemoryBrowser.Change1Click(Sender: TObject);
begin
  hexedit.Visible:=false;
  MBCanvasDblClick(MBCanvas);
end;

procedure TMemoryBrowser.Addthisaddresstothelist1Click(Sender: TObject);
var i: integer;
    ad: dword;
begin
//this will add the selected recdord to the list
  if mbcanvas.Cursor=crHandpoint then
  begin
    //selected
    ad:=selected;
    if addform=nil then addform:=Taddform.create(self);
    addform.NewAddress.text:=inttohex(ad,8);
    addform.showmodal;
    //no free because it can be usefull the next time regarding the bits field
  end;
end;

procedure TMemoryBrowser.Addthisopcodetothecodelist1Click(Sender: TObject);
var {start,stop: string;
    a,b: dword;
    i: integer;}
    desc: string;
begin
  frmAddToCodeList:=TfrmAddToCodeList.create(self);
  frmAddToCodeList.addtocodelist:=true;
  frmAddToCodeList.fromaddress:=dselected;
  frmAddToCodeList.toaddress:=dselected;
  disassemble(frmAddToCodeList.toaddress,desc);
  dec(frmAddToCodeList.toaddress);
  frmAddToCodeList.showmodal;
end;

procedure TMemoryBrowser.Splitter1CanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
  if newsize<80 then
  begin
    newsize:=80;
    accept:=false;
  end;

  if newsize>memorybrowser.Height-80 then
  begin
    newsize:=memorybrowser.Height-80;
    accept:=false;
  end;

end;

procedure TMemoryBrowser.Panel4Resize(Sender: TObject);
begin
  mbcanvas.Height:=panel4.Height-2-9;
  mbcanvas.Width:=panel4.Width;

  mbimage.Width:=mbcanvas.Width;
  mbimage.Height:=mbcanvas.Height;
  mbcanvas.Invalidate;
  refreshmb;
end;

procedure TMemoryBrowser.ScrollBar2Scroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
var delta: integer;
begin
  fcontrol2.SetFocus;
  case scrollcode of
    scLineUp:   dec(memoryaddress,8*rows8);
    scLineDown: inc(memoryaddress,8*rows8);
    scPageDown: inc(memoryaddress,8*rows8*((mbcanvas.Height-5) div (TextHeight)-1));
    scPageUp:   dec(memoryaddress,8*rows8*((mbcanvas.Height-5) div (TextHeight)-1));
    sctrack:
    begin
      delta:=scrollpos-50;
      memoryaddress:=memoryaddress+(8*rows8)*delta;
     // if not formsettings.cbKernelReadWriteProcessMemory.checked then memoryaddress:=trunc(scrollpos/10000*$FFFFFFFF);
    end;
  end;

  refreshmb;
  scrollpos:=50;
end;

procedure TMemoryBrowser.Setbreakpoint1Click(Sender: TObject);
begin
{$ifndef net}
  togglebreakpoint(dselected);
  updatedisassemblerview;
{$endif}
end;

procedure TMemoryBrowser.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  {$ifndef net}
  if (debuggerthread<>nil) and (debuggerthread.userisdebugging) then
  begin
    WaitForSingleObject(semaphore,infinite);
    debuggerthread.removebreakpoint;
    releasesemaphore(semaphore,1,nil);

    debuggerthread.DRRegs.Dr0:=0;
    debuggerthread.DRRegs.Dr1:=0;
    debuggerthread.DRRegs.Dr2:=0;
    debuggerthread.DRRegs.Dr3:=0;

    debuggerthread.continuehow:=0;

    setlength(debuggerthread.userbreakpoints,0);
    setlength(debuggerthread.int3userbreakpoints,0);
    debuggerthread.int3CEBreakpoint.address:=0;

    debuggerthread.continueprocess:=true;
    debuggerthread.userisdebugging:=false;
  end;
  {$endif}

end;

procedure TMemoryBrowser.Run1Click(Sender: TObject);
begin
  {$ifndef net}
  if debuggerthread<>nil then
  begin
    debuggerthread.continuehow:=0;   //note: I could also have the debuggerthread suspend itself, and resume it here
    debuggerthread.continueprocess:=true;
    caption:='Memory Viewer - Running';
  end;
  {$endif}
end;

procedure TMemoryBrowser.Step1Click(Sender: TObject);
begin
  {$ifndef net}
  if debuggerthread<>nil then
  begin
    debuggerthread.continuehow:=1; //single step
    debuggerthread.continueprocess:=true;
    caption:='Memory Viewer - Running';
  end;

  {$endif}
end;

procedure TMemoryBrowser.StepOver1Click(Sender: TObject);
var x: dword;
    i: integer;
    temp:string;
    int3: byte;
    original,a,written:dword;
begin
  {$ifndef net}
  int3:=$cc;
  //place a invisble for the user breakpoint on the following upcode

  if debuggerthread<>nil then
  begin
    debuggerthread.continuehow:=0; //step over
    x:=eipv;
    disassemble(x,temp);

    if formsettings.rbDebugAsBreakpoint.checked then
    begin
      debuggerthread.DRRegs.Dr3:=x;

      with debuggerthread do
      for i:=0 to length(threadlist)-1 do
      begin
        suspendthread(debuggerthread.threadlist[i][1]);
        setthreadcontext(debuggerthread.threadlist[i][1],debuggerthread.DRRegs);
        resumethread(debuggerthread.threadlist[i][1]);
      end;
    end else
    begin
      // use the int3CEBreakpoint
      //see if there is already a Breakpoint with this address
      if debuggerthread.int3CEBreakpoint.address>0 then
        RewriteCode(processhandle,debuggerthread.int3CEBreakpoint.address,@debuggerthread.int3CEBreakpoint.originalbyte,1);

      for i:=0 to length(debuggerthread.int3userbreakpoints)-1 do
        if debuggerthread.int3userbreakpoints[i].address=x then
        begin
          //dont need to set a breakpoint
          debuggerthread.continueprocess:=true;
          caption:='Memory Viewer - Running';
          exit;
        end;

      debuggerthread.int3CEBreakpoint.address:=x;
      readprocessmemory(processhandle,pointer(x),@debuggerthread.int3CEBreakpoint.originalbyte,1,written);

      Rewritecode(processhandle,x,@int3,1);
    end;

    debuggerthread.continueprocess:=true;
    caption:='Memory Viewer - Running';
  end;
  {$endif}
end;

procedure TMemoryBrowser.Runtill1Click(Sender: TObject);
var x: dword;
    i: integer;
    temp:string;
    int3: byte;
    original,a,written:dword;
begin
  {$ifndef net}
  int3:=$cc;
  //place a invisble for the user breakpoint on the following upcode

  if debuggerthread<>nil then
  begin
    debuggerthread.continuehow:=0; //step over
    x:=dselected;
    disassemble(x,temp);

    if formsettings.rbDebugAsBreakpoint.checked then
    begin
      debuggerthread.DRRegs.Dr3:=x;

      with debuggerthread do
      for i:=0 to length(threadlist)-1 do
      begin
        suspendthread(debuggerthread.threadlist[i][1]);
        setthreadcontext(debuggerthread.threadlist[i][1],debuggerthread.DRRegs);
        resumethread(debuggerthread.threadlist[i][1]);
      end;
    end else
    begin
      if debuggerthread.int3CEBreakpoint.address>0 then
      begin
        //restore with original
        RewriteCode(processhandle,debuggerthread.int3CEBreakpoint.address,@debuggerthread.int3CEBreakpoint.originalbyte,1);
      end;

      for i:=0 to length(debuggerthread.int3userbreakpoints)-1 do
        if debuggerthread.int3userbreakpoints[i].address=x then
        begin
          //dont need to set a breakpoint
          debuggerthread.continueprocess:=true;
          caption:='Memory Viewer - Running';
          exit;
        end;

      debuggerthread.int3CEBreakpoint.address:=x;
      readprocessmemory(processhandle,pointer(x),@debuggerthread.int3CEBreakpoint.originalbyte,1,written);

      Rewritecode(processhandle,x,@int3,1);
    end;

    debuggerthread.continueprocess:=true;
    caption:='Memory Viewer - Running';
  end;

  {$endif}
end;

procedure TMemoryBrowser.Stacktrace1Click(Sender: TObject);
begin
  {$ifndef net}
  frmstacktrace:=tfrmstacktrace.create(self);
  frmstacktrace.Show;
  {$endif}
end;

procedure TMemoryBrowser.Threadlist1Click(Sender: TObject);
begin
  {$ifndef net}
  if frmThreadlist<>nil then exit;

  if not startdebuggerifneeded then exit;
  frmThreadlist:=tfrmthreadlist.create(self);
  frmThreadlist.show;
  {$endif}

end;

procedure TMemoryBrowser.AssemblePopup(x:string);
var assemblercode,desc: string;
    bytes: tassemblerbytes;
    a,b,original,written:dword;
    originalsize:dword;
    replace: boolean;
    c: word;

    res: word;
    i: integer;
begin
  //make sure it doesnt have a breakpoint
  {$ifndef net}
  if debuggerthread<>nil then
  begin
    for i:=0 to length(debuggerthread.int3userbreakpoints)-1 do
      if debuggerthread.int3userbreakpoints[i].address=dselected then
      begin
        beep; //Best sound effect cheat engine has
        exit;
      end;
  end;
  {$endif}

  originalsize:=dselected;
  assemblercode:=disassemble(originalsize,desc);
  dec(originalsize,dselected);

  assemblercode:=copy(assemblercode,pos('-',assemblercode)+2,length(assemblercode));
  assemblercode:=copy(assemblercode,pos('-',assemblercode)+2,length(assemblercode));

//  copy

  res:=mrCancel;
  InputboxTop:=Tinputboxtop.Create(self);

  with inputboxtop do
  begin
    cpt:='Cheat Engine single-linge assembler';
    question:='Type your assembler code here: (address='+inttohex(dselected,8)+')';

    if x='' then default:=assemblercode else default:=x;

    if x<>'' then
      dontselect:=true;

    res:=Showmodal;
  end;

  if res=mrok then
  begin
    assemblercode:=inputboxtop.default;
    try
      if Assemble(assemblercode,dselected,bytes) then
      begin
        if originalsize<>length(bytes) then
        begin
          if formsettings.replacewithnops.checked then
          begin
            if formsettings.askforreplacewithnops.checked then
            begin
              c:=messagedlg('The generated code is '+IntToStr(length(bytes))+' byte(s) long, but the selected opcode is '+IntToStr(originalsize)+' byte(s) long! Do you want to replace the incomplete opcode(s) with NOP''s?',mtConfirmation,mbYesNoCancel,0);
              replace:=c=mryes;
              if c=mrCancel then exit;
            end else replace:=true;

            if replace then
            begin
              while originalsize>length(bytes) do
              begin
                setlength(bytes,length(bytes)+1);
                bytes[length(bytes)-1]:=$90;
              end;

              a:=dselected+length(bytes);

              b:=dselected;
              while b<a do disassemble(b,desc);

              a:=b-dselected;
              while length(bytes)<a do
              begin
                setlength(bytes,length(bytes)+1);
                bytes[length(bytes)-1]:=$90;
              end;
            end;


          end;
        end;

        //note to self, check the size of the current opcode and give the option to replace the missing or too many bytes with nops
        //and put in a option to disable showing that message, and use a default action

        // get old security and set new security   (not needed in win9x but nt doesnt even allow writeprocessmemory to do this
        original:=0;

        RewriteCode(processhandle,dselected,@bytes[0],length(bytes));
        refreshMB;
        updatedisassemblerview;
      end else raise exception.create('I don''t understand what you mean with '+assemblercode);
    except
      raise exception.create('I don''t understand what you mean with '+assemblercode);
    end;

  end;
  inputboxtop.Free;

end;

procedure TMemoryBrowser.Assemble1Click(Sender: TObject);
begin
  AssemblePopup('');
end;

procedure TMemoryBrowser.DisCanvasDblClick(Sender: TObject);
begin
  assemble1.Click;
end;

procedure TMemoryBrowser.HexEditKeyPress(Sender: TObject; var Key: Char);
begin
  hexadecimal(key);
  if editing then key:=#0;
  editing:=false;

end;

procedure TMemoryBrowser.HexEditExit(Sender: TObject);
var bt: byte;
    aw: dword;
begin
//change
  if not hexedit.Visible then exit;

  if length(hexedit.Text)<2 then
  begin
    hexedit.Visible:=false;
    beep;
    exit;
  end;

  bt:=strtoint('$'+hexedit.text);

  writeprocessmemory(processhandle,pointer(selected),@bt,1,aw);
  refreshmb;

  hexedit.Visible:=false;
end;

procedure TMemoryBrowser.HexEditKeyDown(Sender: TOb