2010年的外挂小作品 - QQ对对碰单机版外挂

其实呢。这个重中之重是找对基址= =。源码么纯粹YY。

这个小外挂实现了各种淫荡的功能。比如把所有的动物换成相同的。

还有更加淫荡的直接加分功能。= =纯粹是蛋疼。

unit Unit1;

interface
{
  程序：Michael J Scofield
  http://blog.csdn.net/MichaelJScofield
                            2010.04.27
  2010.05.08:今天找到了游戏第一个座位基址，加上.
  PS：今天看了韩国的《婚纱》。
}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    mmoChess: TMemo;
    btnReadChessInfo: TButton;
    btnShowChess: TButton;
    btnEditValue: TButton;
    btnChangeOne: TButton;
    btnAotoChange: TButton;
    tmrAutoKill: TTimer;
    Timer1: TTimer;
    btnAddSc: TButton;
    edtSc: TEdit;
    procedure btnReadChessInfoClick(Sender: TObject);
    procedure btnShowChessClick(Sender: TObject);
    procedure btnEditValueClick(Sender: TObject);
    procedure btnChangeOneClick(Sender: TObject);
    procedure tmrAutoKillTimer(Sender: TObject);
    procedure btnAotoChangeClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnAddScClick(Sender: TObject);
  private
    { So boring  }
  public
    { (*^__^*)  }
  end;

type
  TChess       = Array[1..8,1..160] of Byte; //定义棋盘数组
  TChangePoint = Array[1..2] of TPoint; //可改变坐标

const
  MOUSE_RIGHTCLICK = 2; //鼠标右键
  GameCaption      = 'Asphyre - massive particle effects'; //窗口标题
  AppClassName     = 'TMainForm'; //窗口类
  ChessPointer     = $488BE0;  //棋盘基址  [[488BE0]+68]+32C

type
  TGameChess = class
    pGameBase: Pointer;
    pChessman: Pointer;
    pTips: Pointer;
    pMark: Pointer;
    ChessData:TChess; //棋盘数据
  private
  public
  end;

var
  Form1: TForm1;
  ChessData:TChess; //棋盘数据


  {获取真实基址}
  function GetBase:Pointer;
  {读取棋盘数组}
  function ReadChessData:TChess;
  {改变值}
  procedure ChangeValue(Value:Integer);
  {检查是否可以交换}
  function ICanFind3Chessman(ChessData:TChess):Boolean;
  {交换棋子}
  procedure ChangeChessman(Pa,Pb:TPoint);
  {获取可改变坐标}
  function GetPoint:TChangePoint;
  {消除一个}
  procedure KillOne;
  {开始游戏}
  procedure StartGame;

implementation

{$R *.dfm}

{转换名字}
function WhatIsit(Plug:Integer):string;
begin
  Result := 'X';
  case plug of
    0:Result := '蛙';
    1:Result := '鸡';
    2:Result := '猫';
    3:Result := '熊';
    4:Result := '狗';
    5:Result := '牛';
    6:Result := '猴';
  end;
end;

{获取真实基址}
function GetBase:Pointer;
var
  hGame,hProcess:THandle;
  dwPID,dwRead:DWORD;
  ChessBase: Integer;
begin
  Result := nil;
  hGame:=Findwindow(AppClassName,GameCaption);
  if hGame <> 0 then
  begin
    GetWindowThreadProcessId(hGame,dwPID);
    if dwPID <> 0 then
    begin
      hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,dwPID);//[[488BE0]+68]+32C
      ReadProcessMemory(hProcess,Pointer(ChessPointer),@ChessBase,4,dwRead); //我们读取指针 4字节够了
      ReadProcessMemory(hProcess,Pointer(ChessBase+$68),@ChessBase,4,dwRead);
      CloseHandle(hProcess);
      Result := Pointer(ChessBase+$32C);
    end;
  end;
end;

{读取棋盘数组}
function ReadChessData:TChess;
var
  hGame,hProcess:THandle;
  dwPID,dwRead:DWORD;
  ChessXY:TChess;
begin
  hGame:=Findwindow(AppClassName,GameCaption);
  if hGame <> 0 then
  begin
    GetWindowThreadProcessId(hGame,dwPID);
    if dwPID <> 0 then
    begin
      hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,dwPID);
      ReadProcessMemory(hProcess,GetBase,@ChessXY,SizeOf(TChess),dwRead);
      CloseHandle(hProcess);
      Result := ChessXY;
    end;
  end;
  CloseHandle(hGame);
end;

