Not speed memory solution Help

[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 = &H1012F60 '基址
Private Const processName As String = "spider.exe" '进程

Private Sub cmdMoneyUnlimited_Click() '按钮1

If cmdMoneyUnlimited.Caption = "启用锁定" Then
If GetPid = 0 Then
MsgBox "程序还未打开", vbInformation, "提示"

Exit Sub

End If

cmdMoneyUnlimited.Caption = "停止锁定"
Timer2.Interval = 500
Timer2.Enabled = True
Else
cmdMoneyUnlimited.Caption = "启用锁定"
Timer2.Enabled = False
End If

End Sub

Private Sub cmdSunUnlimited_Click() '按钮2

If cmdSunUnlimited.Caption = "启用锁定" Then
If GetPid = 0 Then
MsgBox "程序还未打开", vbInformation, "提示"

Exit Sub

End If

cmdSunUnlimited.Caption = "停止锁定"
Timer1.Interval = 500
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, False, 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
Else
End If
WriteMemoryValue baseAddress, &H1869F '&H1869F=99999
End Sub

Private Sub Timer2_Timer() '
Dim Address As Long
If GetPid = 0 Then
cmdMoneyUnlimited.Caption = "启用锁定"
Timer2.Enabled = False
Exit Sub
Else
End If
WriteMemoryValue baseAddress, &H98967F '&H1869F=99999
End Sub
Value can not lock who want to help me solve. Thank

I don't get you at all. What do you want?

I cannot help you. Don't chinese people learn English -.-?

Google translator is awful.