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

[aohan]

前几天在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

[孤独剑_LPZ]

好帖当然要顶....

• 打赏
• 举报

回复 赞

[神马被哪个妞占用了呢]

内存修改器么。。。。。。。uping

• 打赏
• 举报

回复 赞

[siLence_Again]

难道是在散分

• 打赏
• 举报

回复 赞

[chinaboyzyq]

好贴，好贴……

• 打赏
• 举报

回复 赞

[无·法]

刚试了 不行啊

回复内容太短了！

• 打赏
• 举报

回复 赞

[luofenghen]

引用 9 楼 sysdzw 的回复:

刚试了 不行啊

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

当然不行了 还有好多API 没申明呢

• 打赏
• 举报

回复 赞

[aohan]

你直接下源码看看，我的测试都正常哦


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

• 打赏
• 举报

回复 赞

[无·法]

引用 11 楼 aohan 的回复:

你直接下源码看看，我的测试都正常哦


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

我就是下的这个源码啊 金钱并没有变化啊

• 打赏
• 举报

回复 赞

[vvsxr]

好东西啊

回复内容太短了！回复内容太短了！回复内容太短了！

• 打赏
• 举报

回复 赞

[aohan]

也可以到这里下载源码：

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

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

• 打赏
• 举报

回复 赞

[舉杯邀明月]

Ding

• 打赏
• 举报

回复 赞

[king06]

启用金钱无限

• 打赏
• 举报

回复 赞

[aohan]

引用 12 楼 sysdzw 的回复:

引用 11 楼 aohan 的回复:
你直接下源码看看，我的测试都正常哦


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

阳光更改是否成功呢？

• 打赏
• 举报

回复 赞

[gukuang78]

学习中，谢谢分享~~~~~~~~~~~

• 打赏
• 举报

回复 赞

[jabulin]

学习中，谢谢分享~~~~~~~~~~~

• 打赏
• 举报

回复 赞

[chenyubo1977]

用外挂玩游戏太没意思了吧

• 打赏
• 举报

回复 赞

[jhone99]

感谢分享

• 打赏
• 举报

回复 赞

[嗷嗷叫的老马]

哈哈.

除了最后的无限生存模式用得着阳光无限与冷却无限外,其它地方就不需要了...

• 打赏
• 举报

回复 赞

[aohan]

小意思了

回复内容太短了

• 打赏
• 举报

回复 赞

[liguicd]

好东西啊，不过，我更喜欢挑战僵尸，哈哈哈

• 打赏
• 举报

回复 赞