不知道哪里有问题，总是只能第一行第一个子和第二行第一个子交换
unit newddp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, newddppro;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Button3: TButton;
Memo1: TMemo;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
sitBase:array[0..3] of ^Dword=(
Pointer($479418),
Pointer($479FFC),
Pointer($47ABE0),
Pointer($47B7C4)
);
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
start;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Gameh:HWND;
GamePid:DWORD;
GameProcessH:THandle;
SitNum:DWORD;
ReadByte:DWORD;
begin
Gameh:=FindWindow(nil,'对对碰角色版');
//进程ID
GetWindowThreadProcessID(Gameh,GamePid);
//进程句柄
GameprocessH:=OpenProcess(PROCESS_VM_Read or PROCESS_VM_Write,false,GamePid);
//读座位号
ReadProcessMemory(GameProcessH,Pointer($0047C9D4),@SitNum,4,readbyte);
//显示座位号
self.Edit1 .text:=inttostr(sitnum);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Gameh:HWND;
GamePid:DWORD;
GameProcessH:THandle;
SitNum:DWORD;
ReadByte:DWORD;
ChessData:array[1..8,1..25] of byte;
X,Y:DWORD;
S:String;
begin
Gameh:=FindWindow(nil,'对对碰角色版');
//进程ID
GetWindowThreadProcessID(Gameh,GamePid);
//进程句柄
GameprocessH:=OpenProcess(PROCESS_VM_Read or PROCESS_VM_Write,false,GamePid);
//读座位号
ReadProcessMemory(GameProcessH,Pointer($0047C9D4),@SitNum,4,readbyte);
//根据座位号 读出相应棋盘数据
ReadProcessMemory(GameProcessH,SitBase[SitNum],@ChessData,200, readbyte);
//显示棋盘数据
Self.Memo1.Text:='';
for y:=1 to 8 do
begin
s:='';
for x:=1 to 8 do
s:=s+intTOstr(ChessData[x][y])+',';
////////////
Self.Memo1.Lines.Add(s);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
P1,P2:TPoint;
begin
p1.X:=3;p1.Y:=1;
p2.X:=4;p2.Y:=1;
autoPlay(p1,p2);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
clearone
end;
end.
////////////////////////////////////////////////////////////////////
unit newddppro;
interface
uses windows,messages;
procedure start; //游戏开局
procedure autoPlay(Pa,Pb:TPoint);//交换两点
procedure clearone; //单消一次
type
twoXy=array[1..2] of Tpoint;
QP_Array= Array[1..8,1..25] of byte;
var
sitBase:array[0..3] of ^Dword=(
Pointer($479418),
Pointer($479FFC),
Pointer($47ABE0),
Pointer($47B7C4)
);
ChessData: QP_Array; //当前棋盘数组
Function TestChess(qp1:QP_Array):bool;
Function GetPoint():twoXy;
implementation
//游戏开局
procedure start;
var
Gameh:hwnd;
begin
//获取窗口句柄
Gameh:=FindWindow(nil,'对对碰角色版');
//模拟鼠标单击
SendMessage(Gameh,Messages.WM_LBUTTONDOWN ,0,$0183017F);//鼠标左键按下
SendMessage(Gameh,Messages.WM_LBUTTONUP ,0,$0183017F);//鼠标左键抬起
end;
//更新棋盘数据
procedure updataChess();
var
Gameh:HWND;
GamePid:DWORD;
GameProcessH:THandle;
SitNum:DWORD;
ReadByte:DWORD;
ChessData:array[1..8,1..25] of byte;
begin
Gameh:=FindWindow(nil,'对对碰角色版');
//进程ID
GetWindowThreadProcessID(Gameh,GamePid);
//进程句柄
GameprocessH:=OpenProcess(PROCESS_VM_Read or PROCESS_VM_Write,false,GamePid);
//读座位号
ReadProcessMemory(GameProcessH,Pointer($0047C9D4),@SitNum,4,readbyte);
//根据座位号 读出相应棋盘数据
ReadProcessMemory(GameProcessH,SitBase[SitNum],@ChessData,200, readbyte);
end;
//交换两点
procedure autoPlay(Pa,Pb:TPoint);
var
Gameh:HWND;
P1,P2:TPoint;
lparam:DWORD;
begin
p1.X:=272+48*pa.X-30;p1.Y:=99+48*pa.Y-30;
p2.X:=272+48*pb.X-30;p2.Y:=99+48*pb.Y-30;
Gameh:=FindWindow(nil,'对对碰角色版');
//点一
lparam:=p1.X+p1.Y shl 16;
SendMessage(Gameh,messages.WM_LBUTTONDOWN ,0,lparam);
SendMessage(Gameh,messages.WM_LBUTTONUP ,0,lparam);
//点二
lparam:=p2.X+p2.Y shl 16;
SendMessage(Gameh,messages.WM_LBUTTONDOWN ,0,lparam);
SendMessage(Gameh,messages.WM_LBUTTONUP ,0,lparam);
end;
//////////////////
procedure clearone; //实现单消
var
pxy:twoxy;
begin
pxy:=GetPoint();
AutoPlay(pxy[1],pxy[2]);
end;
//获取交换点
Function GetPoint():twoXy; //获取可交换的2个点
var
x,y,t1:byte;
qp:QP_Array;
begin
///////////////////////////////////////////////////////////////////
for x:=1 to 8 do //1-8列
for y:=1 to 7 do // 遍历某列
begin
updataChess; //更新棋盘数据
qp:=ChessData;
t1:=qp[x][y]; qp[x][y]:=qp[x][y+1]; qp[x][y+1]:=t1; //交换相临棋子
if TestChess(qp) then begin
result[1].X:=x;
result[1].Y:=y;
result[2].X:=x;
result[2].Y:=y+1; exit;end;
end;//end for
for y:=1 to 8 do
for x:=1 to 7 do
begin
updataChess; //更新棋盘数据
qp :=ChessData; //
t1:=qp[x][y]; qp[x][y]:=qp[x+1][y]; qp[x+1][y]:=t1; //交换相临的2点
if TestChess(qp) then begin //如果交换后的棋盘 存在 三个相同的棋子相连
result[1].X:=x;
result[1].Y:=y;
result[2].X:=x+1;
result[2].Y:=y; exit;end;
end;//end for
end; //end Function
//////////////
Function TestChess(qp1:QP_Array):bool; //测试交换过的棋盘 内是否有 三个相同棋子相连 3
var
r1,x,y:byte;
begin
Result:=false;
for y:=1 to 8 do //1-8行坐标
begin
r1:=1;
for x:=1 to 7 do //Y列坐标
begin
if qp1[x][y]=qp1[x+1][y] then begin r1:=r1+1 ; //累计相同棋子数
if r1>=3 then begin Result:=true;exit;end;
end
else r1:=1; //初始化累计 1
end;
end;
/////////////////////////////////////////////////////////////////////////////////////////
//遍历 1-8 列 看是否有 3子 相连的
for x:=1 to 8 do //
begin
r1:=1;
for y:=1 to 7 do //列坐标
begin
if qp1[x][y]=qp1[x][y+1] then begin r1:=r1+1 ; //累计 相同的棋子数
if r1>=3 then begin Result:=true;exit;end; //
end
else r1:=1; //如果相临棋子 不同，则初如化累计值
end;
end;
end; //end function
end.
[培训]《安卓高级研修班(网课)》月薪三万计划，掌握调试、分析还原ollvm、vmp的方法，定制art虚拟机自动化脱壳的方法
