autoassembler.pas

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

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: 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 autoassemble2(code: tstrings;popupmessages: boolean;syntaxcheckonly: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;
var i,j,k,l,e: integer;
    currentline: string;

    currentaddress: dword;
    assembled: array of tassembled;
    x,op,op2:dword;
    ok1,ok2:boolean;
    allocs,kallocs: array of tcealloc;
    labels: array of tlabel;
    fullaccess: array of tfullaccess;
    dealloc: array of integer;
    addsymbollist: array of string;
    deletesymbollist: array of string;

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

    assemblerlines: array of string;

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

  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);
  
  tokens:=tstringlist.Create;

  for i:=0 to code.Count-1 do
  begin
    try
      currentline:=code[i];
      j:=pos('//',currentline);
      if j>0 then
        currentline:=copy(currentline,1,j-1);


      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,15))='REGISTERSYMBOL(' then
      begin
        //add this symbol to the register symbollist
        a:=pos('(',currentline);
        b:=pos(')',currentline);

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

          setlength(addsymbollist,length(addsymbollist)+1);
          addsymbollist[length(addsymbollist)-1]:=s1;
        end
        else raise exception.Create('Syntax error');

        setlength(assemblerlines,length(assemblerlines)-1);
        continue;
      end;

      if uppercase(copy(currentline,1,17))='UNREGISTERSYMBOL(' then
      begin
        //add this symbol to the register symbollist
        a:=pos('(',currentline);
        b:=pos(')',currentline);

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

          setlength(deletesymbollist,length(deletesymbollist)+1);
          deletesymbollist[length(deletesymbollist)-1]:=s1;
        end
        else raise exception.Create('Syntax error');

        setlength(assemblerlines,length(assemblerlines)-1);
        continue;        
      end;

      if uppercase(copy(currentline,1,11))='FULLACCESS(' then
      begin
        a:=pos('(',currentline);
        b:=pos(',',currentline);
        c:=pos(')',currentline);

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

          setlength(fullaccess,length(fullaccess)+1);
          fullaccess[length(fullaccess)-1].address:=symhandler.getAddressFromName(s1);
          fullaccess[length(fullaccess)-1].size:=strtoint(s2);
        end else raise exception.Create('Syntax error');

        setlength(assemblerlines,length(assemblerlines)-1);
        continue;
      end;

      if uppercase(copy(currentline,1,6))='LABEL(' then
      begin
        //syntax: label(x)  x=name of the label
        //later on in the code there has to be a line with "labelname:"
        a:=pos('(',currentline);
        b:=pos(')',currentline);

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


          val('$'+s1,j,a);
          if a=0 then raise exception.Create(s1+' is not a valid identifier');

          varsize:=length(s1);

          while (j<length(labels)) and (length(labels[j].labelname)>varsize) do
          begin
            if labels[j].labelname=s1 then
              raise exception.Create(s1+' is being redeclared');
            inc(j);
          end;

          j:=length(labels);//quickfix
          l:=j;


          //check for the line "labelname:"
          ok1:=false;
          for j:=0 to code.Count-1 do
            if trim(code[j])=s1+':' then
            begin
              if ok1 then raise exception.Create('label '+s1+' is being defined more than once');
              ok1:=true;
            end;

          if not ok1 then raise exception.Create('label '+s1+' is not defined in the script');


          //still here so ok
          //insert it
          setlength(labels,length(labels)+1);
          for k:=length(labels)-1 downto j+1 do
            labels[k]:=labels[k-1];


          labels[l].labelname:=s1;
          labels[l].defined:=false;
          setlength(assemblerlines,length(assemblerlines)-1);
          setlength(labels[l].references,0);
          setlength(labels[l].references2,0);

          continue;
        end else raise exception.Create('Syntax Error');
      end;

      if (uppercase(copy(currentline,1,8))='DEALLOC(') then
      begin
        if (ceallocarray<>nil) then//memory dealloc=possible
        begin

          //syntax: dealloc(x)  x=name of region to deallocate
          //later on in the code there has to be a line with "labelname:"
          a:=pos('(',currentline);
          b:=pos(')',currentline);

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

            //find s1 in the ceallocarray
            for j:=0 to length(ceallocarray)-1 do
            begin
              if uppercase(ceallocarray[j].varname)=uppercase(s1) then
              begin
                setlength(dealloc,length(dealloc)+1);
                dealloc[length(dealloc)-1]:=ceallocarray[j].address;
              end;
            end;
          end;
        end;
        setlength(assemblerlines,length(assemblerlines)-1);
        continue;
      end;

      //memory alloc
      if uppercase(copy(currentline,1,6))='ALLOC(' then
      begin
        //syntax: alloc(x,size)    x=variable name size=bytes
        //allocate memory
        a:=pos('(',currentline);
        b:=pos(',',currentline);
        c:=pos(')',currentline);

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

          val('$'+s1,j,a);
          if a=0 then raise exception.Create(s1+' is not a valid identifier');

          varsize:=length(s1);

          //check for duplicate identifiers
          j:=0;
          while (j<length(allocs)) and (length(allocs[j].varname)>varsize) do
          begin
            if allocs[j].varname=s1 then
              raise exception.Create('The identifier '+s1+' has already been declared');

            inc(j);
          end;

          j:=length(allocs);//quickfix

          setlength(allocs,length(allocs)+1);

          //longest varnames first so the rename of a shorter matching var wont override the longer one
          //move up the other allocs so I can inser this element (A linked list might have been better)
          for k:=length(allocs)-1 downto j+1 do
            allocs[k]:=allocs[k-1];

          allocs[j].varname:=s1;
          allocs[j].size:=StrToInt(s2);

          setlength(assemblerlines,length(assemblerlines)-1);   //don't bother with this in the 2nd pass
          continue;
        end else raise exception.Create('Wrong syntax. ALLOC(identifier,sizeinbytes)');
      end;

      //replace identifiers with values so the assemble error check doesnt crash on that
      for j:=0 to length(allocs)-1 do
        currentline:=replacetoken(currentline,allocs[j].varname,'00000000');


      {$ifndef net}
      //memory kalloc
      if uppercase(copy(currentline,1,7))='KALLOC(' then
      begin
        if not DBKReadWrite then raise exception.Create('You need to use kernelmode read/writeprocessmemory if you want to use KALLOC');

        if DarkByteKernel=0 then
          raise exception.Create('Sorry, but without the driver KALLOC will not function');

        //syntax: kalloc(x,size)    x=variable name size=bytes
        //kallocate memory
        a:=pos('(',currentline);
        b:=pos(',',currentline);
        c:=pos(')',currentline);

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

          val('$'+s1,j,a);
          if a=0 then raise exception.Create(s1+' is not a valid identifier');

          varsize:=length(s1);

          //check for duplicate identifiers
          j:=0;
          while (j<length(kallocs)) and (length(kallocs[j].varname)>varsize) do
          begin
            if kallocs[j].varname=s1 then
              raise exception.Create('The identifier '+s1+' has already been declared');

            inc(j);
          end;

          j:=length(kallocs);//quickfix

          setlength(kallocs,length(kallocs)+1);

          //longest varnames first so the rename of a shorter matching var wont override the longer one
          //move up the other kallocs so I can inser this element (A linked list might have been better)
          for k:=length(kallocs)-1 downto j+1 do
            kallocs[k]:=kallocs[k-1];

          kallocs[j].varname:=s1;
          kallocs[j].size:=StrToInt(s2);

          setlength(assemblerlines,length(assemblerlines)-1);   //don't bother with this in the 2nd pass
          continue;
        end else raise exception.Create('Wrong syntax. kalloc(identifier,sizeinbytes)');
      end;

      //replace identifiers with values so the assemble error check doesnt crash on that
      for j:=0 to length(kallocs)-1 do
        currentline:=replacetoken(currentline,kallocs[j].varname,'00000000');

      {$endif}

      //check for assembler errors
      //address

      if currentline[length(currentline)]=':' then
      begin
        try
          ok1:=false;
          for j:=0 to length(labels)-1 do
            if currentline=labels[j].labelname+':' then
            begin
              labels[j].assemblerline:=length(assemblerlines)-1;
              ok1:=true;
              continue;
            end;

          if ok1 then continue; //no check