autoassembler.pas.svn-base

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

unit autoassembler;

interface

uses assemblerunit,classes,{$ifndef autoassemblerdll}cefuncproc,{$endif}windows,symbolhandler,sysutils,dialogs,controls
{$ifdef netclient}
,netapis;
{$else}
,NewKernelHandler;
{$endif}

{$ifdef autoassemblerdll}
type TCEAlloc=record
  address: dword;
  varname: string;
  size: dword;
end;

type PCEAlloc=^TCEAlloc;
type TCEAllocArray=array of TCEAlloc;
{$endif}

procedure getenableanddisablepos(code:tstrings;var enablepos,disablepos: integer);
function autoassemble(code: tstrings;popupmessages: boolean):boolean; overload;
function autoassemble(code: Tstrings; popupmessages,enable,syntaxcheckonly, targetself: boolean;var CEAllocarray: TCEAllocArray): boolean; overload;

implementation


procedure tokenize(input: string; tokens: tstringlist);
var i: integer;
    a: integer;
begin

  tokens.clear;
  a:=-1;
  for i:=1 to length(input) do
  begin
    case input[i] of
      'a'..'z','A'..'Z','0'..'9','_': if a=-1 then a:=i;
      else
      begin
        if a<>-1 then
          tokens.AddObject(copy(input,a,i-a),tobject(a));
        a:=-1;
      end;
    end;
  end;

  if a<>-1 then
    tokens.AddObject(copy(input,a,length(input)),tobject(a));
end;

function tokencheck(input,token:string):boolean;
var tokens: tstringlist;
    i: integer;
begin
  tokens:=tstringlist.Create;
  try
    tokenize(input,tokens);
    result:=false;

    for i:=0 to tokens.Count-1 do
      if tokens[i]=token then
      begin
        result:=true;
        break;
      end;
  finally
    tokens.free;
  end;
end;

function replacetoken(input: string;token:string;replacewith:string):string;
var tokens: tstringlist;
    i,j: integer;
begin
  result:=input;
  tokens:=tstringlist.Create;
  try
    tokenize(input,tokens);
    for i:=0 to tokens.Count-1 do
      if tokens[i]=token then
      begin
        j:=integer(tokens.Objects[i]);
        result:=copy(input,1,j-1)+replacewith+copy(input,j+length(token),length(input));
      end;

  finally
    tokens.free;
  end;
end;


function removecomments(code: tstrings):string;
var i,j: integer;
    currentline: string;
    instring: boolean;
    incomment: boolean;
