memscan.pas.svn-base

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

          else
          begin
            //we now have a list of entries with all the same address, k-1 points to the last one
            if CheckRoutine(@newmemory[currentaddress-currentbase],@oldmem[(k-1)*vsize]) then
              StoreResultRoutine(currentaddress,@newmemory[currentaddress-currentbase]);

            //clear typesmatch and set current address
            for l:=vtByte to vtDouble do
              typesmatch[l]:=false;

            currentaddress:=alist[k].address;

            typesmatch[tvariabletype(alist[k].bit)]:=true;
          end;

        end;

        if CheckRoutine(@newmemory[currentaddress-currentbase],@oldmem[j*vsize]) then
          StoreResultRoutine(currentaddress,@newmemory[currentaddress-currentbase]);
      end;
    end;

    i:=j+1;
  end;
end;


procedure TScanner.nextnextscanmembinary(addresslist: pointer; chunksize: integer);
var stepsize: dword;
    i,j,k,l: dword;
    maxindex: dword;
    vsize: dword;
    currentbase: dword;
    newmemory: array [0..4095] of byte;
    oldmem: pbytearray;
    alist: PBitAddressArray;
    actualread: dword;
    lastaddress: dword;
    scannedbitlist: array [0..7] of boolean;
begin
  i:=0;
  maxindex:=chunksize;
  vsize:=variablesize;
  alist:=addresslist;
  currentbase:=0;

  while i<maxindex do
  begin
    j:=i+1;
              
    currentbase:=alist[i].address and $FFFFF000;
    while j<=maxindex do
    begin
      if (currentbase)=((alist[j].address+vsize-1) and $fffff000) then //same page
        inc(j)
      else
      begin
        dec(j);  //now points to the last valid one, or the first one
        break;
      end;
    end;



    currentbase:=alist[i].address;
    if readprocessmemory(processhandle,pointer(currentbase),@newmemory[0],(alist[j].address-currentbase)+vsize,actualread) then
    begin
      k:=i;
      while k<=j do
      begin
        if CheckRoutine(@newmemory[alist[k].address-currentbase],nil) then
        begin
          for l:=0 to 7 do
            scannedbitlist[l]:=false;

          lastaddress:=alist[k].address;

          while alist[k].address=lastaddress do
          begin
            //add bits to the scanned bitlist
            scannedbitlist[alist[k].bit]:=true;
            inc(k);
          end;
          dec(k);

          for l:=0 to 7 do
            if not scannedbitlist[l] then binaryresults[l]:=false; //if it wasn't scanned, but the result was true, then set it to false

          StoreResultRoutine(alist[k].address,@newmemory[alist[k].address-currentbase]);
        end;
        inc(k); //next
      end;
    end;

    i:=j+1;
  end;
end;

procedure TScanner.nextnextscanmem(addresslist: pointer; oldmemory: pointer; chunksize: integer);
{
gather addresses in a 4K region and readprocessmemory the difference between (so if only 2 addresses in a 4K block and address 1 is at 0 and address 2 at 2k, then only read 2k)
note: Do a test to see how many cpu cycles it costs to read 4K and 4bytes and find out the minimum number for mos toptimal speed
done: 4 byte scan takes an average of 4000 cycles (due to caches etc...)
   4096 byte scan takes an average of 6500 cycles ...
   2048 byte scan takes an average of 5900 cycles ...

conclusion: only when there is 1 address in the list, scan 1 address, else scan more

}

var stepsize: dword;
    i,j,k: dword;
    maxindex: dword;
    vsize: dword;
    currentbase: dword;
    newmemory: array [0..4095] of byte;
    oldmem: pbytearray;
    alist: pdwordarray;
    actualread: dword;

    so: Tscanoption;
    valuetype: TValuetype;
    currentaddress: dword;
