植物大战僵尸这个小游戏做的还真不错,我看到了几个版本的植物大战僵尸修改器,如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 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 "植物大战僵尸程序还未打开","提示" 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,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,GetPid) ReadProcessMemory hProcess,ByVal Address,ByVal VarPtr(buffer),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