unit1.pas

来自「这是一段游戏修改工具的源代码.ring3功能由dephi开发,驱动是C开发.希望」· PAS 代码 · 共 2,369 行 · 第 1/5 页

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, ScktComp,ScanThread,WinSock, Sockets,
  IdBaseComponent, IdComponent, IdTCPServer, Menus,syncobjs,newkernelhandler;

const
  //Client to server communication
  CS_GetProcessList=0; //no param
  CS_GetWindowList=1; //no param
  CS_OpenProcess=2; //procid: dword
  CS_AddAddress=3; // Address:dword;valtype:byte;bitnr:byte;length:byte
  CS_RefreshList=4; //Start:word;stop:word
  CS_SetConfig=5; //ShowAsSigned:byte BinariesAsDecimal:byte max:word; buffersize:dword;skip_page_no_cache: byte;UseDebugRegs:byte;stealthusermode:byte;stealthkernelmode:byte
  CS_ClearRecordList=6; //no param
  CS_ChangeValueOfAddress=7; //recnr: word; length:byte; newvalue:string
  CS_FreezeAddress=8; //recnr: word
  CS_ReadProcessMemory=9; //address:dword; length:word;
  CS_WriteProcessMemory=10; //address:dword; length:word; bytes:array of byte
  CS_FirstScan=11; //start,stop:dword;Scantype:byte;vartype:byte;scanvaluelength:byte;scanvalue:string;scanoptions:byte
  CS_NextScan=12;
  CS_NewScan=13;
  CS_CancelScan=14;
  CS_DeleteAddress=15; //recnr:word
  CS_SetTimerSpeed=16; //Updateinterval:word; freezeinterval:word
  CS_UnfreezeAddress=17; //recnr:word
  CS_ProcessItemAck=18;
  CS_SetHyperScanState=19; //(state:byte); //0=off 1=on
  CS_EnableSpeedhack=20; //(speed:single;sleeptime:dword)
  CS_DisableSpeedhack=21; //
  CS_EnableDebugger=22; //
  CS_FindWhatWrites=23;  //(address:dword;size:word)
  CS_FindWhatReads=24;   //(address:dword;size:word)
  CS_FindWhatAccesses=25;//(address:dword;size:word)
  CS_StopCodefinder=26;
  CS_VirtualProtectEx=27; //(Address: dword; dwSize:dword; NewProtect: DWORD);
  CS_SuspenProcess=28;
  CS_ResumeProcess=29;


  //server to client communication
  SC_TellUpdateSpeed=0; //updatespeed:word
  SC_TellFreezeSpeed=1; //freezespeed:word
  SC_ProcessListItem=2; //processid:dword; stringlength:byte;processname:array of char
  SC_StopProcessList=3; // noparam
  SC_OpenProcessSuccess=4; //'
  SC_OpenProcessFailed=5;
  SC_RecordReceived=6; //Indicated that the record has been received  (not really necesary)
  SC_ValueUpdated=7; //recnr:word; length:byte; value:string
  SC_ValueListDone=8; //All values have been sent to the client
  SC_DebugRegsPresent=9;
  SC_ValueChanged=10; //0=success 1=Incorrect value 2=unwritable 3=record doesn't exist

  SC_ReadProcessMemoryResult=11;
  SC_WriteProcessMemoryResult=12;

  SC_ScanResultCount=13; //count:int64
  SC_ScanResult=14; //stringlength:byte; result:string
  SC_AddressUnfrozen=15; //recnr: word;
  SC_UpdateProgressbar=16; //max:word; position:word
  SC_ScanFailed=17;
  SC_Disconnect=18;

  SC_Hyperscanstatus=19; //status:byte //0=off 1=on
  SC_SpeedhackStatus=20; //status:byte
  SC_DebuggerStatus=21; //status: byte 0=off 1=on

  SC_FoundCode=22; //(Address: dword;eax:dword; ebx:dword; ecx:dword; edx:dword;esi:dword;edi:dword;ebp:dword;esp:dword;eip:dword;)
  SC_VirtualProtectExResult=23; //(status:byte; oldprotecT:dword); //status 0=failed 1=success

type TSettings = record
  ShowAsSigned: boolean;
  BinariesAsDecimal: boolean;
  max: word;
  buffersize: dword;
  skip_page_no_cache:boolean;
  usedebugregs: boolean;
end;

type mymemoryrecord = record
  address: dword;
  bit: byte;
  bitlength: byte;
  vartype: byte;
  frozen: boolean;
  Frozenvalue: int64;
  FrozenFvalue: double;
  Frozenstring: string;
  frozenBytes: array of Byte;
