frmautoinjectunit.pas

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

unit frmautoinjectunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Menus,cefuncproc,  StrUtils, types,
  ComCtrls,
  {$ifdef net}
  netapis,
  {$else}
  newkernelhandler,
  {$endif}
  {$ifndef standalonetrainerwithassembler}
  disassembler,
  mainunit2,
  {$endif}
  assemblerunit, autoassembler, symbolhandler;


type
  TfrmAutoInject = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Panel1: TPanel;
    Button1: TButton;
    Load1: TMenuItem;
    Save1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Assigntocurrentcheattable1: TMenuItem;
    emplate1: TMenuItem;
    Codeinjection1: TMenuItem;
    CheatTablecompliantcodee1: TMenuItem;
    APIHook1: TMenuItem;
    SaveAs1: TMenuItem;
    assemblescreen: TMemo;
    PopupMenu1: TPopupMenu;
    procedure Button1Click(Sender: TObject);
    procedure Load1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Codeinjection1Click(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure CheatTablecompliantcodee1Click(Sender: TObject);
    procedure assemblescreenChange(Sender: TObject);
    procedure Assigntocurrentcheattable1Click(Sender: TObject);
    procedure APIHook1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure assemblescreenKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    updating: boolean;
  public
    { Public declarations }
    editscript: boolean;
    procedure highlight;
  end;

  procedure Getjumpandoverwrittenbytes(address,addressto: dword; jumppart,originalcodepart: tstrings);

implementation

{$R *.dfm}

{$ifndef standalonetrainerwithassembler}
uses memorybrowserformunit,APIhooktemplatesettingsfrm,{$ifdef net}unit2{$else}mainunit{$endif};
{$endif}



procedure TfrmAutoInject.Button1Click(Sender: TObject);
var enable,disable: integer;
    a,b: integer;

    aa: TCEAllocArray;
begin
  if editscript then
  begin
    setlength(aa,0);

    {$ifndef standalonetrainerwithassembler}
    //just check if both scripts are valid
    getenableanddisablepos(assemblescreen.Lines,a,b);
    if (a=-1) and (b=-1) then raise exception.create('The code needs a [ENABLE] and a [DISABLE] section if you want to use this script as a table entry');

    if autoassemble(assemblescreen.lines,false,true,true,aa) and
       autoassemble(assemblescreen.lines,false,false,true,aa) then
    begin
      modalresult:=mrok;
    end
    else showmessage('Error. Not all code is injectable. I can''t change the script');

    {$endif}
  end else autoassemble(assemblescreen.lines,true);
end;

procedure TfrmAutoInject.Load1Click(Sender: TObject);
begin
  if opendialog1.Execute then
  begin
    assemblescreen.Clear;
    assemblescreen.Lines.LoadFromFile(opendialog1.filename);
    savedialog1.FileName:=opendialog1.filename;
  end;
end;

procedure TfrmAutoInject.Save1Click(Sender: TObject);
begin
  if savedialog1.filename='' then
  begin
    if savedialog1.Execute then
    assemblescreen.Lines.SaveToFile(savedialog1.filename);
  end else assemblescreen.Lines.SaveToFile(savedialog1.filename);
end;

procedure TfrmAutoInject.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure TfrmAutoInject.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if not editscript then
    action:=cafree;
end;

procedure TfrmAutoInject.Codeinjection1Click(Sender: TObject);
function inttostr(i:int64):string;
begin
  if i=0 then result:='' else result:=sysutils.IntToStr(i);
end;

var address: string;
    addressdw: dword;
    originalcode: array of string;
    codesize: integer;
    a,b: dword;
    x: string;
    i,j,k: integer;
    prev_usesymbols: boolean;
    injectnr: integer;
begin
{$ifndef standalonetrainerwithassembler}
  a:=memorybrowser.dselected;

  address:=inttohex(a,8);
  if inputquery('On what address do you want the jump?','Code inject template',address) then
  begin
    try
      a:=strtoint('$'+address);
    except

      a:=symhandler.getaddressfromname(address);

    end;

    b:=a;

    injectnr:=0;
    for i:=0 to assemblescreen.Lines.Count-1 do
    begin
      j:=pos('alloc(newmem',lowercase(assemblescreen.lines[i]));
      if j<>0 then
      begin
        x:=copy(assemblescreen.Lines[i],j+12,length(assemblescreen.Lines[i]));
        x:=copy(x,1,pos(',',x)-1);
        try
          k:=strtoint(x);
          if injectnr<=k then
            injectnr:=k+1;
        except
          inc(injectnr);
        end;
      end;
    end;


    //disassemble the old code
    setlength(originalcode,0);
    codesize:=0;

    while codesize<5 do
    begin
      setlength(originalcode,length(originalcode)+1);
      originalcode[length(originalcode)-1]:=disassemble(a,x);
      i:=posex('-',originalcode[length(originalcode)-1]);
      i:=posex('-',originalcode[length(originalcode)-1],i+1);
      originalcode[length(originalcode)-1]:=copy(originalcode[length(originalcode)-1],i+2,length(originalcode[length(originalcode)-1]));
      codesize:=a-b;
    end;

    with assemblescreen.lines do
    begin
      add('alloc(newmem'+inttostr(injectnr)+',2048) //2kb should be enough');
      add('label(returnhere'+inttostr(injectnr)+')');
      add('label(originalcode'+inttostr(injectnr)+')');
      add('label(exit'+inttostr(injectnr)+')');
      add('');
      add(address+':');
      add('jmp newmem'+inttostr(injectnr)+'');
      while codesize>5 do
      begin
        add('nop');
        dec(codesize);
      end;

      add('returnhere'+inttostr(injectnr)+':');
      add('');
      add('newmem'+inttostr(injectnr)+': //this is allocated memory, you have read,write,execute access');
      add('//place your code here');

      add('');
      add('');
      add('originalcode'+inttostr(injectnr)+':');
      for i:=0 to length(originalcode)-1 do
        add(originalcode[i]);
      add('');
      add('exit'+inttostr(injectnr)+':');
      add('jmp returnhere'+inttostr(injectnr)+'');


    end;

  end;

{$endif}
end;

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


procedure TfrmAutoInject.CheatTablecompliantcodee1Click(Sender: TObject);
begin
  assemblescreen.Lines.Insert(0,'[ENABLE]');
  assemblescreen.Lines.Insert(1,'//code from here to ''[DISABLE]'' will be used to enable the cheat');
  assemblescreen.Lines.Insert(2,'');

  assemblescreen.Lines.Add(' ');
  assemblescreen.Lines.Add(' ');
  assemblescreen.Lines.Add('[DISABLE]');
  assemblescreen.Lines.Add('//code from here till the end of the code will be used to disable the cheat');
end;

procedure TfrmAutoInject.assemblescreenChange(Sender: TObject);
begin
//  highlight;
end;

procedure TFrmAutoInject.highlight;
{var pos: tpoint;
    start,stop: integer;
    old: integer;
    i:integer;}
begin
{  if updating then exit;

  updating:=true;
  try
    pos.x:=0;
    pos.y:=0;
    start:=sendmessage(assemblescreen.handle,EM_CHARFROMPOS,0,lparam(@pos));

    pos.x:=self.ClientWidth;
    pos.y:=self.ClientHeight;
    stop:=sendmessage(assemblescreen.handle,EM_CHARFROMPOS,0,lparam(@pos));

    if start>5 then dec(start,5) else start:=0;

    assemblescreen.Lines.BeginUpdate;

    old:=assemblescreen.selstart;
    for i:=start to stop-1 do
    begin
      if assemblescreen.Text[i]='a' then
      begin
        assemblescreen.SelStart:=i;
      end;
    end;

    assemblescreen.Lines.EndUpdate;
    assemblescreen.SelStart:=old;

  finally
    updating:=false;
  end;    }
end;

procedure TfrmAutoInject.Assigntocurrentcheattable1Click(Sender: TObject);
var a,b: integer;
    aa:TCEAllocArray;
begin
{$ifndef standalonetrainerwithassembler}
  {$ifndef net}
  setlength(aa,0);
  getenableanddisablepos(assemblescreen.Lines,a,b);
  if (a=-1) and (b=-1) then raise exception.create('The code needs a [ENABLE] and a [DISABLE] section if you want to add it to a table');

  if autoassemble(assemblescreen.lines,false,true,true,aa) and
     autoassemble(assemblescreen.lines,false,false,true,aa) then
  begin
    //add a entry with type 255
    mainform.AddAutoAssembleScript(assemblescreen.text);


  end
  else showmessage('Failed to add to table. Not all code is injectable');
  {$endif}
  {$endif}
end;

procedure Getjumpandoverwrittenbytes(address,addressto: dword; jumppart,originalcodepart: tstrings);
//pre: jumppart and originalcodepart are declared objects
var x,y: dword;
    z: string;
    i: integer;
begin
{$ifndef standalonetrainerwithassembler}
  x:=address;
  y:=address;

  while x-y<5 do
  begin
    z:=disassemble(x);
    z:=copy(z,pos('-',z)+1,length(z));
    z:=copy(z,pos('-',z)+1,length(z));

    originalcodepart.add(z);
  end;

  jumppart.Add('jmp '+inttohex(addressto,8));

  for i:=5 to x-y-1 do
    jumppart.Add('nop');
{$endif}
end;


procedure TfrmAutoInject.APIHook1Click(Sender: TObject);
function inttostr(i:int64):string;
begin
  if i=0 then result:='' else result:=sysutils.IntToStr(i);
end;

var address: string;
    addressdw: dword;
    originalcode: array of string;
    codesize: integer;
    a,b,c: dword;
    x: string;
    i,j,k: integer;
    prev_usesymbols: boolean;
    injectnr: integer;

begin
{$ifndef standalonetrainerwithassembler}
  a:=memorybrowser.dselected;

  address:=inttohex(a,8);

  with tfrmapihooktemplatesettings.create(self) do
//  if inputquery('Give the address of the api you want to hook',address) and inputquery('Give the address of the replacement function',address) then
  begin
    try
      edit1.text:=address;
      if showmodal<>mrok then exit;

      try
        a:=strtoint('$'+edit1.text);
      except
        a:=symhandler.getaddressfromname(edit1.text);
      end;

      try
        b:=strtoint('$'+edit2.text);
      except
        b:=symhandler.getaddressfromname(edit2.text);
      end;

      if edit3.text<>'' then
      begin
        try
          c:=strtoint('$'+edit3.text);
        except
          c:=symhandler.getaddressfromname(edit3.text);
        end;
      end;



      b:=a;

      injectnr:=0;
      for i:=0 to assemblescreen.Lines.Count-1 do
      begin
        j:=pos('alloc(newmem',lowercase(assemblescreen.lines[i]));
        if j<>0 then
        begin
          x:=copy(assemblescreen.Lines[i],j+12,length(assemblescreen.Lines[i]));
          x:=copy(x,1,pos(',',x)-1);
          try
            k:=strtoint(x);
            if injectnr<=k then
              injectnr:=k+1;
          except
            inc(injectnr);
          end;
        end;
      end;


      //disassemble the old code
      setlength(originalcode,0);
      codesize:=0;


      while codesize<5 do
      begin
        setlength(originalcode,length(originalcode)+1);
        originalcode[length(originalcode)-1]:=disassemble(a,x);
        i:=posex('-',originalcode[length(originalcode)-1]);
        i:=posex('-',originalcode[length(originalcode)-1],i+1);
        originalcode[length(originalcode)-1]:=copy(originalcode[length(originalcode)-1],i+2,length(originalcode[length(originalcode)-1]));
        codesize:=a-b;
      end;


      with assemblescreen.lines do
      begin
        add('alloc(originalcall'+inttostr(injectnr)+',2048) //2kb should be enough');
        add('label(returnhere'+inttostr(injectnr)+')');
        add('');
        add(edit1.text+':');
        add('jmp '+edit2.text);
        while codesize>5 do
        begin
          add('nop');
          dec(codesize);
        end;

        add('returnhere'+inttostr(injectnr)+':');
        add('');
        add('originalcall'+inttostr(injectnr)+':');

        for i:=0 to length(originalcode)-1 do
          add(originalcode[i]);
        add('jmp returnhere'+inttostr(injectnr)+'');

        add('');
        if edit3.text<>'' then
        begin
          add(edit3.text+':');
          add('dd originalcall');
        end;


      end;

    finally
      free;
    end;
  end;

{$endif}
end;

procedure TfrmAutoInject.SaveAs1Click(Sender: TObject);
begin
  if savedialog1.Execute then
    save1.Click;    
end;

procedure TfrmAutoInject.FormShow(Sender: TObject);
begin
{$ifndef standalonetrainerwithassembler}
  if editscript then button1.Caption:=strOK;
{$endif}
end;

procedure TfrmAutoInject.assemblescreenKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
   if (ssCtrl in Shift) and (key=ord('A'))  then
   begin
     TMemo(Sender).SelectAll;
     Key := 0;
   end;
end;

end.