3个关于进程的VBA函数

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

你可能感兴趣的:(3个关于进程的VBA函数)