{修改提示}
procedure TForm1.btnReadChessInfoClick(Sender: TObject);
var
  hGame,hProcess: THandle;
  dwPID,dwRead: DWORD;
  TipsCount: Integer;
  Tips,ScanCode: Byte;
begin
  StartGame;
  hGame:=Findwindow(AppClassName,GameCaption);
  if hGame <> 0 then
  begin
    GetWindowThreadProcessId(hGame,dwPID);
    if dwPID <> 0 then
    begin
      hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,dwPID);//[[488BE0]+68]+A30
      ReadProcessMemory(hProcess,Pointer(ChessPointer),@TipsCount,4,dwRead); //我们读取指针 4字节够了
      ReadProcessMemory(hProcess,Pointer(TipsCount+$68),@TipsCount,4,dwRead);
      ReadProcessMemory(hProcess,Pointer(TipsCount+$A30),@Tips,SizeOf(Byte),dwRead);
      Tips := Tips + 1;
      WriteProcessMemory(hProcess,Pointer(TipsCount+$A30),@Tips,SizeOf(Tips),dwRead);
      ScanCode := MapVirtualKey(VK_F1,0);
      keybd_event(VK_F1,ScanCode,KEYEVENTF_EXTENDEDKEY,0);
      keybd_event(VK_F1,ScanCode,KEYEVENTF_KEYUP,0);
      CloseHandle(hProcess);
    end;
  end;
  CloseHandle(hGame);
end;

{读取棋盘信息}
procedure TForm1.btnShowChessClick(Sender: TObject);
var
  ChessXY:TChess;
  x,y:Integer;
  ChessLine:string;
begin
  ChessXY := ReadChessData;
  mmoChess.Lines.Add('#######################');
  for y:=1 to 8 do
  begin
    ChessLine := '#';
    for x:=1 to 8 do
    begin
      ChessLine := ChessLine + WhatIsit(ChessXY[x][(y-1)*20+1])+'#';
    end;
    mmoChess.Lines.Add(ChessLine);
  end;
  mmoChess.Lines.Add('#######################');
end;

{改变值}
procedure ChangeValue(Value:Integer);
var
  hGame,hProcess:THandle;
  dwPID,dwRead:DWORD;
  ChessXY:TChess;
  x,y:Integer;
begin
  hGame:=Findwindow(AppClassName,GameCaption);
  if hGame <> 0 then
  begin
    GetWindowThreadProcessId(hGame,dwPID);
    if dwPID <> 0 then
    begin
      hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,dwPID);
      ReadProcessMemory(hProcess,GetBase,@ChessXY,SizeOf(ChessXY),dwRead);
      for y:=1 to 8 do
      begin
        for x:=1 to 8 do
        begin
          ChessXY[x][(y-1)*20+1] := Value;
        end;
      end;
      WriteProcessMemory(hProcess,GetBase,@ChessXY,SizeOf(ChessXY),dwRead);
      CloseHandle(hProcess);
    end;
  end;
end;

{改成熊猫}
procedure TForm1.btnEditValueClick(Sender: TObject);
begin
  ChangeValue(3);
end;


{交换棋子}
procedure ChangeChessman(Pa,Pb:TPoint);
var
  hGame:THandle;
  ClickFocus:DWORD;
  p1,p2:TPoint;
begin
  hGame:=Findwindow(AppClassName,GameCaption);
  p1.X := 37 + 48 * Pa.X - 24;
  p1.Y := 125 + 48 * Pa.Y - 24;
  p2.X := 37 + 48 * Pb.X - 24;
  p2.Y := 125 + 48 * Pb.Y - 24;
  ClickFocus := p1.X + p1.Y shl 16;
  SendMessage(hGame,WM_LBUTTONDOWN,0,ClickFocus);
  sendMessage(hGame,WM_LBUTTONUP, 0,ClickFocus);
  ClickFocus := p2.X + p2.Y shl 16;
  SendMessage(hGame,WM_LBUTTONDOWN,0,ClickFocus);
  sendMessage(hGame,WM_LBUTTONUP,0,ClickFocus);
end;


{检查是否可以交换}
function ICanFind3Chessman(ChessData:TChess):Boolean;
var
  i,X,Y:Integer;
begin
  Result := False;
  for Y:=1 to 8 do
  begin
    i := 1;
    for X:=1 to 7 do
    begin
      if (ChessData[X][(Y-1)*20+1])=(ChessData[X+1][(Y-1)*20+1]) then  //横坐标 相邻检查
      begin
        i := i + 1;
        if i >= 3 then
        begin
          Result := True;
          Exit;
        end;
      end
      else
      begin
        i := 1;
      end;
    end;
  end;
  for X:=1 to 8 do //纵坐标
  begin
    i := 1;
    for Y:=1 to 7 do
    begin
      if (ChessData[X][(Y-1)*20+1])=(ChessData[X][Y*20+1]) then
      begin
        i := 1;
        if i >= 3 then
        begin
          Result := True;
          Exit;
        end;
      end
      else
      begin
        i := 1;
      end;
    end;
  end;