begin
  i:=0;
  so:=scanoption;
  maxindex:=chunksize;
  vsize:=variablesize;
  oldmem:=oldmemory;
  alist:=addresslist;

  case variableType of
    vtByte:   valuetype:=vt_byte;
    vtWord:   valuetype:=vt_word;
    vtDWord:  valuetype:=vt_dword;
    vtdouble: valuetype:=vt_double;
    vtQword:  valuetype:=vt_int64;
    vtAll:    valuetype:=vt_all;
    vtCustom:
    begin
      case vsize of
        1: valuetype:=vt_byte;
        2: valuetype:=vt_word;
        4: valuetype:=vt_dword;
        8: valuetype:=vt_int64;
        else valuetype:=vt_dword;
      end;

    end;
  end;


  while i<maxindex do
  begin
    j:=i+1;
    currentbase:=alist[i] and $FFFFF000;
    while j<=maxindex do
    begin
      if (currentbase)=((alist[j]+vsize-1) and $fffff000) then //same page
        inc(j)
      else
      begin
        dec(j);  //now points to the last valid one, or the first one
        break;
      end;
    end;


    currentbase:=alist[i];
    if readprocessmemory(processhandle,pointer(currentbase),@newmemory[0],(alist[j]-currentbase)+vsize,actualread) then
    begin
      if so=soSameAsFirst then
      begin
        for k:=i to j do
          if checkroutine(@newmemory[alist[k]-currentbase],firstscanhandler.getpointertoaddress(alist[k],valuetype )) then
            StoreResultRoutine(alist[k],@newmemory[alist[k]-currentbase])
      end
      else
      begin
        for k:=i to j do
          if CheckRoutine(@newmemory[alist[k]-currentbase],@oldmem[k*vsize]) then
            StoreResultRoutine(alist[k],@newmemory[alist[k]-currentbase]);
      end;
    end;

    i:=j+1;
  end;
end;

procedure TScanner.configurescanroutine;
{
Parse scanvalue1 and scanvalue2 accordingly to the scanoptions and type
and fill in class variables that will be used for the scans
}
var FloatSettings: TFormatSettings;
    BinaryString,andmask,bitmask: string;
    i: integer;
    b: Tbytes;
    foundbuffersize: integer;
    p: pointer;
