frmautoinjectunit.pas.svn-base

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

        //now clean up output so that the result is a readable program
        for i:=0 to labels.Count-1 do
          output.Insert(2+i,'label('+labels[i]+')');

        output.Insert(2+labels.Count,'');

        i:=2+labels.Count+1;
        while i<output.Count do
        begin
          if pos('orig_',output[i])>0 then
          begin
            //determine if it's valid or not
            ok:=false;
            for j:=0 to labels.Count-1 do
              if labels[j]+':'=output[i] then
              begin
                ok:=true;
                break;
              end;

            if not ok then
              output.Delete(i)
            else
            begin
              output.Insert(i,'');
              inc(i,2);
            end;
          end
          else inc(i);
        end;

        assemblescreen.Lines.AddStrings(output);

      finally
        output.free;
      end;

    end;

  end;
{$endif}
end;

procedure TfrmAutoInject.New1Click(Sender: TObject);
begin
  scripts[length(scripts)-1].script:=assemblescreen.Text;
  setlength(scripts,length(scripts)+1);

  scripts[length(scripts)-1].script:='';
  scripts[length(scripts)-1].undoscripts[0].oldscript:='';
  scripts[length(scripts)-1].currentundo:=0;

  assemblescreen.Text:='';

  if length(scripts)=2 then //first time new
    tabcontrol1.Tabs.Add('Script 1');

  tabcontrol1.Tabs.Add('Script '+inttostr(length(scripts)));
  tabcontrol1.TabIndex:=length(scripts)-1;
  oldtabindex:=tabcontrol1.TabIndex;
end;

procedure TfrmAutoInject.FormCreate(Sender: TObject);
begin
  setlength(scripts,1);
  scripts[0].currentundo:=0;
  oldtabindex:=0;
  assemblescreen.SelStart:=0;
  assemblescreen.SelLength:=0;

end;

procedure TfrmAutoInject.TabControl1Change(Sender: TObject);
begin
  scripts[oldtabindex].script:=assemblescreen.text;
  scripts[oldtabindex].filename:=opendialog1.FileName;
  
  assemblescreen.text:=scripts[TabControl1.TabIndex].script;
  opendialog1.FileName:=scripts[TabControl1.TabIndex].filename;

  oldtabindex:=tabcontrol1.TabIndex;
end;

procedure TfrmAutoInject.Syntaxhighlighting1Click(Sender: TObject);
var s: string;
begin
  Syntaxhighlighting1.checked:=not Syntaxhighlighting1.checked;
  if Syntaxhighlighting1.checked then
  begin
    //enable
    assemblescreen.OnChange := assemblescreenChange;
    assemblescreenChange(assemblescreen);
  end
  else
  begin
    //disable
    assemblescreen.OnChange := nil;
    assemblescreen.PlainText := true;
    s:=assemblescreen.text;
    assemblescreen.Clear;
    assemblescreen.text:=s;
  end;
end;

procedure TfrmAutoInject.TabControl1ContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
  selectedtab:=TabControl1.IndexOfTabAt(mousepos.x,mousepos.y);
  closemenu.Popup(mouse.CursorPos.X,mouse.cursorpos.Y);   
end;

procedure TfrmAutoInject.Close1Click(Sender: TObject);
var i: integer;
begin
  if messagedlg('Are you sure you want to close '+TabControl1.Tabs[selectedtab]+' ?',mtConfirmation,[mbyes,mbno],0)=mryes then
  begin
    scripts[oldtabindex].script:=assemblescreen.text; //save current script
    tabcontrol1.Tabs.Delete(selectedtab);

    for i:=selectedtab to length(scripts)-2 do
      scripts[i]:=scripts[i+1];

    setlength(scripts,length(scripts)-1);

    if oldtabindex=selectedtab then //it was the current one
    begin
      oldtabindex:=length(scripts)-1;
      tabcontrol1.TabIndex:=oldtabindex;
      assemblescreen.text:=scripts[oldtabindex].script;
      assemblescreen.OnChange(assemblescreen);
    end;

    if (length(scripts)=1) then
      tabcontrol1.Tabs.Delete(0);

//    tabcontrol1.tabs[selectedtab]

  end;
end;

procedure TfrmAutoInject.injectscript(createthread: boolean);
var i: integer;
    setenvscript: tstringlist;
    CEAllocArray: TCEAllocArray;
    callscriptscript: tstringlist;

    totalmem: dword;
    totalwritten: dword;
    address: pointer;
    mi: TModuleInfo;
    hasjustloadedundercdll: boolean;

    aawindowwithstub: tfrmautoinject;
    setenv_done: dword;
    setenv_done_value: dword;
    s: string;

    ignore: dword;
    th: thandle;
