pid 在任务管理器看不到了 openprocess 为什么还返回非0?
R T
程序代码:Const SYNCHRONIZE = &H100000
'一直等待
Const INFINITE = &HFFFF
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub Command1_Click()
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
lPid = Shell("notepad.exe", vbNormalFocus)
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
If lHnd <> 0 Then
lRet = WaitForSingleObject(lHnd, INFINITE)
CloseHandle (lHnd)
End If
MsgBox "已终止.", vbInformation, "Shelled Application"
End If
End Sub
程序代码:Option Explicit
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
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 GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Dim c As FILETIME
Dim e As FILETIME
Dim k As FILETIME
Dim u As FILETIME
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
Private Sub Command1_Click()
lPid = Shell("notepad.exe", vbNormalFocus)
If lPid <> 0 Then
lHnd = OpenProcess(PROCESS_ALL_ACCESS, 0, lPid)
Form1.Caption = lHnd
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Dim temp As Long
temp = GetProcessTimes(lHnd, c, e, k, u)
Text1.Text = temp & "," & e.dwHighDateTime & "," & e.dwLowDateTime
If e.dwHighDateTime <> 0 Or e.dwLowDateTime <> 0 Then
Form1.Caption = "完成"
CloseHandle lHnd
Timer1.Enabled = False
End If
End Sub也可以这样
程序代码:
If TheProcesses(0) <> 0 Then
Dim i As Long
For i = UBound(TheProcesses) To 0 Step -1
Dim a As Long
a = OpenProcess(PROCESS_ALL_ACCESS, False, TheProcesses(i))
If a = 0 Then
Call DeleteFormArray(TheProcesses, i)
Else
Dim CreationTime As FileTime, ExitTime As FileTime, KernelTime As FileTime, UserTime As FileTime
If GetProcessTimes(a, CreationTime, ExitTime, KernelTime, UserTime) = 0 Then
MsgBox GetLastError
Call DeleteFormArray(TheProcesses, i)
Else
If ExitTime.dwHighDateTime <> 0 And ExitTime.dwLowDateTime <> 0 Then
Call DeleteFormArray(TheProcesses, i)
End If
End If
End If
Call CloseHandle(a)
Next i
End If