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 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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!