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

2010-02-25 02:30:58 846 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

BERTopic安装指南：hdbscan依赖问题全解析（附解决方案）本文详细解析了安装BERTopic时常见的hdbscan依赖报错问题，深入剖析了C++编译环境缺失、Python版本兼容性以及包管理渠道混用三大核心原因。针对Windows、macOS和Linux不同系统，提供了创建虚拟环境、使用conda安装预编译包、安装C++编译工具等具体解决方案，帮助用户顺利安装BERTopic并开始文本主题建模实践。阅读详情

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