VB版 植物大战僵尸修改器源码

aohan 2010-02-25 02:30:58
前几天在C#版中看到了C#版的修改器源码,现修改一个VB版的




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


...全文
493 21 打赏 收藏 举报
写回复
21 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
liguicd 2010-03-02
好东西啊,不过,我更喜欢挑战僵尸,哈哈哈
  • 打赏
  • 举报
回复
aohan 2010-03-02
小意思了

回复内容太短了

  • 打赏
  • 举报
回复
哈哈.

除了最后的无限生存模式用得着阳光无限与冷却无限外,其它地方就不需要了...
  • 打赏
  • 举报
回复
jhone99 2010-03-01
感谢分享
  • 打赏
  • 举报
回复
chenyubo1977 2010-03-01
用外挂玩游戏太没意思了吧
  • 打赏
  • 举报
回复
jabulin 2010-03-01
学习中,谢谢分享~~~~~~~~~~~
  • 打赏
  • 举报
回复
gukuang78 2010-03-01
学习中,谢谢分享~~~~~~~~~~~
  • 打赏
  • 举报
回复
aohan 2010-02-28
引用 12 楼 sysdzw 的回复:
引用 11 楼 aohan 的回复:
你直接下源码看看,我的测试都正常哦


http://download.csdn.net/source/2079764
我就是下的这个源码啊  金钱并没有变化啊


阳光更改是否成功呢?
  • 打赏
  • 举报
回复
king06 2010-02-26
启用金钱无限
  • 打赏
  • 举报
回复
舉杯邀明月 2010-02-26
Ding
  • 打赏
  • 举报
回复
aohan 2010-02-26
也可以到这里下载源码:

http://download.csdn.net/source/2079764

http://download.csdn.net/source/2079764
  • 打赏
  • 举报
回复
vvsxr 2010-02-26
好东西啊

回复内容太短了!回复内容太短了!回复内容太短了!
  • 打赏
  • 举报
回复
无·法 2010-02-26
引用 11 楼 aohan 的回复:
你直接下源码看看,我的测试都正常哦


http://download.csdn.net/source/2079764

我就是下的这个源码啊 金钱并没有变化啊
  • 打赏
  • 举报
回复
aohan 2010-02-26
你直接下源码看看,我的测试都正常哦


http://download.csdn.net/source/2079764
  • 打赏
  • 举报
回复
luofenghen 2010-02-26
引用 9 楼 sysdzw 的回复:
刚试了 不行啊

<strong>回复内容太短了!</strong>


当然不行了 还有好多API 没申明呢
  • 打赏
  • 举报
回复
无·法 2010-02-26
刚试了 不行啊

回复内容太短了!
  • 打赏
  • 举报
回复
chinaboyzyq 2010-02-26
好贴,好贴……
  • 打赏
  • 举报
回复
siLence_Again 2010-02-25
难道是在散分
  • 打赏
  • 举报
回复
内存修改器么。。。。。。。uping
  • 打赏
  • 举报
回复
孤独剑_LPZ 2010-02-25
好帖当然要顶....
  • 打赏
  • 举报
回复
加载更多回复
相关推荐
发帖
API
加入

1471

社区成员

VB API
申请成为版主
帖子事件
创建了帖子
2010-02-25 02:30
社区公告
暂无公告