Link to home
Start Free TrialLog in
Avatar of bbcac
bbcac

asked on

VBScript hanging on WMI Query dispite error handling

I have a script that is very long that is hanging upon a WMI query to a particular host. Rather then trying to fix the orginal script I created this small snippet to test my code.

This code hangs for several hours until I kill the process. Just a note it works on all other servers just fine. I can also remote into, and manage remotely this server through windows tools. I should also not that it is line 3 that creates the issues as I have added msgbox outputs to see where the hanging begins.

It is not my desire to fix the problematic server, rather to correct the script to handle this situation.

Thanks,
ON ERROR RESUME NEXT
strComputer = "problemserver"
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select Description from Win32_PnPEntity")

For Each objItem in colItems
    Wscript.Echo "Description: " & objItem.Description
    Wscript.Echo
Next

Open in new window

Avatar of Rich Rumble
Rich Rumble
Flag of United States of America image

Have you tried without the "impersonate" part:

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PnPEntity",,48)

If your not using it already, the Scriptomatic is an awesome WMI/VBS tool, the code below was generated using it.
-rich
On Error Resume Next
arrComputers = Array(".")
'commented out multiple computers below
'arrComputers = Array("pc1, pc2, server1, server22")
For Each strComputer In arrComputers
   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PnPEntity",,48)

   For Each objItem In colItems
      WScript.Echo "Availability: " & objItem.Availability
      WScript.Echo "Caption: " & objItem.Caption
      WScript.Echo "ClassGuid: " & objItem.ClassGuid
      WScript.Echo "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
      WScript.Echo "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
      WScript.Echo "CreationClassName: " & objItem.CreationClassName
      WScript.Echo "Description: " & objItem.Description
      WScript.Echo "DeviceID: " & objItem.DeviceID
      WScript.Echo "ErrorCleared: " & objItem.ErrorCleared
      WScript.Echo "ErrorDescription: " & objItem.ErrorDescription
      WScript.Echo "InstallDate: " & WMIDateStringToDate(objItem.InstallDate)
      WScript.Echo "LastErrorCode: " & objItem.LastErrorCode
      WScript.Echo "Manufacturer: " & objItem.Manufacturer
      WScript.Echo "Name: " & objItem.Name
      WScript.Echo "PNPDeviceID: " & objItem.PNPDeviceID
      strPowerManagementCapabilities = Join(objItem.PowerManagementCapabilities, ",")
         WScript.Echo "PowerManagementCapabilities: " & strPowerManagementCapabilities
      WScript.Echo "PowerManagementSupported: " & objItem.PowerManagementSupported
      WScript.Echo "Service: " & objItem.Service
      WScript.Echo "Status: " & objItem.Status
      WScript.Echo "StatusInfo: " & objItem.StatusInfo
      WScript.Echo "SystemCreationClassName: " & objItem.SystemCreationClassName
      WScript.Echo "SystemName: " & objItem.SystemName
      WScript.Echo
   Next
Next

Function WMIDateStringToDate(dtmDate)
WScript.Echo dtm: 
	WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
	Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
	& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function

Open in new window

You can also try it like this, which uses a ping test, and a WMI connection timeout test, from my article here:
https://www.experts-exchange.com/A_4379.html

Regards,

Rob.
Const WMITimeOutInSeconds = 10
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

strComputer = "problemserver"
If Ping(strComputer) = True Then
	strReturn = TestWMIConnection(strComputer, WMITimeOutInSeconds)
	If strReturn = "success" Then
		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
		Set colItems = objWMIService.ExecQuery("Select Description from Win32_PnPEntity")
		For Each objItem In colItems
			Wscript.Echo "Description: " & objItem.Description
			Wscript.Echo
		Next
	ElseIf strReturn = "failed" Then
		WScript.Echo strComputer & ": WMI ERROR"
	Else
		WScript.Echo strComputer & ": WMI TIME OUT"
	End If
Else
	WScript.Echo strComputer & ": Ping failed"
End If


Function Ping(strComputer)
   Dim objShell, boolCode
   Set objShell = CreateObject("WScript.Shell")
   boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
   If boolCode = 0 Then
      Ping = True
   Else
      Ping = False
   End If
End Function

Function TestWMIConnection(strComputer, intTimeOutInSeconds)
   ' Function written by Rob Sampson - 12 Jan 2011
   ' Experts-Exchange volunteer: http://www.experts-exchange.com/M_3820065.html
   ' Return strings from this function are in lower case, and consist of:
   ' "success": WMI Connection successful
   ' "failed": WMI Connection failed
   ' "time out": WMI Connection attempt timed out

   Set objFSO = CreateObject("Scripting.FileSystemObject")
   strTempScript = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempWMITestToBeDeleted.vbs"

   Set objTempFile = objFSO.CreateTextFile(strTempScript, True)
   objTempFile.WriteLine "On Error Resume Next"
   objTempFile.WriteLine "Set objWMIService = GetObject(""winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2"")"
   objTempFile.WriteLine "If Err.Number = 0 Then"
   objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""success"""
   objTempFile.WriteLine "Else"
   objTempFile.WriteLine vbTab & "WScript.StdOut.Write ""failed"""
   objTempFile.WriteLine "End If"
   objTempFile.Close

   Set objShell = CreateObject("WScript.Shell")
   Set objExec = objShell.Exec("wscript " & objFSO.GetFile(strTempScript).ShortPath)
   intSeconds = 0
   While objExec.Status = 0 And intSeconds <= intTimeOutInSeconds
      WScript.Sleep 1000
      intSeconds = intSeconds + 1
   Wend
   If objExec.Status = 1 Then
      strReturn = objExec.StdOut.ReadAll
   Else
      On Error Resume Next
      objExec.Terminate
      Err.Clear
      On Error GoTo 0
      strReturn = "time out"
   End If
   objFSO.DeleteFile strTempScript, True

   TestWMIConnection = LCase(strReturn)
End Function

Open in new window

Sounds like a corrupt WMI instance.

On that server run this:  rundll32 wbemupgd, RepairWMISetup

Reboot it and try your script again.
Avatar of bbcac
bbcac

ASKER

Netman66,
I agree this is a WMI issue on the client. However the script must mitigate this issue.

richrumble,
Getting rid of the impersonate does not solve the issue.


RobSampson,
I can't rely on PING as some of the servers have ICMP turned off
If WMI is broken, what do you expect the script to do?

You can execute the WMI fix remotely with Admin rights using REXEC.

Other than that, you can try an ON ERROR RESUME NEXT statement to see if it will skip the fact it isn't responding.

You might be able to kick off another timer script just before the query and kill the process if it takes too long, but that kind of defeats the automation.

You're best to correct each server as you encounter them - do not execute the script on servers that are broken.

Here is a tool for WMI Diag:  http://www.microsoft.com/download/en/details.aspx?id=7684

Perhaps you can execute this (or some part of it) before your script runs and parse the output for certain values which you can use to decide to run your script or move on to the next server.


I agree with Netman66.
-rich
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial