unit UnitMemorySearch; interface uses tlhelp32,strutils, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls,DBCtrls; type TFrmMemory = class(TForm) ListAdress: TListBox; BtnFirst: TButton; BtnNext: TButton; Label1: TLabel; Edvalue1: TEdit; Label2: TLabel; ComMod: TComboBox; Edvalue2: TEdit; Label4: TLabel; Edname: TEdit; Label5: TLabel; ComTypes: TComboBox; Label6: TLabel; stList: TListBox; Button1: TButton; ProgressBar1: TProgressBar; Edit1: TEdit; Label7: TLabel; BitBtn1: TBitBtn; Labpro: TLabel; Listgetadr: TListBox; BtnAdd: TButton; Label9: TLabel; Edread: TEdit; Label10: TLabel; Edwrite: TEdit; Label11: TLabel; BtnWrite: TButton; BtnRead: TButton; Label12: TLabel; LabTime: TLabel; BtnSave: TButton; ListVal: TListBox; BtnAddVal1: TButton; BtnAddval2: TButton; BtnDelete: TButton; BtnSaveVal: TButton; BtnRAdd: TButton; Timer1: TTimer; CheckBox1: TCheckBox; BtnProset: TButton; labDebug: TLabel; ListTask: TListBox; BtnDelTask: TButton; BtnAddTask: TButton; Label13: TLabel; Label14: TLabel; Label15: TLabel; Label16: TLabel; ComTask: TComboBox; EdTaskAdr: TEdit; EdTaskVal: TEdit; Label17: TLabel; BtnResume: TButton; BtnRun: TButton; BtnTaskSave: TButton; Label18: TLabel; Timer2: TTimer; Memo1: TMemo; Timer3: TTimer; Label8: TLabel; Label19: TLabel; Label20: TLabel; Memo2: TMemo; Memo3: TMemo; Memo4: TMemo; Memo5: TMemo; Memo6: TMemo; ListBox1: TListBox; TrackBar1: TTrackBar; Memo7: TMemo; Memo8: TMemo; Memo9: TMemo; Label3: TLabel; procedure BtnFirstClick(Sender: TObject); function GetmemoryValue(i,vsize:integer):integer; function FindAdress(trvalue,olvalue:integer):boolean; function FindAdress1(trvalue,olvalue:integer):boolean; procedure BtnNextClick(Sender: TObject); procedure Button1Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure ComModChange(Sender: TObject); procedure ListAdressDblClick(Sender: TObject); procedure BtnAddClick(Sender: TObject); procedure BtnReadClick(Sender: TObject); procedure BtnWriteClick(Sender: TObject); procedure ListAdressClick(Sender: TObject); procedure ListgetadrClick(Sender: TObject); procedure BtnSaveClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure BtnAddVal1Click(Sender: TObject); procedure BtnDeleteClick(Sender: TObject); procedure BtnSaveValClick(Sender: TObject); procedure BtnAddval2Click(Sender: TObject); procedure ListValClick(Sender: TObject); procedure ListValDblClick(Sender: TObject); procedure BtnRAddClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure BtnProsetClick(Sender: TObject); procedure SetCase; procedure BtnDelTaskClick(Sender: TObject); procedure BtnAddTaskClick(Sender: TObject); procedure BtnRunClick(Sender: TObject); procedure BtnResumeClick(Sender: TObject); procedure BtnTaskSaveClick(Sender: TObject); function readpai(caradr:int64):integer; procedure searchvalue(serval1WORD;serval2WORD); procedure Timer2Timer(Sender: TObject); procedure Timer3Timer(Sender: TObject); procedure FormShow(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); private { Private declarations } public prohand,ProID:HWND; SmodSize:integer; minadr,maxadr:int64; { Public declarations } end; var searchTime:integer=0; mb,p:^char; FrmMemory: TFrmMemory; BaseAdr:int64=$00400000; oldvalue,value,value2,Casei,dizhu:integer; mycaradr,leftcaradr,rightcaradr,mycardcountstr,lefitcountstr,rightcountstr,backcardstr:int64; mildoldcardcount,lefitoldcount,rightoldcount,lastpaiquan:integer; mildoldsendcount,leftoldsendcount,rightoldsendcount:integer; lastmidsendcardlist,lastleftsendcardlist,lastrightsendcardlist: array[1..15] of integer; lastsendcardstr,mesendstr,nextsendstr,lastthisstr,nextthisstr,methisstr,mecardstr,nodicardstr:string; oldlastsendcardstr,oldnextsendstr,oldlastthisstr,oldnextthisstr:string; oldleftsendcount,oldrightsendcount,oldleftallsendcount,oldrightallsendcount:integer; mygame:HWND; ispo1:boolean; hHook:integer; shuinum:integer; const WH_MOUSE_LL = 14; implementation uses unitprolist,UnitSet,unit1, Unit2; {$R *.dfm} procedure RunPro; var i:integer; begin for i:=2 to 10 do begin frmmemory.ProgressBar1.Position:=i*10; sleep(5); end; frmmemory.ProgressBar1.Position:=0; end; {//GetmemoryValue} function TFrmMemory.GetmemoryValue(i,vsize:integer):integer; var byte1,byte2,byte3,byte4:char; TrueValue:integer; begin if vsize=1 then begin p:=mb; inc(p,i); result:=integer(P^); end else if vsize=2 then begin p:=mb; inc(p,i); byte1:=p^; inc(p); byte2:=p^; TrueValue:=integer(byte1)+integer(byte2)*16*16; result:=TrueValue ; end else if vsize=4 then begin p:=mb; inc(p,i); byte1:=p^; inc(p); byte2:=p^; inc(p); byte3:=p^; inc(p); byte4:=p^; TrueValue:=integer(byte1)+integer(byte2)*16*16; TrueValue:=TrueValue+integer(byte3)*16*16*16*16; TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16; result:=TrueValue; end; //转自 棋牌基地 http://www.2qipai.com end; / procedure TFrmMemory.SetCase; begin if commod.Text ='精确值'then begin Casei:=1; end else if commod.Text ='大于'then begin Casei:=2; end else if commod.Text ='小于'then begin Casei:=3; end else if commod.Text ='增加'then begin Casei:=4; end else if commod.Text ='减少'then begin Casei:=5; end else if commod.Text ='increased by'then begin Casei:=6; end else if commod.Text ='decreased by'then begin Casei:=7; end else if commod.Text ='between'then begin Casei:=8; end ; end; function TFrmMemory.FindAdress(Trvalue,Olvalue:integer):boolean;{findadress} begin result:=false; case Casei of 1: begin if trvalue=value then result:=true; end ; 2: begin if trvalue>value then result:=true; end; 3: begin if trvalue<value then result:=true; end; 4: begin if trvalue>olvalue then result:=true; end; 5: begin if trvalue<olvalue then result:=true; end; 6: begin if trvalue>olvalue then result:=true; end ; 7: begin if trvalue<olvalue then result:=true; end ; 8: begin if (trvalue>=value) and (trvalue<=value2) then result:=true; end ; end; end;{end findadress} function TFrmMemory.FindAdress1(Trvalue,Olvalue:integer):boolean;{findadress} begin result:=false; case Casei of 1: begin if trvalue=value then result:=true; end ; 2: begin if trvalue>value then result:=true; end; 3: begin if trvalue<value then result:=true; end; 4: begin if trvalue>olvalue then result:=true; end; 5: begin if trvalue<olvalue then result:=true; end; 6: begin if trvalue>olvalue then result:=true; end ; 7: begin if trvalue<olvalue then result:=true; end ; 8: begin if (trvalue>=value) and (trvalue<=value2) then result:=true; end ; end; end;{end findadress} // //通过EXE文件名获得指定可执行文件的进程ID function FindProcessID(sName:string):THandle; var csH:THandle; ps:TProcessEntry32; iFlag:byte; b:boolean; begin iFlag := 0; result := 0; csH := tlHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPALL,0); ps.dwSize := sizeof(TProcessEntry32); try b := tlHelp32.Process32First(csh,ps); if b then begin while tlHelp32.Process32Next(csH,ps) do begin if pos(sName,strpas(ps.szExeFile)) > 0 then begin result := ps.th32ProcessID; //showmessage(inttostr(result)+' '+inttostr(ps.th32ParentProcessID )+' '+inttostr(ps.cntThreads) ) ; exit; end; end; end; finally closeHandle(csH); end; end;{end function FindProcessID} procedure TFrmMemory.searchvalue(serval1WORD;serval2WORD); var Fname:string; ass,i,valsize:integer; siz:Cardinal; byte1,byte2,byte3,byte4:char; TrueValue:integer; begin value:=serval1; value2:=serval2; // showmessage(inttostr(value)); Fname:=edname.Text ; BaseAdr:=minadr; /// if (listadress.Count=0) then begin if value=0 then exit; btnfirst.Caption :='NewSet'; btnnext.Enabled :=True; progressbar1.Position:=20; valsize:=strtoint(comtypes.Text); comtypes.Enabled:=false; end else begin listadress.Clear ; listbox1.Clear; btnnext.Enabled :=False; btnfirst.Caption :='BtnFirst'; comtypes.Enabled:=true; labtime.Caption:='搜索次数:0' ; exit; end; / //BaseAdr:=$00400000; 2143289344 prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then exit; setcase;//设置全局变量 搜索类型 try listadress.Clear ; listbox1.Clear; btnfirst.Enabled :=false; mb:=AllocMem(SmodSize); while BaseAdr<maxadr do begin readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz); if siz>0 then begin p:=mb; // inc(p,89990); // listadress.Items.Add(inttohex(baseadr,8)+'--'+inttostr(byte(p^))); byte1:=p^; inc(p); byte2:=p^; inc(p); byte3:=p^; inc(p); byte4:=p^; case valsize of 4:begin TrueValue:=integer(byte1)+integer(byte2)*16*16; TrueValue:=TrueValue+integer(byte3)*16*16*16*16; TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16; end; 2: TrueValue:=integer(byte1)+integer(byte2)*16*16; 1: TrueValue:=integer(byte1); end; if findadress(truevalue,oldvalue) then listadress.Items.Add(inttohex(baseadr,8)+' '+inttostr(Truevalue)); // findadress(siz); truevalue=value for i:=1 to siz-1 do begin byte1:=byte2; byte2:=byte3; byte3:=byte4; inc(p); byte4:=p^; case valsize of 4:begin TrueValue:=integer(byte1)+integer(byte2)*16*16; TrueValue:=TrueValue+integer(byte3)*16*16*16*16; TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16; end; 2: TrueValue:=integer(byte1)+integer(byte2)*16*16; 1: TrueValue:=integer(byte1); end;{end case} if findadress(truevalue,oldvalue) then listadress.Items.Add(inttohex(baseadr+i,8));//+' '+inttostr(Truevalue)); end;{end for} end; BaseAdr:=BaseAdr+SmodSize; { inc(p,88888); ass:=byte(p^); listadress.Items.Add(inttostr(ass)); listadress.Items.Add(inttohex(baseadr,8)+'_____ '+inttostr(siz));} end; finally freemem(mb,SmodSize); closehandle(Prohand); label7.Caption:='搜索到记录:'+inttostr(listadress.Count); runpro; oldvalue:=value; btnfirst.Enabled:=True; searchtime:=1; labtime.Caption:='搜索次数:'+inttostr(searchtime)+'次'; end; end; procedure TFrmMemory.BtnFirstClick(Sender: TObject); begin searchvalue($37010007,0); end; //NEXT 查找事件代码!!!!!!!!!!!!! procedure TFrmMemory.BtnNextClick(Sender: TObject); var Fname,isv:string; oldadress,fi:int64; TrueValue,i,value1,i2,i3,valsize:integer; byte1,byte2,byte3,byte4:char; siz:Cardinal; begin isv:=edvalue1.Text; trim(isv); if isv='' then exit; value1:=strtoint(edvalue1.Text ); //showmessage(inttostr(value1)); Fname:=edname.Text ; stlist.Items.Clear; BaseAdr:=minadr;// 2143289344 prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then exit; setcase; value:=strtoint(edvalue1.Text ); value2:=strtoint(edvalue2.Text ); progressbar1.Position:=20; valsize:=strtoint(comtypes.Text); try btnfirst.Enabled :=false; mb:=AllocMem(SmodSize); i3:=listadress.Count-1; readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz); for i:=0 to i3 do // while BaseAdr<$7FFFFFFF do begin{for begin} oldadress:=strtoint('$'+leftstr(listadress.Items.Strings,8)); oldvalue:=strtoint(midstr(listadress.Items.Strings,11,8 )); fi:= oldadress-baseadr; if fi>=(Smodsize-3) then begin while fi>=(Smodsize-3) do begin baseadr :=baseadr+SmodSize; fi:=oldadress-baseadr; end; readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz); end; {if fi>=89997 begin} i2:=fi; if siz>0 then begin p:=mb; inc(p,i2); byte1:=p^; inc(p); byte2:=p^; inc(p); byte3:=p^; inc(p); byte4:=p^; case valsize of 4:begin TrueValue:=integer(byte1)+integer(byte2)*16*16; TrueValue:=TrueValue+integer(byte3)*16*16*16*16; TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16; end; 2: TrueValue:=integer(byte1)+integer(byte2)*16*16; 1: TrueValue:=integer(byte1); end; if findadress(truevalue,oldvalue) then stlist.Items.Add(leftstr(listadress.Items.Strings,8)); // if truevalue=value1 then stlist.Items.Add(inttohex(oldadress,8)+' '+inttostr(Truevalue)); end; {if siz end} end;{for end} listadress.Items.Clear ; i:= stlist.Items.Count-1; for i3:=0 to i do begin Fname:= stlist.Items.Strings[i3]; listadress.Items.Add(Fname); end; finally // lnowindex:=0; freemem(mb,SmodSize); closehandle(Prohand); runpro; label7.Caption:='搜索到记录:'+inttostr(listadress.Count); //转自 棋牌基地 http://www.2qipai.com btnfirst.Enabled:=True; searchtime:=searchtime+1; labtime.Caption:='搜索次数:'+inttostr(searchtime)+'次'; end; end; procedure TFrmMemory.Button1Click(Sender: TObject); var ffa:int64; selvalue:integer; selstr:string; begin listgetadr.DeleteSelected; //edit1.Text :=inttostr( listadress.SelCount) ; //selvalue:=listadress.ItemIndex; // listadress.Items.Delete(selvalue); // listadress.Selected[1]:=true; //selvalue:= listadress.Count; //selstr:='$'+listadress.Items.Strings [selvalue]; // ffa:= strtoint('$'+listadress.Items.Strings [selvalue]); //edit1.Text :=inttostr(ffa) //edit1.Text :=listadress.Items.Strings [selvalue]; // edit1.Text := inttostr(selvalue); end; procedure TFrmMemory.BitBtn1Click(Sender: TObject); begin frmprolist.Show; end; procedure TFrmMemory.ComModChange(Sender: TObject); begin if commod.text='between' then edvalue2.Enabled:=True else edvalue2.Enabled:=false; end; procedure TFrmMemory.ListAdressDblClick(Sender: TObject); var ffa:int64; selvalue:integer; selstr:string; begin selvalue:=listadress.ItemIndex; edit1.Text :=leftstr(listadress.Items.Strings [selvalue],8); listgetadr.Items.Add(edit1.Text); end; procedure TFrmMemory.BtnAddClick(Sender: TObject); var st1:string; ad1:int64; begin st1:=inputbox('添加地址','输入十六进制要加符号:$','$'); if (trim(st1)='') or (trim(st1)='$') then exit; try ad1:=strtoint(st1); listgetadr.Items.Add(inttohex(ad1,8)); except end; end; procedure TFrmMemory.BtnReadClick(Sender: TObject); var Readadr:int64; Rvalue,size:integer; siz:Cardinal; begin if trim(edit1.Text )='' then begin edname.Text:='失败!';exit; end; if trim(edit1.Text )='' then begin edname.Text:='失败!';exit; end; Rvalue:=0; size:=strtoint(comtypes.Text); Readadr:=strtoint('$'+edit1.Text); prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then if Prohand=0 then begin edname.Text:='失败!';exit; end; try readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz); edname.Text:='读取成功!'; finally closehandle(prohand); edread.Text :=inttostr(rvalue); end; end; procedure TFrmMemory.BtnWriteClick(Sender: TObject); var Writeadr:int64; Wvalue,size:integer; siz:Cardinal; begin if trim(edWrite.Text )='' then begin edname.Text:='失败!';exit; end; Wvalue:=strtoint(edwrite.Text); size:=strtoint(comtypes.Text); Writeadr:=strtoint('$'+edit1.Text); prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then begin edname.Text:='失败!';exit; end; try writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz); edname.Text:='修改成功'; finally closehandle(prohand); end; end; procedure TFrmMemory.ListAdressClick(Sender: TObject); var ffa:int64; selvalue:integer; selstr:string; begin selvalue:=listadress.ItemIndex; edit1.Text :=leftstr(listadress.Items.Strings [selvalue],8); end; procedure TFrmMemory.ListgetadrClick(Sender: TObject); var ffa:int64; selvalue:integer; selstr:string; begin selvalue:=listgetadr.ItemIndex; edit1.Text :=leftstr(listgetadr.Items.Strings [selvalue],8); edtaskadr.Text:=edit1.text; end; procedure TFrmMemory.BtnSaveClick(Sender: TObject); begin listgetadr.Items.SaveToFile('SaveAdress.txt'); showmessage('保存成功!'); end; function HookProc(iCode: Integer; //处理系统钩子的函数 wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export; //书写调用规则,记得加 stdcall var mstruct:^TMouseHookStruct; temppoint:tpoint; gamename:array[0..30] of char; begin if wparam=WM_rbuttondown then begin if ispo1 then begin mstruct:=Pointer(lparam); ispo1:=false; mygame:=WindowFromPoint(mstruct.pt); getwindowtext(mygame,gamename,30); end; end; Result:=CallNextHookEx(hHook,icode,wparam,lparam); end; function EnableDebugPriv: Boolean; //提升进程权限为DEBUG权限 var hToken: THandle; tp: TTokenPrivileges; rl: Cardinal; begin Result := false; OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken); if LookupPrivilegeValue(nil, 'SeDebugPrivilege', tp.Privileges[0].Luid) then begin tp.PrivilegeCount:=1; tp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED; Result := AdjustTokenPrivileges(hToken, false, tp, SizeOf(tp), nil, rl); end; end; function Myrandom(Num: Integer): integer; var T: _SystemTime; X: integer; I: integer; begin Result := 0; GetSystemTime(T); X := T.wDayOfWeek * T.wYear * T.wMilliseconds*T.wSecond * (random(Num)+1) + Random(1); if X < 0 then X := -X; X := Random(X); if(num = 0) then Exit; X := X mod num; for I := 0 to X do //通过随机发生次数来控制产生不同的随机数 X := Random(Num); Result := X; end; procedure TFrmMemory.FormCreate(Sender: TObject); var SysTime: TsystemTime; DosTime:Integer; FileTime:TFileTime; begin hHook:=SetWindowsHookEx(WH_MOUSE_LL,HookProc,Hinstance,0); //[Error] HookMsg.dpr(65): Incompatible types: 'Calling conventions differ' //if fileexists('SaveAdress.txt')=True then //listgetadr.Items.LoadFromFile('SaveAdress.txt') ; //if fileexists('listval.txt')=True then //listval.Items.LoadFromFile('listval.txt') ; //if fileexists('listtask.txt')=True then //listtask.Items.LoadFromFile('listtask.txt') ; Smodsize:=900000; minadr:=$004D0000; maxadr:=$004E0000; mycaradr:=0; dizhu:=4; ispo1:=false; mygame:=0; GetSystemTime(SysTime); SystemTimeToFileTime(SysTime,FileTime); FileTimeToDosDateTime(FileTime,LongRec(DosTime).Hi,longRec(DosTime).Lo); shuinum:=DosTime; end; procedure TFrmMemory.BtnAddVal1Click(Sender: TObject); begin listval.Items.Add(edwrite.Text ); end; procedure TFrmMemory.BtnDeleteClick(Sender: TObject); begin listval.DeleteSelected; end; procedure TFrmMemory.BtnSaveValClick(Sender: TObject); begin listval.Items.SaveToFile('Listval.txt'); showmessage('保存成功!'); end; procedure TFrmMemory.BtnAddval2Click(Sender: TObject); var st1:string; ad1:int64; begin st1:=inputbox('添加地址','输入十六进制要加符号:$','$'); if (trim(st1)='') or (trim(st1)='$') then exit; try ad1:=strtoint(st1); listval.Items.Add(inttostr(ad1)); except end; end; procedure TFrmMemory.ListValClick(Sender: TObject); var ffa:int64; selvalue:integer; selstr:string; begin selvalue:=listval.ItemIndex; edname.Text :=listval.Items.Strings [selvalue]; edtaskval.Text:=edname.Text ; end; procedure TFrmMemory.ListValDblClick(Sender: TObject); var ffa:int64; selvalue:integer; selstr:string; begin selvalue:=listval.ItemIndex; edwrite.Text :=listval.Items.Strings [selvalue]; end; procedure TFrmMemory.BtnRAddClick(Sender: TObject); begin listval.Items.Add(edread.Text ); end; procedure TFrmMemory.Timer1Timer(Sender: TObject); begin try BtnRunClick(Sender); except checkbox1.Checked :=false; timer1.Enabled:=false; end; end; procedure TFrmMemory.CheckBox1Click(Sender: TObject); begin if checkbox1.Checked =true then begin timer1.Enabled:=True; end else begin timer1.Enabled:=false; end; end; procedure TFrmMemory.BtnProsetClick(Sender: TObject); begin frmset.Show; end; procedure TFrmMemory.BtnDelTaskClick(Sender: TObject); begin listtask.DeleteSelected; end; procedure TFrmMemory.BtnAddTaskClick(Sender: TObject); var Readadr:int64; Rvalue,Wvalue,size:integer; siz:Cardinal; begin if (Trim(edtaskadr.Text )='') or (Trim(edtaskval.Text)='') then exit; Rvalue:=0; size:=strtoint(comtask.Text); wvalue:=strtoint(edtaskval.Text); Readadr:=strtoint('$'+edtaskadr.Text); prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then begin listtask.Items.Add(inttohex(wvalue,8) +'--'+comtask.Text +'--'+format('%8d',[wvalue])+'--失败' ); exit; end; try readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz); edname.Text:='读取成功!'; //转自 棋牌基地 http://www.2qipai.com finally closehandle(prohand); listtask.Items.Add(inttohex(wvalue,8) +'--'+comtask.Text +'--'+format('%8d',[wvalue])+'--'+inttostr(rvalue) ); end; end; procedure TFrmMemory.BtnRunClick(Sender: TObject); var Writeadr:int64; Wvalue,Flag,size,count:integer; siz:Cardinal; begin prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then begin edname.Text:='批量失败!';exit; end; try for count:=0 to listtask.Items.Count-1 do begin writeadr:=strtoint('$'+leftstr(listtask.Items.Strings[count],8)); size:= strtoint(midstr(listtask.Items.Strings[count],11,1)); wvalue:=strtoint(midstr(listtask.Items.Strings[count],14,8)); writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz); end; finally closehandle(prohand); edname.Text:='批量修改成功'; end;{end try} end; procedure TFrmMemory.BtnResumeClick(Sender: TObject); var Writeadr:int64; Wvalue,Flag,size,count:integer; Loststr:string; siz:Cardinal; begin prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then begin edname.Text:='批量恢复失败!';exit; end; try for count:=0 to listtask.Items.Count-1 do begin writeadr:=strtoint('$'+leftstr(listtask.Items.Strings[count],8)); size:= strtoint(midstr(listtask.Items.Strings[count],11,1)); Loststr:=trim(midstr(listtask.Items.Strings[count],24,8)); if loststr<>'失败' then begin wvalue:=strtoint(loststr); writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz); end; end; finally closehandle(prohand); edname.Text:='批量恢复成功'; end;{end try} end; procedure TFrmMemory.BtnTaskSaveClick(Sender: TObject); begin listtask.Items.SaveToFile('ListTask.txt'); showmessage('保存成功!'); end; // Get Window Handle By ProcessID function GetPIDByHWnd(const hWnd: THandle): THandle; var PID: DWORD; begin if hWnd<>0 then begin GetWindowThreadProcessID(hWnd, @PID); Result:=PID; end else Result:=0; end; procedure SetPrivilege; var OldTokenPrivileges, TokenPrivileges: TTokenPrivileges; ReturnLength: dword; hToken: THandle; Luid: int64; begin OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken); LookupPrivilegeValue(nil, 'SeDebugPrivilege', Luid); TokenPrivileges.Privileges[0].luid := Luid; TokenPrivileges.PrivilegeCount := 1; TokenPrivileges.Privileges[0].Attributes := 0; AdjustTokenPrivileges(hToken, False, TokenPrivileges, SizeOf(TTokenPrivileges), OldTokenPrivileges, ReturnLength); OldTokenPrivileges.Privileges[0].luid := Luid; OldTokenPrivileges.PrivilegeCount := 1; OldTokenPrivileges.Privileges[0].Attributes := TokenPrivileges.Privileges[0].Attributes or SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, OldTokenPrivileges, ReturnLength, PTokenPrivileges(nil)^, ReturnLength); end; procedure TFrmMemory.Timer2Timer(Sender: TObject); var i:integer; mygametemp:HWND; gamename:array[0..30] of char; begin mygametemp:=0; mygametemp:=findwindow(nil,PChar(inttostr(shuinum))); if mygametemp<>0 then begin mygame:=mygametemp; proID:=GetPIDByHWnd(mygame); if (listbox1.Count=0) then begin listadress.Clear; searchvalue($00070000,0); if listadress.Count<>0 then begin for i:=0 to listadress.Count-1 do if (readpai(strtoint('$'+leftstr(ListAdress.items.Strings,8))+8)=3) then listbox1.Items.Add(ListAdress.items.Strings); end; if (listbox1.Count=1) then mycaradr:=strtoint('$'+leftstr(listbox1.items.Strings[0],8))+50 else if (listbox1.Count>1) then mycaradr :=strtoint('$'+leftstr(listbox1.items.Strings[1],8))+50; end; if (listbox1.Count=0) then begin listadress.Clear; searchvalue($00080000,0); if listadress.Count<>0 then begin for i:=0 to listadress.Count-1 do if (readpai(strtoint('$'+leftstr(ListAdress.items.Strings,8))+8)=3) then listbox1.Items.Add(ListAdress.items.Strings); end; if (listbox1.Count=1) then mycaradr:=strtoint('$'+leftstr(listbox1.items.Strings[0],8))+50 else if (listbox1.Count>1) then mycaradr :=strtoint('$'+leftstr(listbox1.items.Strings[1],8))+50; end; end else begin mycaradr:=0; dizhu:=4; listadress.Clear; listbox1.Clear; memo1.Clear; memo2.Clear; memo3.Clear; memo4.Clear; memo5.Clear; memo6.Clear; form1.Memo1.Clear; form1.Label1.Caption:=''; mygame:=findwindow(nil,'斗地主角色版'); if mygame<>0 then setwindowtext(mygame,PChar(inttostr(shuinum))); end; end; function TFrmMemory.readpai(caradr:int64):integer; var Readadr:int64; Rvalue,size:integer; siz:Cardinal; begin Rvalue:=0; size:=1; Readadr:=caradr; prohand:=openprocess($1F0FFF,false,proID); if Prohand=0 then if Prohand=0 then begin edname.Text:='失败!';exit; end; try readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz); // edname.Text:='读取成功!'; finally closehandle(prohand); // edread.Text :=inttostr(rvalue); result:= rvalue; end; end; function getpai(cardint:integer):string; begin case cardint of 1: result:= '1'; 2: result:= '2'; 3: result:= '3'; 4: result:= '4'; 5: result:= '5'; 6: result:= '6'; 7: result:= '7'; 8: result:= '8'; 9: result:= '9'; 10: result:= '10'; 11: result:= 'J'; 12: result:= 'Q'; 13: result:= 'K'; 14: result:= '小王'; 15: result:= '大王'; end; end; function cardlistturnstr(cardlist:array of integer):string; var carstr:string; i:integer; begin carstr:=''; for i:=0 to 14 do begin carstr:=carstr+inttostr(cardlist); end; result:=carstr; end; procedure TFrmMemory.Timer3Timer(Sender: TObject); var cardvalue,cardtype,i,j,mycardcount,lefitcount,rightcount,k,thispaiquan,passcount,nodicount:integer; mycard,sendcard:string; nosendcard: array[0..4,1..15] of boolean; cardlist: array[1..15] of integer; ruku,firstsend:boolean; mildsendcount,leftsendcount,rightsendcount:integer; mildallsendcount,leftallsendcount,rightallsendcount:integer; gamenamestring:string; gamename:array[0..30] of char; begin if mygame=0 then exit; getwindowtext(mygame,gamename,30); gamenamestring:=gamename; if gamenamestring<>inttostr(shuinum) then exit; if (mycaradr<>0) then begin ruku:=false; firstsend:=false; mycardcountstr:=mycaradr+320; lefitcountstr:=mycaradr+2408; rightcountstr:=mycaradr-1768; leftcaradr :=lefitcountstr-320; rightcaradr :=rightcountstr-320; mycardcount:= readpai(mycardcountstr); lefitcount:= readpai(lefitcountstr); rightcount:= readpai(rightcountstr); thispaiquan:=-1; if mildoldcardcount<>mycardcount then begin mildsendcount:= mildoldcardcount-mycardcount; thispaiquan:=0; mildoldsendcount:= mildsendcount; end; if lefitoldcount<>lefitcount then begin leftsendcount:= lefitoldcount-lefitcount; thispaiquan:=2; leftoldsendcount:= leftsendcount; end; if rightoldcount<>rightcount then begin rightsendcount:= rightoldcount-rightcount; thispaiquan:=1; rightoldsendcount:=rightsendcount; end; mildoldcardcount:=mycardcount; lefitoldcount:=lefitcount; rightoldcount:=rightcount; if thispaiquan<>-1 then begin if (thispaiquan<lastpaiquan) then passcount:= thispaiquan+3-lastpaiquan else passcount:= thispaiquan-lastpaiquan; if passcount=0 then begin ZeroMemory(@lastmidsendcardlist,sizeof(lastmidsendcardlist)); ZeroMemory(@lastleftsendcardlist,sizeof(lastleftsendcardlist)); ZeroMemory(@lastrightsendcardlist,sizeof(lastrightsendcardlist)); memo7.Text:=''; memo8.Text:=''; memo9.Text:=''; if thispaiquan=0 then begin leftoldsendcount:= 0; rightoldsendcount:=0; oldleftsendcount:=0; oldlastthisstr:=''; oldrightsendcount:=0; oldnextthisstr:=''; end else if thispaiquan=1 then begin mildoldsendcount:= 0; leftoldsendcount:= 0; oldleftsendcount:=0; oldlastthisstr:=''; mildoldsendcount:=0; methisstr:=''; end else if thispaiquan=2 then begin mildoldsendcount:= 0; rightoldsendcount:=0; mildoldsendcount:=0; methisstr:=''; oldrightsendcount:=0; oldnextthisstr:=''; end; ruku:=true; firstsend:=true; //入库 end else if passcount=1 then begin if thispaiquan=0 then ruku:=true; //入库 end else if passcount=2 then begin if thispaiquan=0 then begin ZeroMemory(@lastleftsendcardlist,sizeof(lastleftsendcardlist)) ; memo7.Text:=''; oldleftsendcount:=0; oldlastthisstr:=''; ruku:=true; //入库 end else if thispaiquan=1 then begin ZeroMemory(@lastmidsendcardlist,sizeof(lastmidsendcardlist)); memo9.Text:=''; mildoldsendcount:=0; methisstr:=''; ruku:=true; //入库 end else if thispaiquan=2 then begin ZeroMemory(@lastrightsendcardlist,sizeof(lastrightsendcardlist)); memo8.Text:=''; oldrightsendcount:=0; oldnextthisstr:=''; end; end; lastpaiquan:=thispaiquan; end; if ((mycardcount=20) or (lefitcount=20) or (rightcount=20)) then begin oldleftsendcount:=0; oldlastthisstr:=''; oldrightsendcount:=0; oldnextthisstr:=''; mildoldsendcount:=0; methisstr:=''; ruku:=false; end; if ( (lefitoldcount=20) or (rightoldcount=20)) then ruku:=false; if mycardcount=20 then begin dizhu:=0; lastpaiquan:=dizhu; end; if lefitcount=20 then begin dizhu:=2; lastpaiquan:=dizhu; end ; if rightcount=20 then begin dizhu:=1 ; lastpaiquan:=dizhu; end else if( rightcount=0) and (lefitcount=0) and (mycardcount=0 )then dizhu:=4; if dizhu=0 then label8.Caption:='地主 中:'+inttostr(mycardcount)+' ' else label8.Caption:='中:'+inttostr(mycardcount)+' '; if dizhu=2 then label19.Caption:='地主 左:'+inttostr(lefitcount)+' ' else label19.Caption:='左:'+inttostr(lefitcount)+' '; if dizhu=1 then label20.Caption:='地主 右:'+inttostr(rightcount)+' ' else label20.Caption:='右:'+inttostr(rightcount)+' '; ZeroMemory(@nosendcard,sizeof(nosendcard)); ZeroMemory(@cardlist,sizeof(cardlist)); mycard:=''; for i:=0 to 19 do begin cardtype:=readpai(mycaradr+8*i); cardvalue :=readpai(mycaradr+1+8*i); if (cardvalue>0) and (cardvalue<16)and (i<mycardcount) then begin case cardtype of 1: mycard:=mycard+'黑'+inttostr(cardvalue)+' '; 2: mycard:=mycard+'红'+inttostr(cardvalue)+' '; 3: mycard:=mycard+'梅'+inttostr(cardvalue)+' '; 4: mycard:=mycard+'方'+inttostr(cardvalue)+' '; 0: mycard:=mycard+' '+inttostr(cardvalue)+' '; end; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; if (i<mycardcount) then if (cardvalue>0) and (cardvalue<16) then nosendcard[cardtype,cardvalue]:=true; end; mecardstr:=cardlistturnstr(cardlist); mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; memo1.Lines.Text:=mycard; ZeroMemory(@cardlist,sizeof(cardlist)); if mycard='' then begin mycard:=''; for i:=0 to 19 do begin cardtype:=readpai(leftcaradr+8*i); cardvalue :=readpai(leftcaradr+1+8*i); if (cardvalue>0) and (cardvalue<16) and (i<lefitcount)then begin case cardtype of 1: mycard:=mycard+'黑'+inttostr(cardvalue)+' '; 2: mycard:=mycard+'红'+inttostr(cardvalue)+' '; 3: mycard:=mycard+'梅'+inttostr(cardvalue)+' '; 4: mycard:=mycard+'方'+inttostr(cardvalue)+' '; 0: mycard:=mycard+' '+inttostr(cardvalue)+' '; end; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; if (i<mycardcount) then if (cardvalue>0) and (cardvalue<16) then nosendcard[cardtype,cardvalue]:=true; end; mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; memo2.Lines.Text:=mycard; end; ZeroMemory(@cardlist,sizeof(cardlist)); if mycard='' then begin mycard:=''; for i:=0 to 19 do begin cardtype:=readpai(rightcaradr+8*i); cardvalue :=readpai(rightcaradr+1+8*i); if (cardvalue>0) and (cardvalue<16) and (i<rightcount) then begin case cardtype of 1: mycard:=mycard+'黑'+inttostr(cardvalue)+' '; 2: mycard:=mycard+'红'+inttostr(cardvalue)+' '; 3: mycard:=mycard+'梅'+inttostr(cardvalue)+' '; 4: mycard:=mycard+'方'+inttostr(cardvalue)+' '; 0: mycard:=mycard+' '+inttostr(cardvalue)+' '; end; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; if (i<mycardcount) then if (cardvalue>0) and (cardvalue<16) then nosendcard[cardtype,cardvalue]:=true; end; mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; memo3.Lines.Text:=mycard; end; ZeroMemory(@cardlist,sizeof(cardlist)); if (mildsendcount>0) then ZeroMemory(@lastmidsendcardlist,sizeof(lastmidsendcardlist)); mycard:=''; k:=0; mildallsendcount:=0; for i:=19 downto 0 do begin cardtype:=readpai(mycardcountstr+20+8*i); cardvalue :=readpai(mycardcountstr+21+8*i); if (cardvalue>0) and (cardvalue<16) then begin case cardtype of 1: mycard:=mycard+'黑'+inttostr(cardvalue)+' '; 2: mycard:=mycard+'红'+inttostr(cardvalue)+' '; 3: mycard:=mycard+'梅'+inttostr(cardvalue)+' '; 4: mycard:=mycard+'方'+inttostr(cardvalue)+' '; 0: mycard:=mycard+' '+inttostr(cardvalue)+' '; end; mildallsendcount:= mildallsendcount+1; if (k<mildsendcount) then lastmidsendcardlist[cardvalue]:= lastmidsendcardlist[cardvalue]+1; k:=k+1; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; if mildsendcount>0 then methisstr:=cardlistturnstr(lastmidsendcardlist); mesendstr:=cardlistturnstr(cardlist); if (cardvalue>0) and (cardvalue<16) then nosendcard[cardtype,cardvalue]:=true; end; mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; memo4.Lines.Text:=mycard; if mildsendcount>0 then begin sendcard:=''; for i:=1 to 15 do if lastmidsendcardlist>0 then sendcard:=sendcard+inttostr(lastmidsendcardlist)+'个'+getpai(i)+', '; memo9.Lines.Text:=sendcard; end; ZeroMemory(@cardlist,sizeof(cardlist)); if (leftsendcount>0) then ZeroMemory(@lastleftsendcardlist,sizeof(lastleftsendcardlist)); mycard:=''; k:=0; leftallsendcount:=0; for i:=19 downto 0 do begin cardtype:=readpai(lefitcountstr+20+8*i); cardvalue :=readpai(lefitcountstr+21+8*i); if (cardvalue>0) and (cardvalue<16) then begin case cardtype of 1: mycard:=mycard+'黑'+inttostr(cardvalue)+' '; 2: mycard:=mycard+'红'+inttostr(cardvalue)+' '; 3: mycard:=mycard+'梅'+inttostr(cardvalue)+' '; 4: mycard:=mycard+'方'+inttostr(cardvalue)+' '; 0: mycard:=mycard+' '+inttostr(cardvalue)+' '; end; leftallsendcount:= leftallsendcount+1; if (k<leftsendcount) then lastleftsendcardlist[cardvalue]:= lastleftsendcardlist[cardvalue]+1; k:=k+1; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; if leftsendcount>0 then lastthisstr:=cardlistturnstr(lastleftsendcardlist); lastsendcardstr:=cardlistturnstr(cardlist); if (cardvalue>0) and (cardvalue<16) then nosendcard[cardtype,cardvalue]:=true; end; mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; memo5.Lines.Text:=mycard; if leftsendcount>0 then begin sendcard:=''; for i:=1 to 15 do if lastleftsendcardlist>0 then sendcard:=sendcard+inttostr(lastleftsendcardlist)+'个'+getpai(i)+', '; memo7.Lines.Text:=sendcard; end; ZeroMemory(@cardlist,sizeof(cardlist)); if (rightsendcount>0) then ZeroMemory(@lastrightsendcardlist,sizeof(lastrightsendcardlist)); mycard:=''; k:=0; rightallsendcount:=0; for i:=19 downto 0 do begin cardtype:=readpai(rightcountstr+20+8*i); cardvalue :=readpai(rightcountstr+21+8*i); if (cardvalue>0) and (cardvalue<16) then begin case cardtype of 1: mycard:=mycard+'黑'+inttostr(cardvalue)+' '; 2: mycard:=mycard+'红'+inttostr(cardvalue)+' '; 3: mycard:=mycard+'梅'+inttostr(cardvalue)+' '; 4: mycard:=mycard+'方'+inttostr(cardvalue)+' '; 0: mycard:=mycard+' '+inttostr(cardvalue)+' '; end; rightallsendcount:= rightallsendcount+1; if (k<rightsendcount) then lastrightsendcardlist[cardvalue]:= lastrightsendcardlist[cardvalue]+1; k:=k+1; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; if rightsendcount>0 then nextsendstr:=cardlistturnstr(cardlist); nextthisstr:=cardlistturnstr(lastrightsendcardlist); if (cardvalue>0) and (cardvalue<16) then nosendcard[cardtype,cardvalue]:=true; end; mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; memo6.Lines.Text:=mycard; if rightsendcount>0 then begin sendcard:=''; for i:=1 to 15 do if lastrightsendcardlist>0 then sendcard:=sendcard+inttostr(lastrightsendcardlist)+'个'+getpai(i)+', '; memo8.Lines.Text:=sendcard; end; ZeroMemory(@cardlist,sizeof(cardlist)); mycard:=''; for i:=1 to 4 do for j:=1 to 13 do begin if (nosendcard[j]=false) then begin case i of 1: mycard:=mycard+'黑'+inttostr(j)+' '; 2: mycard:=mycard+'红'+inttostr(j)+' '; 3: mycard:=mycard+'梅'+inttostr(j)+' '; 4: mycard:=mycard+'方'+inttostr(j)+' '; end; cardlist[j]:= cardlist[j]+1; end; end; if (nosendcard[0][14]=false) then mycard:=mycard+'小王 '; if (nosendcard[0][15]=false) then mycard:=mycard+'大王 '; mycard:=''; for i:=1 to 15 do if cardlist>0 then mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; form1.Memo1.Lines.Text := mycard; backcardstr:=mycaradr+39556; ZeroMemory(@cardlist,sizeof(cardlist)); mycard:=''; for i:=0 to 2 do begin cardtype:=readpai(backcardstr+8*i); cardvalue :=readpai(backcardstr+1+8*i); if (((cardvalue>11) and (cardvalue<16)) or ((cardvalue>0) and (cardvalue<3)))then begin case cardtype of 1: if nosendcard[cardtype][cardvalue] =false then begin mycard:=mycard+'黑'+inttostr(cardvalue)+' '; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; 2: if nosendcard[cardtype][cardvalue] =false then begin mycard:=mycard+'红'+inttostr(cardvalue)+' '; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; 3: if nosendcard[cardtype][cardvalue] =false then begin mycard:=mycard+'梅'+inttostr(cardvalue)+' '; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; 4: if nosendcard[cardtype][cardvalue] =false then begin mycard:=mycard+'方'+inttostr(cardvalue)+' '; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; 0: if nosendcard[cardtype][cardvalue] =false then begin mycard:=mycard+' '+inttostr(cardvalue)+' '; cardlist[cardvalue]:= cardlist[cardvalue]+1; end; end; end; end; mycard:=''; nodicount:=0; for i:=1 to 15 do if cardlist>0 then begin nodicount:=nodicount+cardlist; mycard:=mycard+inttostr(cardlist)+'个'+getpai(i)+', '; end; form1.label1.caption := mycard; nodicardstr:= cardlistturnstr(cardlist); if ((oldleftsendcount=0) and (oldrightsendcount=0) and (mildoldsendcount=0)) then ruku:=false; if (ruku and (dizhu<>4) and ((rightallsendcount+leftallsendcount+mildallsendcount+mycardcount+lefitcount+rightcount)=54)) then begin form2.DBNavigator1.BtnClick(nbLast ); form2.DBNavigator1.BtnClick(nbInsert); form2.DBEdit1.Text:=inttostr(dizhu); if (firstsend) and (mildsendcount>0) then begin form2.DBEdit2.Text :='True'; end else begin form2.DBEdit2.Text :='False'; end; form2.DBEdit10.Text:=inttostr(mycardcount); form2.DBEdit4.Text:=inttostr(oldleftallsendcount); form2.DBEdit6.Text:=inttostr(mildallsendcount); form2.DBEdit8.Text:=inttostr(oldrightallsendcount); form2.DBEdit12.Text:=inttostr(oldleftsendcount); form2.DBEdit14.Text:=inttostr(mildoldsendcount); form2.DBEdit16.Text:=inttostr(oldrightsendcount); form2.DBEdit18.Text:=inttostr(nodicount); form2.DBEdit3.Text:=oldlastsendcardstr; form2.DBEdit5.Text:=mesendstr; form2.DBEdit7.Text:=oldnextsendstr; form2.DBEdit9.Text:=mecardstr; form2.DBEdit11.Text:=oldlastthisstr; form2.DBEdit13.Text:=methisstr; form2.DBEdit15.Text:=oldnextthisstr; form2.DBEdit17.Text:=nodicardstr; form2.DBNavigator1.BtnClick(nbPost); end; if leftsendcount>0 then begin oldleftsendcount:=leftoldsendcount; oldleftallsendcount:=leftallsendcount; oldlastthisstr:=lastthisstr; oldlastsendcardstr:=lastsendcardstr; end; if rightsendcount>0 then begin oldrightsendcount:=rightoldsendcount; oldrightallsendcount:=rightallsendcount; oldnextsendstr:=nextsendstr; oldnextthisstr:=nextthisstr; end; end; end; procedure TFrmMemory.FormShow(Sender: TObject); begin form1.Show; form2.show; SetPrivilege; label3.Caption:=inttostr(shuinum); end; procedure TFrmMemory.TrackBar1Change(Sender: TObject); begin FrmMemory.AlphaBlendValue:=trackbar1.Position; end; procedure TFrmMemory.Button2Click(Sender: TObject); begin ispo1:=true; end; procedure TFrmMemory.Button4Click(Sender: TObject); begin EnableDebugPriv; end; end. unit UnitProcedure; interface implementation function TFrmMemory.GetOldmemoryValue(i,vsize:integer):integer; var TrueValue:integer; begin if vsize=1 then begin result:=integer(Oldmemory); end else if vsize=2 then begin TrueValue:=integer(Oldmemory)+integer(Oldmemory[i+1])*16*16; result:=TrueValue; end else if vsize=4 then begin TrueValue:=integer(Oldmemory)+integer(Oldmemory[i+1])*16*16; TrueValue:=TrueValue+integer(Oldmemory[i+1])*16*16*16; result:=TrueValue; end; end; //检测地址中的 值是否符合条件 function TFrmMemory.GetmemoryValue(i,vsize:integer):integer; var TrueValue:integer; begin if vsize=1 then begin result:=integer(newmemory); end else if vsize=2 then begin TrueValue:=integer(newmemory)+integer(newmemory[i+1])*16*16; result:=TrueValue ; end else if vsize=4 then begin TrueValue:=integer(newmemory)+integer(newmemory[i+1])*16*16; TrueValue:=TrueValue+integer(newmemory[i+1])*16*16*16; result:=TrueValue; end; end; / procedure TFrmMemory.FindnextAdress; var value,value2,vleng,i,bvalue,fi:integer; begin if edvalue1.Text =''then exit; value:=strtoint(edvalue1.Text ); value2:=strtoint(edvalue2.Text ); vleng:=strtoint(comtypes.Text ); ListAdress.Clear ; for fi:=0 to listadress.Items.Count-1 do begin i:=strtoint(listadress.Items.Names[fi])-baseadr; if commod.Text ='精确值'then begin if getmemoryvalue(i,vleng)=value then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='大于'then begin if getmemoryvalue(i,vleng)>value then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='小于'then begin if getmemoryvalue(i,vleng)<value then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='增加'then begin if getmemoryvalue(i,vleng)>getoldmemoryvalue(i,vleng) then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='减少'then begin if getmemoryvalue(i,vleng)<getoldmemoryvalue(i,vleng) then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='Increased by'then begin if getmemoryvalue(i,vleng)=(getoldmemoryvalue(i,vleng)-value) then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='Decreased by'then begin if getmemoryvalue(i,vleng)=(getoldmemoryvalue(i,vleng)-value) then stlist.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='between' then begin bvalue:= getmemoryvalue(i,vleng); if (bvalue>value) and(bvalue<value2) then stlist.Items.Add(inttohex(baseadr+i,8)); end ; end;{end for/} listadress.Items.Clear ; for fi:=0 to (stlist.Items.Count-1 )do listadress.Items.Add(stlist.Items.Names); end; // procedure TFrmMemory.FindAdress(size:integer); var value,value2,vleng,i,bvalue:integer; begin try if edvalue1.Text =''then exit; stlist.Items.Clear ; value:=strtoint(edvalue1.Text ); value2:=strtoint(edvalue2.Text ); vleng:=strtoint(comtypes.Text ); ListAdress.Items.Clear ; for i:=0 to size do if commod.Text ='精确值'then begin if getmemoryvalue(i,vleng)=value then listadress.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='大于'then begin if getmemoryvalue(i,vleng)>value then listadress.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='小于'then begin if getmemoryvalue(i,vleng)<value then listadress.Items.Add(inttohex(baseadr+i,8)); end else if commod.Text ='between'then begin bvalue:= getmemoryvalue(i,vleng); if bvalue>value then if bvalue<value2 then listadress.Items.Add(inttohex(baseadr+i,8)); end ; except end; end; end. unit UnitSet; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,strutils; type TFrmSet = class(TForm) GroupBox1: TGroupBox; Label1: TLabel; EdMsize: TEdit; BtnWrite: TButton; BtnOK: TButton; BtnClose: TButton; Label2: TLabel; EdProID: TEdit; BtnProid: TButton; Label3: TLabel; Edminadr: TEdit; BtnAdr: TButton; Label4: TLabel; EdMaxadr: TEdit; procedure BtnCloseClick(Sender: TObject); procedure BtnWriteClick(Sender: TObject); procedure BtnProidClick(Sender: TObject); procedure BtnOKClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure BtnAdrClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var FrmSet: TFrmSet; implementation uses UnitMemorysearch; {$R *.dfm} {在SetPrivilege中把本线程的令牌权限设置成了DEBUG!应该可以访问任意进程内存~~~~~~} procedure SetPrivilege; var OldTokenPrivileges, TokenPrivileges: TTokenPrivileges; ReturnLength: dword; hToken: THandle; Luid: int64; begin OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken); LookupPrivilegeValue(nil, 'SeDebugPrivilege', Luid); TokenPrivileges.Privileges[0].luid := Luid; TokenPrivileges.PrivilegeCount := 1; TokenPrivileges.Privileges[0].Attributes := 0; AdjustTokenPrivileges(hToken, False, TokenPrivileges, SizeOf(TTokenPrivileges), OldTokenPrivileges, ReturnLength); {OldTokenPrivileges.Privileges[0].luid := Luid; OldTokenPrivileges.PrivilegeCount := 1; OldTokenPrivileges.Privileges[0].Attributes := TokenPrivileges.Privileges[0].Attributes or SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, OldTokenPrivileges, ReturnLength, PTokenPrivileges(nil)^, ReturnLength); } closehandle(hToken); end; / procedure TFrmSet.BtnCloseClick(Sender: TObject); begin FrmSet.Close; end; procedure TFrmSet.BtnWriteClick(Sender: TObject); begin frmmemory.SmodSize:=strtoint(edMsize.Text ); showmessage('修改成功!'); end; procedure TFrmSet.BtnProidClick(Sender: TObject); var st1:string; proset:integer; begin st1:=edproid.Text ; if (trim(st1)='') or (trim(st1)='$') then exit; proset:=strtoint(st1); frmmemory.proid:=Proset; frmmemory.labpro.Caption :='ProID:'+ inttohex(frmmemory.proid,8); showmessage('修改成功!'); end; procedure TFrmSet.BtnOKClick(Sender: TObject); begin setprivilege; frmmemory.labDebug.Caption :='特权模式'; showmessage('开启成功!'); end; procedure TFrmSet.FormShow(Sender: TObject); var st:integer; begin st:= frmmemory.SmodSize ; edMsize.Text :=inttostr(st); edproid.Text:='$'+leftstr(frmmemory.Labpro.Caption,8) ; edminadr.Text:=inttohex(frmmemory.minadr,8 ) ; edmaxadr.Text:=inttohex(frmmemory.maxadr,8 ) ; end; procedure TFrmSet.BtnAdrClick(Sender: TObject); begin frmmemory.minadr :=strtoint('$'+edminadr.Text); frmmemory.maxadr :=strtoint('$'+edmaxadr.Text); showmessage('修改成功!'); end; end.