• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

Delphi对对碰外挂记录

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
unit DDPUnit;

interface

uses windows, Messages;
procedure Start();
procedure AutoPlay(pa, pb: TPoint);
procedure clearone; // 实现单消
procedure addSpeed; // 去掉消除动画,实现加速
procedure subSpeed; //回复原来速度

type // 定义两个数据类型
  twoXy 
= array [1 .. 2of TPoint;
  QP_Array 
= Array [1 .. 81 .. 25of byte; //存储棋盘数据

var
  ChessData: QP_Array; //棋盘数据
  sitBase: 
array [0 .. 3of 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 + 1then
      
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 .. 5of byte = ($90,$90,$6A,$01,$90);
  OldSpeed: 
array [1 .. 5of 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.

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
【读书1】【2017】MATLAB与深度学习——反向传播算法(4)发布时间:2022-07-18
下一篇:
matlab特殊符号表 - FCBayern发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap