学步园

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

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

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

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

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