当我们使用Visual Basic 6.0 开发时,很多时候,我们需要对进程进行操作,这是Windows的API就帮了不少忙。请看看下面从网络收集并经过整理的一些方法:
1、判断某一进程是否正在运行(通过任务管理器)
' ********************************************************************
' 函数名称:CheckApplicationIsRun
' 功能描述:通过进程名称检查应用程序是否运行
' 输 入:ByVal ProcessName As String
' 返 回:Boolean
' ********************************************************************
Private Function CheckApplicationIsRun(ByVal ProcessName As String) As Boolean
On Error GoTo Err
Dim WMI
Dim Obj
Dim Objs
Dim lngResult As Long
CheckApplicationIsRun = False
Set WMI = GetObject("WinMgmts:")
Set Objs = WMI.InstancesOf("Win32_Process")
For Each Obj In Objs
lngResult = StrComp(UCase(ProcessName), UCase(Obj.Description))
If lngResult = 0 Then
CheckApplicationIsRun = True
If Not Objs Is Nothing Then Set Objs = Nothing
If Not WMI Is Nothing Then Set WMI = Nothing
Exit Function
End If
Next
If Not Objs Is Nothing Then Set Objs = Nothing
If Not WMI Is Nothing Then Set WMI = Nothing
Exit Function
Err:
If Not Objs Is Nothing Then Set Objs = Nothing
If Not WMI Is Nothing Then Set WMI = Nothing
End Function
2、关闭某一正在运行的进程
' ********************************************************************
' 函数名称:KillProcess
' 功能描述:关闭指定名称的进程
' 输 入:sProcess As String
' 返 回:无
' ********************************************************************
Private Sub KillProcess(sProcess As String)
Dim lSnapShot As Long
Dim lNextProcess As Long
Dim tPE As PROCESSENTRY32
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> -1 Then
tPE.dwSize = Len(tPE)
lNextProcess = Process32First(lSnapShot, tPE)
Do While lNextProcess
If LCase$(sProcess) = LCase$(Left(tPE.szExeFile, InStr(1, tPE.szExeFile, Chr(0)) - 1)) Then
Dim lProcess As Long
Dim lExitCode As Long
lProcess = OpenProcess(1, False, tPE.th32ProcessID)
TerminateProcess lProcess, lExitCode
CloseHandle lProcess
End If
lNextProcess = Process32Next(lSnapShot, tPE)
Loop
CloseHandle (lSnapShot)
End If
End Sub
3、挂起或恢复进程
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 Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or &HFFF)
Private Declare Function NtSuspendProcess Lib "ntdll.dll" (ByVal hProc As Long) As Long
Private Declare Function NtResumeProcess Lib "ntdll.dll" (ByVal hProc As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private hProcess As Long
Private Sub cmdClose_Click()
CloseHandle hProcess
End Sub
Private Sub cmdResume_Click()
If IsNumeric(txtPid.Text) Then
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, CLng(txtPid.Text))
If hProcess <> 0 Then
NtResumeProcess hProcess '继续
'NtSuspendProcess 挂起
End If
End If
End Sub
Private Sub cmdTerminate_Click()
If hProcess Then
TerminateProcess hProcess, 0
Else
If IsNumeric(txtPid.Text) Then
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, CLng(txtPid.Text))
If hProcess <> 0 Then
TerminateProcess hProcess, 0
End If
End If
End If
End Sub
4、通过进程句柄等待某一应用程序执行完毕再往下执行
Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103
Dim lngProgramID As Long
Dim lngExitCode As Long
Dim hProcess As Long
lngProgramID = Shell(strExecuteFileName, vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, lngProgramID)
Do
Call GetExitCodeProcess(hProcess, lngExitCode)
DoEvents
Loop While lngExitCode = STILL_ALIVE
Call CloseHandle(hProcess)