VB版 植物大战僵尸修改器

植物大战僵尸这个小游戏做的还真不错，我看到了几个版本的植物大战僵尸修改器，如C++版，C#版，所以就改写了一个VB版本的，以下是源码

 

'界面中有两个按钮，分别是cmdSunUnlimited（caption为启用阳光无限），cmdMoneyUnlimited（caption为启用金钱无限），并且需要放两个Timer控件，名称为默认值timer1和timer2

 

'基地址直接从其它工程中获取

 

Option Explicit Private Declare Function ReadProcessMemory _ Lib "Kernel32.dll" (ByVal hProcess As Long, _ ByRef lpBaseAddress As Any, _ ByRef lpBuffer As Any, _ ByVal nSize As Long, _ ByRef lpNumberOfBytesWritten As Long) As Long Private Declare Function WriteProcessMemory _ Lib "Kernel32.dll" (ByVal hProcess As Long, _ ByRef lpBaseAddress As Any, _ ByRef lpBuffer As Any, _ ByVal nSize As Long, _ ByRef lpNumberOfBytesWritten As Long) As Long Private Declare Function OpenProcess _ Lib "Kernel32.dll" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long Private Const baseAddress As Long = &H6A9EC0 Private Const processName As String = "PlantsVsZombies.exe" Private Sub cmdMoneyUnlimited_Click() '金钱无限 If cmdMoneyUnlimited.Caption = "启用金钱无限" Then If GetPid = 0 Then MsgBox "植物大战僵尸程序还未打开", vbInformation, "提示" Exit Sub End If cmdMoneyUnlimited.Caption = "停止启用金钱无限" Timer2.Interval = 1000 Timer2.Enabled = True Else cmdMoneyUnlimited.Caption = "启用金钱无限" Timer2.Enabled = False End If End Sub Private Sub cmdSunUnlimited_Click() '阳光无限 If cmdSunUnlimited.Caption = "启用阳光无限" Then If GetPid = 0 Then MsgBox "植物大战僵尸程序还未打开", vbInformation, "提示" Exit Sub End If cmdSunUnlimited.Caption = "停止启用阳光无限" Timer1.Interval = 1000 Timer1.Enabled = True Else cmdSunUnlimited.Caption = "启用阳光无限" Timer1.Enabled = False End If End Sub Private Sub WriteMemoryValue(ByVal baseAddress As Long, ByVal value As Long) Dim hProcess As Long hProcess = OpenProcess(&H1F0FFF, 0, GetPid) WriteProcessMemory hProcess, ByVal baseAddress, value, 4, 0& CloseHandle hProcess End Sub Private Function ReadMemoryValue(ByVal Address As Long) As Long Dim hProcess As Long Dim buffer As Long hProcess = OpenProcess(&H1F0FFF, 0, GetPid) ReadProcessMemory hProcess, ByVal Address, ByVal VarPtr(buffer), 4, 0& CloseHandle hProcess ReadMemoryValue = buffer End Function '根据进程获取PID Private Function GetPid() As Long Dim objWMIService, objProcess, colProcess Dim strComputer strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!//" & strComputer & "/root/cimv2") Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process") For Each objProcess In colProcess If objProcess.Name = processName Then GetPid = objProcess.ProcessID Exit For End If Next Set objWMIService = Nothing Set colProcess = Nothing End Function Private Sub Timer1_Timer() '阳光无限 Dim Address As Long If GetPid = 0 Then cmdMoneyUnlimited.Caption = "启用阳光无限" Timer1.Enabled = False Exit Sub End If Address = ReadMemoryValue(baseAddress) '基地址不会改变 Address = Address + &H768 '二级地址 Address = ReadMemoryValue(Address) Address = Address + &H5560 WriteMemoryValue Address, &H1869F '&H1869F=99999 End Sub Private Sub Timer2_Timer() '金钱无限 Dim Address As Long If GetPid = 0 Then cmdMoneyUnlimited.Caption = "启用金钱无限" Timer2.Enabled = False Exit Sub End If Address = ReadMemoryValue(baseAddress) '基地址不会改变 Address = Address + &H82C '二级地址 Address = ReadMemoryValue(Address) Address = Address + &H28 WriteMemoryValue Address, &H1869F '&H1869F=99999 End Sub

 

源码下载地址：http://download.csdn.net/source/2079764