程序代码：

Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Dim dizhi As Long
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SPECIFIC_RIGHTS_ALL = &HFFFF
Const STANDARD_RIGHTS_ALL = &H1F0000
Const PROCESS_ALL_ACCESS = &HFFF
Const PROCESS_VM_OPERATION = &H8&
Const PROCESS_VM_READ = &H10&
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()
dizhi = &H9430190
End Sub

   Private Function ncnr(lpADDress As Long) As Integer
   Dim hwnd As Long      
   Dim pid As Long      
   Dim pHandle As Long  
   hwnd = FindWindow(vbNullString, "Warcraft III")
   GetWindowThreadProcessId hwnd, pid
   pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
   ReadProcessMemory pHandle, lpADDress, ByVal VarPtr(ncnr), 4, 0&
   CloseHandle hProcess
End Function

Private Sub Timer1_Timer()
On Error Resume Next
Dim s, objWMIService, colProcessList, objProcess
Dim mFind As Boolean
s = "war3.exe"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name='" & s & "'")
For Each objProcess In colProcessList
mFind = True
Next
If mFind Then
Label1 = "游戏已经加载。 [War3.exe]"
Else
Label1 = "进程没有被找到。 [请运行War3.exe]"
End If
End Sub

Private Sub Timer2_Timer()
Label5 = ncnr(dizhi)
End Sub