end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Portvalue: TEdit;
    Label1: TLabel;
    StatusBar1: TStatusBar;
    FreezeTimer: TTimer;
    Log: TMemo;
    UpdateTimer: TTimer;
    ListBox: TListBox;
    hexcb: TCheckBox;
    TimeOutTest: TTimer;
    Progressbartimer: TTimer;
    Button2: TButton;
    IdTCPServer1: TIdTCPServer;
    PopupMenu1: TPopupMenu;
    Savetofile1: TMenuItem;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure UpdateTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FreezeTimerTimer(Sender: TObject);
    procedure TimeOutTestTimer(Sender: TObject);
    procedure ProgressbartimerTimer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure Savetofile1Click(Sender: TObject);
  private
    { Private declarations }
    logon: boolean;
    online: boolean;
    settings: TSettings;
    currenttype: byte;
    keepalivesend:boolean;
    UpdatelistCS: TCriticalSection;

    hypermode: boolean;
    cescanhook:thandle;
    cehookdll: thandle;

    procedure GetWindowList2;
    procedure GetProcessList2;
    function ChangeValue(recordnr: integer; newvalue:string):byte;
    procedure FreezeAddress(i: word);
    procedure SetReadWriteBreakpoint(address: dword; size: dword);
    procedure SetReadBreakpoint(address: dword; size: dword);
    procedure SetWriteBreakpoint(address: dword; size: dword);

  public
    { Public declarations }
    Numberofrecords: Integer;
    memrec: array of mymemoryrecord;
    senddata: boolean;
    lag: Integer;

    progressbar:TProgressBar;
    output: array [0..2048] of byte;

    SThread: TScanThread;
    Progressbar1: TProgressbar;
    closed: boolean;
    hyperscanenabled: boolean;
    speedhackenabled: boolean;
    HyperscanFileMapping: THandle;


    procedure UpdateList; overload;
    procedure UpdateList(start: word;stop:word); overload;
    procedure ReceiveBuf(var Buf; Count: Integer;socket:TCustomWinSocket);
    procedure SendBuf(count: integer);
    procedure Enablehypermode;
    procedure DisableHypermode;
    procedure DisableSpeedhack;

   // debuggerthread: tdebuggerthread;
  end;

var
  Form1: TForm1;


resourcestring strAddressHasToBeReadable='This address can''t be read';
implementation

{$R *.DFM}
uses CEFuncProc,debugger;

procedure TForm1.SendBuf(count: integer);
var i,j: integer;
    counter: integer;
    FDSet: TFDSet;
    TimeVal: TTimeVal;
    x: integer;
    bytenr: integer;
    threadlist: tlist;
begin
  threadlist:=idtcpserver1.Threads.LockList;
  try
    for i:=0 to threadlist.count-1 do
      TIdPeerThread(threadlist[i]).Connection.WriteBuffer(output[0],count);
  finally
    idtcpserver1.Threads.UnlockList;
  end;
end;

procedure TForm1.FreezeAddress(i: word);
var error: dword;

    a: single;
    b: double;
    controle: String;

    j,k,sel: Integer;
    db: Byte;
    dw: Word;
    dd: dword;
    di64: Int64;

    read8: array of byte;
    read9: pbyte;

    freeze: boolean;
    freezegroup: array [1..4] of boolean;
    temps: pchar;

    temp: string;
begin
  //read memory
  case memrec[i].VarType of
    0:
    begin  //byte
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(db),1,error);
      if error=1 then
      begin
        memrec[i].FrozenValue:=db;
        memrec[i].Frozen:=true;
      end;
    end;

    1:
    begin  //word
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(dw),2,error);
      if error=2 then
      begin
        memrec[i].FrozenValue:=dw;
        memrec[i].Frozen:=true;
      end;
    end;

    2:
    begin  //dword
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(dd),4,error);
      if error=4 then
      begin
        memrec[i].FrozenValue:=dd;
        memrec[i].Frozen:=true;
      end;
    end;

    3:  //float
    begin
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(a),4,error);
      if error=4 then
      begin
        controle:=FloatToStr(a);
        if system.pos('NAT',controle)>0 then error:=0;
        if system.pos('INF',controle)>0 then error:=0;
        if error<>0 then
        begin
          memrec[i].FrozenFvalue:=a;
          memrec[i].Frozen:=true;
        end;
      end;
    end;

    4:
    begin
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(b),8,error);
      if error=8 then
      begin
        controle:=FloatToStr(b);
        if system.pos('NAT',controle)>0 then error:=0;
        if system.pos('INF',controle)>0 then error:=0;
        if error<>0 then
        begin
          memrec[i].frozenfvalue:=b;
          memrec[i].Frozen:=true;
        end;
      end;
    end;

    5:
    begin  //binary
      k:=1+((memrec[i].Bit+memrec[i].bitlength) div 8);
      setlength(read8,k);
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(read8[0]),k,error);
      if error=k then
      begin
        //find out the current bit combination (use frozenstrings to store the value)
        //convert what i need to a string of bits
        temp:='';
        j:=memrec[i].Bit;
        read9:=@read8[0];
        for k:=1 to memrec[i].bitlength do
        begin
          temp:=temp+IntToStr(getbit(j,read9^));
          inc(j);
          if j>=8 then
          begin
            j:=0;
            inc(read9);
          end;
        end;

        //the tempstring now contaisn the bits (bit0 is first char...)
        memrec[i].Frozenstring:=temp;
        memrec[i].Frozen:=true;
      end;
    end;

    6:
    begin  //int64
      readprocessmemory(processhandle,pointer(memrec[i].Address),addr(dI64),8,error);
      if error=8 then
      begin
        memrec[i].FrozenValue:=di64;
        memrec[i].Frozen:=true;
      end;
    end;

    7:
    begin  //text
      getmem(temps,memrec[i].bit);
      readprocessmemory(processhandle,pointer(memrec[i].Address),temps,memrec[i].Bit,error);
      if error=memrec[i].bit then
      begin
        memrec[i].FrozenString:=temps;
        memrec[i].Frozen:=true;
      end;
      freemem(temps);
    end;

    8:
    begin  //array of byte
      setlength(memrec[i].FrozenBytes,memrec[i].bit);
      readprocessmemory(processhandle,pointer(memrec[i].Address),memrec[i].FrozenBytes,memrec[i].Bit,error);
      if error=memrec[i].bit then
      memrec[i].Frozen:=true;
    end;
  end;


  if error=0 then
  begin
    //freeze failed
    output[0]:=SC_ADDRESSUNFROZEN;
    pword(@output[1])^:=i;
    sendbuf(3);
  end;

  //and freeze it