begin
{$ifndef standalonetrainerwithassembler}
  //this will inject the script dll and generate a assembler script the user can use to call the script
  //first set the environment var for uc_home
  s:=assemblescreen.text;
  if not symhandler.getmodulebyname('undercdll.dll',mi) then
  begin
    //dll was not loaded yet

    setenvscript:=tstringlist.Create;

    with setenvscript do
    begin
      add('[enable]');
      Add('alloc(envname,8)');
      add('alloc(envvar,512)');
      add('alloc(myscript,512)');

      add('envname:');
      add('db ''UC_HOME'',0');
      add('envvar:');
      add('db '''+cheatenginedir+''' ,0');
      add('myscript:');
      add('push envvar');
      add('push envname');
      add('call SetEnvironmentVariableA');
      add('ret');

      //cleanup part:
      add('[disable]');
      add('dealloc(myscript)');
      add('dealloc(envvar)');
      add('dealloc(envname)');
    end;

    setlength(CEAllocArray,1);
    if autoassemble(setenvscript,false,true,false,false,CEAllocArray) then //enabled
    begin
      for i:=0 to length(ceallocarray)-1 do
        if ceallocarray[i].varname='myscript' then
        begin
          th:=createremotethread(processhandle,nil,0,pointer(ceallocarray[i].address),nil,0,ignore);
          if th<>0 then
            waitforsingleobject(th,4000); //4 seconds max
            
          break;
        end;



      //wait done
      autoassemble(setenvscript,false,false,false,false,CEAllocArray); //disable for the deallocs
    end;

    setenvscript.free;


    injectdll(cheatenginedir+'undercdll.dll','');
    symhandler.reinitialize;
    hasjustloadedundercdll:=true;
  end else hasjustloadedundercdll:=false;

  //now allocate memory for the script and write it to there
  totalmem:=length(assemblescreen.text);
  address:=VirtualAllocEx(processhandle,nil,totalmem+512,mem_commit,page_execute_readwrite);
  if address=nil then raise exception.create('Failed allocating memory for the script');
  if not WriteProcessMemory(processhandle,address,@s[1],totalmem,totalwritten) then
    raise exception.create('failed writing the script to the process');



  callscriptscript:=tstringlist.create;
  try
    with callscriptscript do
    begin
      add('label(result)');
      add(inttohex((dword(address)+totalmem+$20) - (dword(address) mod $10),8)+':');
      add('pushfd');
      add('pushad');
      add('push '+inttohex(dword(address),8));
      add('call underc_executescript');
      add('mov [result],eax');
      add('popad');
      add('popfd');
      add('mov eax,[result]');
      add('ret');
      add('result:');
      add('dd 0');
    end;

    if hasjustloadedundercdll then
    begin
      //lets wait before injecting the callscript script
      symhandler.waitforsymbolsloaded;
      if not symhandler.getmodulebyname('undercdll.dll',mi) then
        raise exception.Create('Failure loading undercdll');
    end;
    if not autoassemble(callscriptscript,false,true,false,false,CEAllocArray) then raise exception.Create('Failed creating calling stub for script located at address '+inttohex(dword(address),8));
  finally
    callscriptscript.free;
  end;

  aawindowwithstub:=tfrmautoinject.create(memorybrowser);
  with aawindowwithstub.assemblescreen.Lines do
  begin
    if createthread then
    begin
      add('createthread(myscript)');
      add('alloc(myscript,256)');
      add('myscript:');
    end;

    add('//Call this code to execute the script from assembler');
    add('call '+inttohex((dword(address)+totalmem+$20) - (dword(address) mod $10),8));
    add('');
    add('//eax==0 when successfully executed');
    add('//''call underc_geterror'' to get a pointer to the last generated error buffer');

    if createthread then
      add('ret //interesing thing with createthread is that the return param points to exitthread');
  end;
  aawindowwithstub.show;
{$endif}
end;



procedure TfrmAutoInject.Injectincurrentprocess1Click(Sender: TObject);
begin
  injectscript(false);
end;

procedure TfrmAutoInject.Injectintocurrentprocessandexecute1Click(
  Sender: TObject);
begin
  injectscript(true);
end;

procedure TfrmAutoInject.Cut1Click(Sender: TObject);
begin
  assemblescreen.CutToClipboard;
end;

procedure TfrmAutoInject.Copy1Click(Sender: TObject);
begin
  assemblescreen.CopyToClipboard;
end;

procedure TfrmAutoInject.Paste1Click(Sender: TObject);
begin
  assemblescreen.PasteFromClipboard;
end;

procedure TfrmAutoInject.Find1Click(Sender: TObject);
begin
  finddialog1.Execute;

end;

procedure TfrmAutoInject.FindDialog1Find(Sender: TObject);
var start,l: integer;
    p: integer;
begin
  //scan the text for the given text
  start:=assemblescreen.selstart;
  l:=length(assemblescreen.text)-start;

  p:=assemblescreen.FindText(finddialog1.FindText,start,l,[]);
  if p<>-1 then
  begin
    assemblescreen.SelStart:=p;
    assemblescreen.SelLength:=length(finddialog1.FindText);
  end;
end;

//follow is just a emergency fix since undo is messed up. At least it's better than nothing
procedure TfrmAutoInject.undotimerTimer(Sender: TObject);
var currentundo: integer;
    i: integer;
    ti: integer;
begin
  ti:=tabcontrol1.TabIndex;
  if ti=-1 then ti:=0;
  
  currentundo:=scripts[ti].currentundo;


  if currentundo=4 then //first move all previous up one spot and overwrite 1
  begin
    for i:=1 to 4 do
      scripts[ti].undoscripts[i-1]:=scripts[ti].undoscripts[i];
  end
  else
  begin
    inc(currentundo); //once it hits 4 it stays at 4, else inc.
    scripts[ti].currentundo:=currentundo;
  end;

  scripts[ti].undoscripts[currentundo].oldscript:=assemblescreen.Text;
  scripts[ti].undoscripts[currentundo].startpos:=assemblescreen.SelStart;

  undotimer.Enabled:=false; //done waiting, a keypress or other change will restart this timer
end;

procedure TfrmAutoInject.Undo1Click(Sender: TObject);
var currentundo: integer;
begin
  currentundo:=scripts[selectedtab].currentundo;
  dec(currentundo);
  if currentundo>=0 then
  begin
    assemblescreen.text:=scripts[selectedtab].undoscripts[currentundo].oldscript;

    scripts[selectedtab].currentundo:=currentundo;
    assemblescreen.SelLength:=0;
    assemblescreen.SelStart:=scripts[selectedtab].undoscripts[currentundo].startpos;
    undotimer.enabled:=false; //don't bother saving this edit
  end;

end;

end.