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