end;

function TForm1.ChangeValue(recordnr: integer; newvalue:string):byte;
var newvalue1: Byte;
    oldvalue1: byte;
    newvalue2: word;
    newvalue3: dword;
    newvalue4: Single;
    newvalue5: Double;
    newvalue6: Int64;
    newvalueSt: String;
    newvalue8: TBytes;

    newbytes: array of byte;

    text: pchar;
    addzero: boolean;
    write: dword;
    error,i,j,k,l: Integer;
    bl:integer;

    original: dword;
    thistype: integer;

    nrselected: integer;

begin
  newvaluest:=newvalue;
  if (newvalue='??') or (newvalue='NAN') or (newvalue='INF') then
  begin
    result:=1;
    exit;
  end;

  thistype:=memrec[recordnr].vartype;

  error:=0;

  case thistype of
    0,1,2,5,6: begin
                  val(newvaluest,newvalue6,error);
                  if error=0 then
                  begin
                    newvalue1:=byte(newvalue6);
                    newvalue2:=word(newvalue6);
                    newvalue3:=dword(newvalue6);
                  end;
                end;

    3,4:        begin
                  val(newvaluest,newvalue5,error);
                  newvalue4:=newvalue5;
                end;

    7:          begin
                  addzero:=false;
                  newvalue1:=0;

                  getmem(text,length(newvaluest));
                  StrCopy(text, PChar(newvaluest));

                  VirtualProtectEx(processhandle,  pointer(memrec[recordnr].Address),1,PAGE_EXECUTE_READWRITE,original);

                  writeprocessmemory(processhandle,pointer(memrec[recordnr].Address),text,length(newvaluest),write);
                  if addzero then writeprocessmemory(processhandle,pointer(memrec[recordnr].Address+length(newvaluest)),addr(newvalue1),1,write);

                  VirtualProtectEx(processhandle,  pointer(memrec[recordnr].Address),1,original,write);

                  memrec[recordnr].Frozenstring:=newvaluest;
                  freemem(text);
                  exit;
                end;

    8:          begin
                  if nrselected>1 then
                  begin
                    beep;
                    exit;
                  end;

                  for i:=1 to length(newvaluest) do
                  case newvaluest[i] of
                    '0'..'9' : ;
                    'a'..'f' : ;
                    'A'..'F' : ;
                    ' ','-' : ;
                    else raise exception.create('This is not a valid notation');
                  end;

                  ConvertStringToBytes(newvaluest,true,newvalue8);

                  memrec[recordnr].Bit:=length(newvalue8);
                  setlength(memrec[recordnr].frozenbytes,length(newvalue8));

                  for i:=0 to length(newvalue8)-1 do
                    memrec[recordnr].frozenbytes[i]:=newvalue8[i];

                  VirtualProtectEx(processhandle,  pointer(memrec[recordnr].Address),1,PAGE_EXECUTE_READWRITE,original);
                  writeprocessmemory(processhandle,pointer(memrec[recordnr].Address),@memrec[recordnr].frozenbytes[0],length(newvalue8),write);
                  //set old security back
                  VirtualProtectEx(processhandle,  pointer(memrec[recordnr].Address),1,original,write);
                  setlength(newvalue8,0);
                  exit;
                end;
  end;


  if error>0 then raise Exception.Create('This is not a valid value!');

  i:=recordnr;

  begin
    begin