begin
  //fill FloatSettings with formatting data (e.g difference between , and . for decimal)
  GetLocaleFormatSettings(GetThreadLocale, FloatSettings);


  if scanOption in [soCustom, soExactValue,soValueBetween,soBiggerThan,soSmallerThan, soDecreasedValueBy, soIncreasedValueBy] then
  begin
    //user input is given
    if scanvalue1='' then raise exception.Create('Please fill something in');

    if variableType in [vtByte,vtWord,vtDWord,vtQword,vtAll] then
    begin

      //parse scanvalue1
      try
        if hexadecimal then
          value:=strtoint64('$'+scanvalue1)
        else
          value:=strtoint64(scanvalue1);
      except
        if variableType=vtAll then
        begin
          try
            dvalue:=strtofloat(scanvalue1,FloatSettings);
          except
            if FloatSettings.DecimalSeparator=',' then
              FloatSettings.DecimalSeparator:='.'
            else
              FloatSettings.DecimalSeparator:=',';

            //try again
            try
              dvalue:=strtofloat(scanvalue1,FloatSettings);
            except
              raise exception.Create(scanvalue1+' is not a valid value');
            end;
          end;
          value:=trunc(dvalue);

        end else
          raise exception.Create(scanvalue1+' is an invalid value');
      end;

      if scanOption=soValueBetween then
      begin
        //also parse scanvalue2
        try
          if hexadecimal then
            value2:=strtoint64('$'+scanvalue2)
          else
            value2:=strtoint64(scanvalue2);

        except
          if variableType=vtAll then
          begin
            try
              dvalue:=strtofloat(scanvalue2,FloatSettings);
            except
              if FloatSettings.DecimalSeparator=',' then
                FloatSettings.DecimalSeparator:='.'
              else
                FloatSettings.DecimalSeparator:=',';

              //try again
              try
                dvalue:=strtofloat(scanvalue1,FloatSettings);
              except
                raise exception.Create(scanvalue1+' is not a valid value');
              end;
            end;
            value:=trunc(dvalue);
          end else
          raise exception.Create(scanvalue2+' is an invalid value');
        end;
      end;
    end;

    if variableType in [vtsingle,vtDouble,vtAll] then
    begin
      try
        dvalue:=strtofloat(scanvalue1,FloatSettings);
      except
        if FloatSettings.DecimalSeparator=',' then
          FloatSettings.DecimalSeparator:='.'
        else
          FloatSettings.DecimalSeparator:=',';

        //try again
        try
          dvalue:=strtofloat(scanvalue1,FloatSettings);
        except
          raise exception.Create(scanvalue1+' is not a valid value');
        end;
      end;

      if scanoption=soValueBetween then
      begin
        try
          dvalue2:=strtofloat(scanvalue2,FloatSettings);
        except
          if FloatSettings.DecimalSeparator=',' then
            FloatSettings.DecimalSeparator:='.'
          else
            FloatSettings.DecimalSeparator:=',';

          //try again
          try
            dvalue2:=strtofloat(scanvalue1,FloatSettings);
          except
            raise exception.Create(scanvalue1+' is not a valid value');
          end;
        end;

      end;

      svalue:=dvalue;
      svalue2:=dvalue2;

      floataccuracy:=pos(FloatSettings.DecimalSeparator,scanvalue1);
      if floataccuracy>0 then
        floataccuracy:=length(scanvalue1)-floataccuracy;

      svalue:=RoundTo(svalue,-floataccuracy);
      svalue2:=RoundTo(svalue2,-floataccuracy);
      dvalue:=RoundTo(dvalue,-floataccuracy);
      dvalue2:=RoundTo(dvalue2,-floataccuracy);


      mindvalue:=dvalue-(1/(power(10,floataccuracy)));
      maxdvalue:=dvalue+(1/(power(10,floataccuracy)));
      minsvalue:=svalue-(1/(power(10,floataccuracy)));
      maxsvalue:=svalue+(1/(power(10,floataccuracy)));
    end;

    if variableType = vtString then
    begin
      widescanvalue1:=scanvalue1;
    end;    

    if variabletype = vtByteArray then
    begin
      ConvertStringToBytes(scanvalue1,hexadecimal,abs_arraytofind);
      abs_arraylength:=length(abs_arraytofind);
    end;

    if variableType = vtBinary then
    begin
      if binaryStringAsDecimal then
      begin
        if hexadecimal then
        begin
          scanvalue1:=scanvalue1+'$';
          scanvalue2:=scanvalue2+'$';
        end;

        binarystring:=inttobin(strtoint(scanvalue1))
      end
      else
        binarystring:=scanvalue1;

      andmask:='';
      bitmask:='';

      for i:=1 to length(binarystring) do
      begin
        if binarystring[i] in ['?','*'] then
        begin
          andmask:=andmask+'0';
          bitmask:=bitmask+'0';
        end
        else
        if binarystring[i] in ['0','1'] then
        begin
          andmask:=andmask+'1';
          bitmask:=bitmask+binarystring[i];
        end
        else
        if not (binarystring[i] in [' ',#8]) then
          raise exception.Create(binarystring+' is not a valid notation');
      end;

      self.andmask:=BinToInt(andmask);
      self.bitmask:=bintoint(bitmask);


    end;


  end;

  FlushRoutine:=genericFlush; //change if not so

  if variableType in [vtbinary,vtall] then
  begin
    getmem(CurrentAddressBuffer,buffersize*sizeof(Tbitaddress));
    getmem(SecondaryAddressBuffer,buffersize*sizeof(Tbitaddress));
  end
  else
  begin
    getmem(CurrentAddressBuffer,buffersize*4);
    getmem(SecondaryAddressBuffer,buffer