Stability fix for hw and sw inventory - wmi object handles and status

Jul 29, 2013 at 9:44 AM
Hi.

Thanks for a great batch tool! I've used it for several jobs to keep our environment clean in both SCCM 2007 + 2012

I've found that there were some issues when running hw or sw inventory, which crashed with a index error and mshta locking up. After looking at the code I found some hint to the errors and did a modification to always reset wmi object handles and status when connecting to new computers. After those modification I've had no major crashes :) Thought I'd share the correction if any other experienced the same.

Here are the modified functions with comments. Note that the web editor here might surely add some unwanted line breaks and special chars, but you will get the idea at least:
' ~~~~~~~~~~~~~~
' Function to check if WMI "root\CIMV2" namespace object is accessible
Function connectWMI(ByVal remoteComputer)
'Version 1.1
'1.0-1.1 FD. ByVal. Added default value False always. Set objWMIService = Nothing if failed
  On Error Resume Next
  Err.Clear
  Set objWMIService = getWMIobject(remoteComputer, "root\CIMV2")
  If (Err.number <> 0) Then
    Set objWMIService = Nothing
    connectWMI = False
    Exit Function
  End If
  connectWMI = True
End Function

' ~~~~~~~~~~~~~~
' Function to check if WMI "root\CIMV2" and "root\CIMV2\sms" namespaces are accessible
Function actionCheckWMI(ByVal remoteComputer)
'Version 1.1
'1.0-1.1 FD ByVal. Set default value to False always. Removed retVal, not needed
    Dim checkStatus: checkStatus = True
    Log "  >> Checking WMI...", True, "checkWMI", 1

    On Error Resume Next
    actionCheckWMI = False
    Err.Clear

    Set objTestWMIObject = getWMIobject(remoteComputer, "root\CIMV2")
    If (Err.number <> 0) Then
      checkStatus = False
    End If
    Set objTestWMIObject = Nothing

    Set objTestWMIObject = getWMIobject(remoteComputer, "root\CIMV2\sms")
    If (Err.number <> 0) Then
      checkStatus = False
    End If
    Set objTestWMIObject = Nothing

    If Not checkStatus Then
        lastCheckResult = "Unhealthy"
        If Not isFullHealthCheck Then
            statUnhealthy = statUnhealthy + 1
        End If
    Else
        lastCheckResult = "Healthy"
        If Not isFullHealthCheck Then
            statHealthy = statHealthy + 1
        End If
        Log "   ** WMI is healthy.", True, "checkWMI", 1
    End If

    actionCheckWMI = checkStatus
End Function    

' ~~~~~~~~~~~~~~
' Function to return specified WMI namespace object
Function getWMIobject(ByVal remoteComputer, ByVal NS)
'Version 1.1
'1.0-1.1 FD. ByVal. Removed variable returnObject, not used!
'       Set objWmi=Nothing if failed.
On Error Resume Next
    Err.Clear
    If integratedAuth OR remoteComputer = "." Then
        Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate,authenticationLevel=pktPrivacy}\\" & remoteComputer & "\" & NS)
    Else
        Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
        objWbemLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPkt
        Set objWMI = objWbemLocator.ConnectServer(remoteComputer, NS, strUsername, strPassword)
    End If
  If (Err.number <> 0) Then
    statWMIerror = statWMIerror + 1
    Log " !! Failed to connect to WMI namespace """&NS&""" on " & UCase(remoteComputer) & ". Error "&Err.Number&" ("&Err.Description&")", True, "getWMIObject", 3
    Set getWMIobject = Nothing
    Set objWMI = Nothing
  Else
    Set getWMIobject = objWMI
  End If
End Function

' ~~~~~~~~~~~~~~
' Function to connect to Win32_Process class. Uses global object objWMIProcess
Function getWMIProcessObject(ByVal remoteComputer)
'Version 1.1
'1.0-1.1 FD. ByVal. Added default value False always. Removed retVal variable, not needed
'           Set objWMIProcess = Nothing if failed
    On Error Resume Next
    Err.Clear
    getWMIProcessObject = False
    Set objWMIProcess = objWMIService.Get("Win32_Process")
    If (Err.number <> 0) Then
        statWMIerror = statWMIerror + 1
            Log " !! Failed to connect to ""Win32_Process"" WMI class on " & UCase(remoteComputer) & ". Error "&Err.Number&" ("&Err.Description&")", True, "getWMIProcessObject", 3
      Set objWMIProcess = Nothing 
      Exit Function
    Else
        getWMIProcessObject = True
    End If
End Function

' ~~~~~~~~~~~~~~
' Function to WMI object for \root\default:StdRegProv class 
Function getWMIRegistryObject(ByVal remoteComputer)
'Version 1.1
'1.0-1.1 FD. ByVal. Added default value False always. Removed variable returnObject, not used!
'       Set objWMIRegistry = Nothing if failed
On Error Resume Next
    Err.Clear
    getWMIRegistryObject = False
    If integratedAuth OR remoteComputer = "." Then
        Set objWMIRegistry = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & remoteComputer & "\root\default:StdRegProv")
    Else
        Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
        objWbemLocator.Security_.AuthenticationLevel = wbemAuthenticationLevelPkt
        Set objWbemServices = objWbemLocator.ConnectServer(remoteComputer, "root\default", strUsername, strPassword)
        Set objWMIRegistry = objWbemServices.Get("StdRegProv")
    End If
  If (Err.number <> 0) Then
    statWMIerror = statWMIerror + 1
    Log " !! Failed to connect to registry via WMI on " & UCase(remoteComputer) & ". Error "&Err.Number&" ("&Err.Description&")", True, "getWMIRegistryObject", 3
    Set objWMIRegistry = Nothing
    Exit Function
  End If

  getWMIRegistryObject = True
End Function