end;

{获取可改变坐标}
function GetPoint:TChangePoint;
var
  X,Y:Integer;
begin
  for X:=1 to 8 do
  begin
    for Y:=1 to 7 do //因为第八位没有相邻棋子了
    begin
      ChessData := ReadChessData;
      ChessData[X][(Y-1)*20+1] := ChessData[X][(Y-1)*20+1] + ChessData[X][Y*20+1];
      ChessData[X][Y*20+1] := ChessData[X][(Y-1)*20+1] - ChessData[X][Y*20+1];
      ChessData[X][(Y-1)*20+1] := ChessData[X][(Y-1)*20+1] - ChessData[X][Y*20+1];
      if ICanFind3Chessman(ChessData) then
      begin
        Result[1].X := X;
        Result[1].Y := Y;
        Result[2].X := X;
        Result[2].Y := Y + 1;
        Exit;
      end;
    end;
  end;
  for Y:=1 to 8 do
  begin
    for X:=1 to 7 do
    begin
      ChessData := ReadChessData;
      ChessData[X][(Y-1)*20+1] := ChessData[X][(Y-1)*20+1] + ChessData[X+1][(Y-1)*20+1];
      ChessData[X+1][(Y-1)*20+1] := ChessData[X][(Y-1)*20+1] - ChessData[X+1][(Y-1)*20+1];
      ChessData[X][(Y-1)*20+1] := ChessData[X][(Y-1)*20+1] - ChessData[X+1][(Y-1)*20+1];
      if ICanFind3Chessman(ChessData) then
      begin
        Result[1].X := X;
        Result[1].Y := Y;
        Result[2].X := X + 1;
        Result[2].Y := Y;
        Exit;
      end;
    end;
  end;
end;

{消除一个}
procedure KillOne;
var
  ChangePoint:TChangePoint;
begin
  ChangePoint := GetPoint;
  ChangeChessman(ChangePoint[1],ChangePoint[2]);
end;

procedure TForm1.btnChangeOneClick(Sender: TObject);
begin
  StartGame;
  KillOne;
end;

{每2秒钟消除一个}
procedure TForm1.tmrAutoKillTimer(Sender: TObject);
begin
  KillOne;
end;

{开始游戏}
procedure StartGame;
var
  hGame:THandle;
begin
  hGame:=Findwindow(AppClassName,GameCaption);
  if hGame <> 0 then
  begin
    SetForegroundWindow(hGame);//设置窗体置顶
    SendMessage(hGame,WM_LBUTTONDOWN,1,31195597);//$01DC01BB
    SendMessage(hGame,WM_LBUTTONUP,1,31195597);
  end;
end;

{启动自动清除}
procedure TForm1.btnAotoChangeClick(Sender: TObject);
begin

  if btnAotoChange.Caption = '自动消除' then
  begin
    btnAotoChange.Caption := '停止';
    StartGame;
    tmrAutoKill.Enabled := True;
  end
  else if btnAotoChange.Caption = '停止' then
  begin
    btnAotoChange.Caption := '自动消除';
    tmrAutoKill.Enabled := False;
  end;
end;

{截获右键}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Randomize;
  if GetAsyncKeyState(MOUSE_RIGHTCLICK)<>0 then 
  begin
    ChangeValue(Random(6));
  end;
end;

{加分}
procedure TForm1.btnAddScClick(Sender: TObject);
var
  hGame,hProcess: THandle;
  dwPID,dwRead: DWORD;
  TipsCount,Source: Integer;
begin
  StartGame;
  hGame:=Findwindow(AppClassName,GameCaption);
  if hGame <> 0 then
  begin
    GetWindowThreadProcessId(hGame,dwPID);
    if dwPID <> 0 then
    begin
      hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,dwPID);//[[488BE0]+68]+AC4 分数基址
      ReadProcessMemory(hProcess,Pointer(ChessPointer),@TipsCount,4,dwRead);
      ReadProcessMemory(hProcess,Pointer(TipsCount+$68),@TipsCount,4,dwRead);
      Source := StrToInt(edtSc.Text);
      WriteProcessMemory(hProcess,Pointer(TipsCount+$AC4),@Source,SizeOf(Source),dwRead);
      CloseHandle(hProcess);
    end;
  end;
  CloseHandle(hGame);
end;


end.