unit DDPUnit;
interface
uses windows, Messages;
procedure Start();
procedure AutoPlay(pa, pb: TPoint);
procedure clearone; // 实现单消
procedure addSpeed; // 去掉消除动画,实现加速
procedure subSpeed; //回复原来速度
type // 定义两个数据类型
twoXy = array [1 .. 2] of TPoint;
QP_Array = Array [1 .. 8, 1 .. 25] of byte; //存储棋盘数据
var
ChessData: QP_Array; //棋盘数据
sitBase: array [0 .. 3] of Dword = (
坐0号桌时棋盘基址,
坐1号桌时棋盘基址
坐2号桌时棋盘基址
坐3号桌时棋盘基址
);
Function TestChess(qp1: QP_Array): bool;
Function GetPoint(): twoXy;
function GetSitNum(): Dword;
// 当前棋盘数组
implementation
// 游戏开局
procedure Start();
var
Gameh: HWND;
begin
Gameh := FindWindow(nil, '对对碰角色版');
// 模拟鼠标单击
SendMessage(Gameh, Messages.WM_LBUTTONDOWN, 0, $0180017A); // 按下
SendMessage(Gameh, Messages.WM_LBUTTONUP, 0, $0180017A); // 抬起
end;
Function GetSitNum(): Dword;
var
Gameh: HWND;
GamePid: Dword;
GameProcess: THandle;
SitNum: Dword;
readByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版');
// 找进程ID
GetWindowThreadProcessId(Gameh, GamePid);
// 获取进程句柄
GameProcess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE, False,
GamePid);
// 读出座位号
ReadProcessMemory(GameProcess, Pointer(座位号基址), @SitNum, 4, readByte);
// 显示座位号
Result := SitNum;
end;
procedure AutoPlay(pa: TPoint; pb: TPoint);
var
Gameh: HWND;
lparam: Dword;
p1, p2: TPoint;
begin
Gameh := FindWindow(nil, '对对碰角色版');
p1.x := 272 + 48 * (pa.x - 1);
p1.y := 100 + 48 * (pa.y - 1);
p2.x := 272 + 48 * (pb.x - 1);
p2.y := 100 + 48 * (pb.y - 1);
if Gameh <> 0 then
begin
lparam := p1.x + p1.y shl 16;
SendMessage(Gameh, WM_LBUTTONDOWN, 0, lparam); // 鼠标按下
SendMessage(Gameh, WM_LBUTTONUP, 0, lparam); // 鼠标抬起
lparam := p2.x + p2.y shl 16;
SendMessage(Gameh, WM_LBUTTONDOWN, 0, lparam); // 鼠标按下
SendMessage(Gameh, WM_LBUTTONUP, 0, lparam); // 鼠标抬起
end;
end;
procedure clearone; // 实现单消
var
pxy: twoXy;
begin
pxy := GetPoint();
AutoPlay(pxy[1], pxy[2]);
end;
// 更新棋盘数据
procedure upDataChess(); // 读出棋盘数组
var
Gameh: HWND;
GamePid: Dword;
Gamehprocess: THandle;
readByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版'); // 获取游戏窗口句柄
GetWindowThreadProcessId(Gameh, GamePid); // 获取进程ID
Gamehprocess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE, False,
GamePid); // 获取进程句柄
ReadProcessMemory(Gamehprocess, Pointer(sitBase[GetSitNum]), @ChessData, 200,
readByte); // 根据坐位号码 读出相应棋盘数据
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
var
NewSpeed: array [1 .. 5] of byte = ($90,$90,$6A,$01,$90);
OldSpeed: array [1 .. 5] of byte = ($EB,$02,$33,$C9,$51);
SleepBase: Dword = $0041E74D;
procedure addSpeed();
var
Gameh: HWND;
GamePid: Dword;
GameProcess: THandle;
WriteByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版');
if Gameh <> 0 then
begin
GetWindowThreadProcessId(Gameh, GamePid);
GameProcess := OpenProcess(windows.PROCESS_ALL_ACCESS, False, GamePid);
WriteProcessMemory(GameProcess, Pointer(SleepBase), @NewSpeed[1], 5,
WriteByte);
end;
end;
procedure subSpeed;
var
Gameh: HWND;
GamePid: Dword;
GameProcess: THandle;
WriteByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版');
if Gameh <> 0 then
begin
GetWindowThreadProcessId(Gameh, GamePid);
GameProcess := OpenProcess(windows.PROCESS_ALL_ACCESS, False, GamePid);
WriteProcessMemory(GameProcess, Pointer(SleepBase), @OldSpeed[1], 5,
WriteByte);
end;
end;
// End Procudure
end.
interface
uses windows, Messages;
procedure Start();
procedure AutoPlay(pa, pb: TPoint);
procedure clearone; // 实现单消
procedure addSpeed; // 去掉消除动画,实现加速
procedure subSpeed; //回复原来速度
type // 定义两个数据类型
twoXy = array [1 .. 2] of TPoint;
QP_Array = Array [1 .. 8, 1 .. 25] of byte; //存储棋盘数据
var
ChessData: QP_Array; //棋盘数据
sitBase: array [0 .. 3] of Dword = (
坐0号桌时棋盘基址,
坐1号桌时棋盘基址
坐2号桌时棋盘基址
坐3号桌时棋盘基址
);
Function TestChess(qp1: QP_Array): bool;
Function GetPoint(): twoXy;
function GetSitNum(): Dword;
// 当前棋盘数组
implementation
// 游戏开局
procedure Start();
var
Gameh: HWND;
begin
Gameh := FindWindow(nil, '对对碰角色版');
// 模拟鼠标单击
SendMessage(Gameh, Messages.WM_LBUTTONDOWN, 0, $0180017A); // 按下
SendMessage(Gameh, Messages.WM_LBUTTONUP, 0, $0180017A); // 抬起
end;
Function GetSitNum(): Dword;
var
Gameh: HWND;
GamePid: Dword;
GameProcess: THandle;
SitNum: Dword;
readByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版');
// 找进程ID
GetWindowThreadProcessId(Gameh, GamePid);
// 获取进程句柄
GameProcess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE, False,
GamePid);
// 读出座位号
ReadProcessMemory(GameProcess, Pointer(座位号基址), @SitNum, 4, readByte);
// 显示座位号
Result := SitNum;
end;
procedure AutoPlay(pa: TPoint; pb: TPoint);
var
Gameh: HWND;
lparam: Dword;
p1, p2: TPoint;
begin
Gameh := FindWindow(nil, '对对碰角色版');
p1.x := 272 + 48 * (pa.x - 1);
p1.y := 100 + 48 * (pa.y - 1);
p2.x := 272 + 48 * (pb.x - 1);
p2.y := 100 + 48 * (pb.y - 1);
if Gameh <> 0 then
begin
lparam := p1.x + p1.y shl 16;
SendMessage(Gameh, WM_LBUTTONDOWN, 0, lparam); // 鼠标按下
SendMessage(Gameh, WM_LBUTTONUP, 0, lparam); // 鼠标抬起
lparam := p2.x + p2.y shl 16;
SendMessage(Gameh, WM_LBUTTONDOWN, 0, lparam); // 鼠标按下
SendMessage(Gameh, WM_LBUTTONUP, 0, lparam); // 鼠标抬起
end;
end;
procedure clearone; // 实现单消
var
pxy: twoXy;
begin
pxy := GetPoint();
AutoPlay(pxy[1], pxy[2]);
end;
// 更新棋盘数据
procedure upDataChess(); // 读出棋盘数组
var
Gameh: HWND;
GamePid: Dword;
Gamehprocess: THandle;
readByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版'); // 获取游戏窗口句柄
GetWindowThreadProcessId(Gameh, GamePid); // 获取进程ID
Gamehprocess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE, False,
GamePid); // 获取进程句柄
ReadProcessMemory(Gamehprocess, Pointer(sitBase[GetSitNum]), @ChessData, 200,
readByte); // 根据坐位号码 读出相应棋盘数据
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
var
NewSpeed: array [1 .. 5] of byte = ($90,$90,$6A,$01,$90);
OldSpeed: array [1 .. 5] of byte = ($EB,$02,$33,$C9,$51);
SleepBase: Dword = $0041E74D;
procedure addSpeed();
var
Gameh: HWND;
GamePid: Dword;
GameProcess: THandle;
WriteByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版');
if Gameh <> 0 then
begin
GetWindowThreadProcessId(Gameh, GamePid);
GameProcess := OpenProcess(windows.PROCESS_ALL_ACCESS, False, GamePid);
WriteProcessMemory(GameProcess, Pointer(SleepBase), @NewSpeed[1], 5,
WriteByte);
end;
end;
procedure subSpeed;
var
Gameh: HWND;
GamePid: Dword;
GameProcess: THandle;
WriteByte: Dword;
begin
Gameh := FindWindow(nil, '对对碰角色版');
if Gameh <> 0 then
begin
GetWindowThreadProcessId(Gameh, GamePid);
GameProcess := OpenProcess(windows.PROCESS_ALL_ACCESS, False, GamePid);
WriteProcessMemory(GameProcess, Pointer(SleepBase), @OldSpeed[1], 5,
WriteByte);
end;
end;
// End Procudure
end.