![]() |
#2
zyf7794032342013-08-27 19:53
|

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
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
请问我哪里有问题啊?