Public Function IsExeRunning(exeName As String) As Boolean
If testing Then Exit Function
On Error GoTo ErrorHandler
Dim flag As Boolean
Dim strComputer As String
Dim objWMI As Object, objProcessSet As Object, objProcess As Object
Dim strUserName As String
Dim strUserDomain As String
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set objProcessSet = objWMI.ExecQuery("SELECT Name FROM Win32_Process WHERE Name = '" & exeName & "'")
'MsgBox objProcessSet.count
'MsgBox Environ$("username")
For Each objProcess In objProcessSet
objProcess.GetOwner strUserName, strUserDomain
'MsgBox strUserName
If strUserName = Environ$("username") Then
flag = True
Exit For
End If
'MsgBox "Process " & objProcess.Name & " is owned by " & strUserDomain & "\" & strUserName & "."
Next
'If objProcessSet.count > 0 Then
' flag = True
'Else
' flag = False
'End If
' For Each Process In objProcessSet
' If Process.Name = exeName Then
' flag = True
' Exit For
' End If
' Next
ErrorHandler:
Set objProcessSet = Nothing
Set objWMI = Nothing
If Err.Number <> 0 Then
IsExeRunning = True
Else
IsExeRunning = flag
End If
End Function
Public Function CntExeRunning(exeName As String) As Integer
If testing Then Exit Function
'On Error GoTo ErrorHandler
On Error Resume Next
'Dim flag As Boolean
Dim cnt As Integer
'cnt = 0
Dim strComputer As String
Dim objWMI As Object
Dim objProcessSet As Object
'Dim objProcess As Object
Dim strUserName As String
Dim strUserDomain As String
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set objProcessSet = objWMI.ExecQuery("SELECT Name FROM Win32_Process WHERE Name = '" & exeName & "'")
'MsgBox objProcessSet.count
cnt = objProcessSet.count
'ErrorHandler:
If Err.Number <> 0 Then
'Do nothing as always error
'MyMsgBox Err.Number & " " & Err.Description, 10
'cnt = 0
End If
'MyMsgBox cnt & "", 10
Set objProcessSet = Nothing
Set objWMI = Nothing
CntExeRunning = cnt
End Function
Public Function KillExeRunning(exeName As String) As Boolean
If testing Then Exit Function
On Error Resume Next
Dim flag As Boolean
flag = False
Dim strComputer As String
Dim objWMI As Object, objProcessSet As Object, objProcess As Object
Dim strUserName As String
Dim strUserDomain As String
strComputer = "."
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set objProcessSet = objWMI.ExecQuery("SELECT Name FROM Win32_Process WHERE Name = '" & exeName & "'")
If objProcessSet.count > 0 Then
For Each objProcess In objProcessSet
objProcess.GetOwner strUserName, strUserDomain
'MsgBox strUserName
If strUserName = Environ$("username") Then
End If
'MsgBox "Process " & objProcess.Name & " is owned by " & strUserDomain & "\" & strUserName & "."
If objProcess.Name = exeName Then
Dim errReturnCode As Integer
errReturnCode = objProcess.Terminate()
'MsgBox errReturnCode
If errReturnCode = 0 Then
flag = True
End If
End If
Next
End If
Set objProcessSet = Nothing
Set objWMI = Nothing
KillExeRunning = flag
End Function
网友评论