begin
  //remove comments
  instring:=false;
  incomment:=false;
  for i:=0 to code.count-1 do
  begin
    currentline:=code[i];
    
    for j:=1 to length(currentline) do
    begin
      if incomment then
      begin
        //inside a comment, remove everything till a } is encountered
        if (currentline[j]='}') or
           ((currentline[j]='*') and (j<length(currentline)) and (currentline[j+1]='/')) then
        begin
          incomment:=false; //and continue parsing the code...

          if ((currentline[j]='*') and (j<length(currentline)) and (currentline[j+1]='/')) then
            currentline[j+1]:=' ';
        end;

        currentline[j]:=' ';
      end
      else
      begin
        if currentline[j]='''' then instring:=not instring;
        if currentline[j]=#9 then currentline[j]:=' '; //tabs are basicly comments 

        if not instring then
        begin
          //not inside a string, so comment markers need to be dealt with
          if (currentline[j]='/') and (j<length(currentline)) and (currentline[j+1]='/') then //- comment (only the rest of the line)
          begin
            //cut off till the end of the line (and might as well jump out now)
            currentline:=copy(currentline,1,j-1);
            break;
          end;

          if (currentline[j]='{') or
             ((currentline[j]='/') and (j<length(currentline)) and (currentline[j+1]='*')) then
          begin
            incomment:=true;
            currentline[j]:=' '; //replace from here till the first } with spaces, this goes on for multiple lines
          end;
        end;
      end;
    end;

    code[i]:=trim(currentline);
  end;

end;


procedure unlabeledlabels(code: tstrings);
var i,j: integer;
    lastseenlabel: integer;
    labels: array of string; //sorted in order of definition
    currentline: string;

begin
  //unlabeled label support
  //For those reading the source, PLEASE , try not to code scripts like that
  //the scripts you make look like crap, and are hard to read. (like using goto in a c app)
  //this is just to make one guy happy
  i:=0;
  while i<code.count do
  begin
    currentline:=code[i];

    if length(currentline)>1 then
    begin
      if currentline='@@:' then
      begin
        currentline:='RandomLabel'+chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 chr(ord('A')+random(26))+
                 ':';
        code[i]:=currentline;

        code.Insert(0,'label('+copy(currentline,1,length(currentline)-1)+')');
        inc(i);

        setlength(labels,length(labels)+1);
        labels[length(labels)-1]:=copy(currentline,1,length(currentline)-1);
      end else
      if currentline[length(currentline)-1]=':' then
      begin
        setlength(labels,length(labels)+1);
        labels[length(labels)-1]:=copy(currentline,1,length(currentline)-1);
      end;
    end;

    inc(i);
  end;

  //all label definitions have been filled in
  //now change @F (forward) and @B (back) to the labels in front and behind
  lastseenlabel:=-1;
  for i:=0 to code.Count-1 do
  begin
    currentline:=code[i];
    if length(currentline)>1 then
    begin
      if currentline[length(currentline)-1]=':' then
      begin
        //find this in the array
        currentline:=copy(currentline,1,length(currentline)-1);
        for j:=(lastseenlabel+1) to length(labels)-1 do  //lastseenlabel+1 since it is ordered in definition
        begin
          if uppercase(currentline)=uppercase(labels[j]) then
          begin
            lastseenlabel:=j;
            break;
          end;
        end;
        //lastseenlabel is now updated to the current pos
      end else
      if pos('@f',lowercase(currentline))>0 then  //forward
      begin
        //forward label, so labels[lastseenlabel+1]
        if lastseenlabel=-1 then
          raise exception.Create('There is code defined without specifying the address it belongs to');

        currentline:=replacetoken(currentline,'@f',labels[lastseenlabel+1]);
        currentline:=replacetoken(currentline,'@F',labels[lastseenlabel+1]);
      end else
      if pos('@b',lowercase(currentline))>0 then //back
      begin
        //forward label, so labels[lastseenlabel]
        if lastseenlabel=-1 then
          raise exception.Create('There is code defined without specifying the address it belongs to');

        currentline:=replacetoken(currentline,'@b',labels[lastseenlabel]);
        currentline:=replacetoken(currentline,'@B',labels[lastseenlabel]);
      end;
    end;


  end;
end;


function autoassemble2(code: tstrings;popupmessages: boolean;syntaxcheckonly:boolean; targetself: boolean ;var ceallocarray:TCEAllocArray ):boolean;
type tassembled=record
  address: dword;
  bytes: TAssemblerbytes;
end;


type tlabel=record
  defined: boolean;
  address:dword;
  labelname: string;
  assemblerline: integer;
  references: array of integer; //index of assembled array
  references2: array of integer; //index of assemblerlines array
end;
type tfullaccess=record
  address: dword;
  size: dword;
end;
type tdefine=record
  name: string;
  whatever: string;
end;
var i,j,k,l,e: integer;
    currentline: string;

    currentaddress: dword;
    assembled: array of tassembled;
    x,y,op,op2:dword;
    ok1,ok2:boolean;
    loadbinary: array of record
      address: string; //string since it might be a label/alloc/define
      filename: string;
    end;

    allocs,kallocs: array of tcealloc;
    labels: array of tlabel;
    defines: array of tdefine;
    fullaccess: array of tfullaccess;
    dealloc: array of integer;
    addsymbollist: array of string;
    deletesymbollist: array of string;
    createthread: array of string;

    a,b,c: integer;
    s1,s2: string;

    assemblerlines: array of string;

    varsize: integer;
    tokens: tstringlist;
    baseaddress: dword;

    include: tstringlist;
    testdword,bw: dword;
    binaryfile: tmemorystream;

    incomment: boolean;

    bytebuf: PByteArray;

    processhandle: THandle;
    ProcessID: DWORD;

    symhandler: TSymhandler;   
begin
  if targetself then
  begin
    //get this function to use the symbolhandler that's pointing to CE itself and the self processid/handle
    processhandle:=getcurrentprocess;
    processid:=getcurrentprocessid;
    symhandler:=symbolhandler.selfsymhandler;
  end
  else
  begin
    processhandle:=cefuncproc.ProcessHandle;
    processid:=cefuncproc.ProcessID;
    symhandler:=symbolhandler.symhandler;
  end;

  symhandler.waitforsymbolsloaded;


//2 pass scanner
  try
    setlength(assembled,1);
    setlength(kallocs,0);
    setlength(allocs,0);
    setlength(dealloc,0);
    setlength(assemblerlines,0);
    setlength(fullaccess,0);
    setlength(addsymbollist,0);
    setlength(deletesymbollist,0);
    setlength(defines,0);
    setlength(loadbinary,0);

    tokens:=tstringlist.Create;

    incomment:=false;



    removecomments(code);
    unlabeledlabels(code);


    //first pass

    i:=0;
    while i<code.Count do
    begin
      try
        try
          currentline:=code[i];



          currentline:=trim(currentline);

          if length(currentline)=0 then continue;
          if copy(currentline,1,2)='//' then continue; //skip

          setlength(assemblerlines,length(assemblerlines)+1);
          assemblerlines[length(assemblerlines)-1]:=currentline;

          if uppercase(copy(currentline,1,8))='INCLUDE(' then
          begin
            a:=pos('(',currentline);
            b:=pos(')',currentline);

            if (a>0) and (b>0) then
            begin
              s1:=copy(currentline,a+1,b-a-1);

              if ExtractFileExt(uppercase(s1))='.' then
                s1:=s1+'CEA';

              if ExtractFileExt(uppercase(s1))='' then
                s1:=s1+'.CEA';