作者在 2011-01-13 00:29:01 发布以下内容
// 如何用delphi开发斗地主记牌器
//作者：边缘软件 http://www.bianyuansoft.com qq:38998399
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(serval1
WORD;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+'红
//作者：边缘软件 http://www.bianyuansoft.com qq:38998399
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(serval1
WORD;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(serval1
WORD;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+'红