VB版 植物大战僵尸修改器源码
前几天在C#版中看到了C#版的修改器源码，现修改一个VB版的
Option ExplicitPrivate 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 LongPrivate 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 LongPrivate Declare Function OpenProcess _ Lib "Kernel32.dll" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As LongPrivate Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As LongPrivate Const baseAddress As Long = &H6A9EC0Private 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 SubPrivate 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 SubPrivate 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 hProcessEnd SubPrivate 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 = bufferEnd Function'根据进程获取PIDPrivate 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 = NothingEnd FunctionPrivate 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=99999End SubPrivate 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=99999End Sub