'*************************************************************************
' $ScriptName: "Microsoft.Windows.Server.Common"$
'
' Purpose: To have one place for common stuff across various BaseOS VBScripts
'
' $File: Microsoft.Windows.Server.Common.vbs$
'*************************************************************************
'---------------------------------------------------------------------------
' Returns WMI Instance requested. Tries to execute WMI query a N times.
'---------------------------------------------------------------------------
Function WMIGetInstanceExTryN(oWMI, ByVal sInstance, ByVal N)
Dim oInstance, nInstanceCount
Dim e, i
Set e = New Error
For i = 0 To i < N
On Error Resume Next
Set oInstance = oWMI.InstancesOf(sInstance)
e.Save
On Error Goto 0
If IsEmpty(oInstance) Or e.Number <> 0 Then
If i = N - 1 Then
ThrowScriptError "The class name '" & sInstance & "' returned no instances. Please check to see if this is a valid WMI class name.", e
End If
Else
On Error Resume Next
nInstanceCount = oInstance.Count
e.Save
On Error Goto 0
If e.Number <> 0 Then
If i = N - 1 Then
ThrowScriptError "The class name '" & sInstance & "' did not return any valid instances. Please check to see if this is a valid WMI class name.", e
End If
Else
Exit For
End If
End If
WScript.Sleep(1000)
Next
Set WMIGetInstanceExTryN = oInstance
End Function
'---------------------------------------------------------------------------
' Returns WMI Instance requested.
'---------------------------------------------------------------------------
Function WMIGetInstanceEx(oWMI, ByVal sInstance)
Dim oInstance, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oInstance = oWMI.InstancesOf(sInstance)
e.Save
On Error Goto 0
If IsEmpty(oInstance) Or e.Number <> 0 Then
ThrowScriptError "The class name '" & sInstance & "' returned no instances. Please check to see if this is a valid WMI class name.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oInstance.Count
e.Save
On Error Goto 0
If e.Number <> 0 Then
ThrowScriptError "The class name '" & sInstance & "' did not return any valid instances. Please check to see if this is a valid WMI class name.", e
End If
Set WMIGetInstanceEx = oInstance
End Function
'---------------------------------------------------------------------------
' Connect to WMI.
'---------------------------------------------------------------------------
Function WMIConnect(ByVal sNamespace)
Dim oWMI
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptError "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
End If
Set WMIConnect = oWMI
End Function
'---------------------------------------------------------------------------
' Returns WMI Instance requested.
'---------------------------------------------------------------------------
Function WMIGetInstance(ByVal sNamespace, ByVal sInstance)
Dim oWMI, oInstance
Set oWMI = WMIConnect(sNamespace)
Set oInstance = WMIGetInstanceEx(oWMI, sInstance)
Set WMIGetInstance = oInstance
End Function
'---------------------------------------------------------------------------
' Returns WMI Instance requested.
'---------------------------------------------------------------------------
Function WMIGetInstanceNoAbort(ByVal sNamespace, ByVal sInstance)
Dim oWMI, oInstance, nInstanceCount
On Error Resume Next
Set oWMI = GetObject(sNamespace)
If Not IsEmpty(oWMI) Then
Set oInstance = oWMI.InstancesOf(sInstance)
If Not IsEmpty(oInstance) And Err.Number = 0 Then
'Determine if we queried a valid WMI class - Count will return 0 or empty
nInstanceCount = oInstance.Count
If Err.Number = 0 Then
Set WMIGetInstanceNoAbort = oInstance
On Error Goto 0
Exit Function
End If
End If
End If
On Error Goto 0
Set WMIGetInstanceNoAbort = Nothing
End Function
'---------------------------------------------------------------------------
' Executes the WMI query and returns the result set.
'---------------------------------------------------------------------------
Function WMIExecQuery(ByVal sNamespace, ByVal sQuery)
Dim oWMI, oQuery, nInstanceCount
Dim e
Set e = New Error
On Error Resume Next
Set oWMI = GetObject(sNamespace)
e.Save
On Error Goto 0
If IsEmpty(oWMI) Then
ThrowScriptError "Unable to open WMI Namespace '" & sNamespace & "'. Check to see if the WMI service is enabled and running, and ensure this WMI namespace exists.", e
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
e.Save
On Error Goto 0
If IsEmpty(oQuery) Or e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' returned an invalid result set. Please check to see if this is a valid WMI Query.", e
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
e.Save
On Error Goto 0
If e.Number <> 0 Then
ThrowScriptError "The Query '" & sQuery & "' did not return any valid instances. Please check to see if this is a valid WMI Query.", e
End If
Set WMIExecQuery = oQuery
End Function
'---------------------------------------------------------------------------
' Executes the WMI query and returns the result set, no abort version.
'---------------------------------------------------------------------------
Function WMIExecQueryNoAbort(ByVal sNamespace, ByVal sQuery)
Dim oWMI, oQuery
Set oWMI = GetObject(sNamespace)
Set oQuery = oWMI.ExecQuery(sQuery)
Set WMIExecQueryNoAbort = oQuery
End Function
'---------------------------------------------------------------------------
' Retrieves WMI property.
'---------------------------------------------------------------------------
Function GetWMIProperty(oWmi, sPropName, nCIMType, ErrAction)
Dim sValue, oWmiProp, oError
Set oError = New Error
' Check that object is valid.
If Not IsValidObject(oWmi) Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "Accessing property on invalid WMI object.", oError
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
GetWMIProperty = ""
Exit Function
End If
' Get properties...
On Error Resume Next
Set oWmiProp = oWmi.Properties_.Item(sPropName)
oError.Save
If oError.Number <> 0 Then
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", oError
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
End If
On Error Goto 0
If IsValidObject(oWmiProp) Then
sValue = oWmiProp.Value
If IsNull(sValue) Then ' If value is null, return blank to avoid any issues
GetWMIProperty = ""
Else
Select Case (oWmiProp.CIMType)
Case wbemCimtypeString, wbemCimtypeSint16, wbemCimtypeSint32, wbemCimtypeReal32, wbemCimtypeReal64, wbemCimtypeSint8, wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32, wbemCimtypeSint64, wbemCimtypeUint64:
If Not oWmiProp.IsArray Then
GetWMIProperty = Trim(CStr(sValue))
Else
GetWMIProperty = Join(sValue, ", ")
End If
Case wbemCimtypeBoolean:
If sValue = 1 Or UCase(sValue) = "TRUE" Then
GetWMIProperty = "True"
Else
GetWMIProperty = "False"
End If
Case wbemCimtypeDatetime:
Dim sTmpStrDate
' First attempt to convert the whole wmi date string
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4) & " " & _
Mid (sValue, 9, 2) & ":" & _
Mid(sValue, 11, 2) & ":" & _
Mid(sValue, 13, 2)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else
' Second, attempt just to convert the YYYYMMDD
sTmpStrDate = Mid(sValue, 5, 2) & "/" & _
Mid(sValue, 7, 2) & "/" & _
Left(sValue, 4)
If IsDate(sTmpStrDate) Then
GetWMIProperty = CDate(sTmpStrDate)
Else
' Nothing works - return passed in string
GetWMIProperty = sValue
End If
End If
Case Else:
GetWMIProperty = ""
End Select
End If
Else
If (ErrAction And ErrAction_ThrowError) = ErrAction_ThrowError Then _
ThrowScriptErrorNoAbort "An error occurred while accessing WMI property: '" & sPropName & "'.", oError
If (ErrAction And ErrAction_Abort) = ErrAction_Abort Then _
Quit()
GetWMIProperty = ""
End If
If (ErrAction And ErrAction_Trace) = ErrAction_Trace Then _
WScript.Echo " + " & sPropName & " :: '" & GetWMIProperty & "'"
End Function
'---------------------------------------------------------------------------
' Class for error handling.
'---------------------------------------------------------------------------
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
'---------------------------------------------------------------------------
' Creates an event and sends it back to the mom server.
'---------------------------------------------------------------------------
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
' Retrieve the name of this (running) script
Dim FSO, ScriptFileName
Set FSO = CreateObject("Scripting.FileSystemObject")
ScriptFileName = FSO.GetFile(WScript.ScriptFullName).Name
Set FSO = Nothing
If Not IsNull(oErr) Then _
sMessage = sMessage & ". " & oErr.Description
On Error Resume Next
Dim oAPITemp
Set oAPITemp = CreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent ScriptFileName, g_ErrorEventNumber, lsEventError, sMessage
On Error Goto 0
WScript.Echo sMessage
End Function
'---------------------------------------------------------------------------
' Creates an event and sends it back to the mom server.
'---------------------------------------------------------------------------
Function ThrowScriptError(Byval sMessage, ByVal oErr)
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
Quit()
End Function
'---------------------------------------------------------------------------
' Creates automation objects and returns it.
'---------------------------------------------------------------------------
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error Goto 0
If oError.Number <> 0 Then
ThrowScriptError "Unable to create automation object '" & sProgramId & "'", oError
End If
End Function
'---------------------------------------------------------------------------
' Quits the script.
'---------------------------------------------------------------------------
Function Quit()
WScript.Quit()
End Function
'---------------------------------------------------------------------------
' Checks whether oObject is valid.
'---------------------------------------------------------------------------
Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
'---------------------------------------------------------------------------
' Outputs arguments for debugging purposes
'---------------------------------------------------------------------------
Function TraceLogArguments
Dim oArgs
Set oArgs = WScript.Arguments
Dim i, sArgs
For i = 0 To oArgs.Count - 1
sArgs = sArgs & " {" & oArgs(i) & "}"
Next
TraceLogMessage "Arguments:" & sArgs
End Function
'---------------------------------------------------------------------------
' Verifies that number of arguments is correct
'---------------------------------------------------------------------------
Function VerifyNumberOfArguments(ByVal NumberOfArguments)
Dim oArgs
Set oArgs = WScript.Arguments
If oArgs.Count <> NumberOfArguments Then
Dim i, sArgs
For i = 0 To oArgs.Count - 1
sArgs = sArgs & " {" & oArgs(i) & "}"
Next
ThrowScriptError "Invalid number of arguments (" & oArgs.Count & " instead of " & NumberOfArguments & "). Arguments:" & sArgs, Null
End If
End Function
'---------------------------------------------------------------------------
' Outputs to file and echo for debugging purposes
'---------------------------------------------------------------------------
Function TraceLogMessage(ByVal sMessage)
WScript.Echo sMessage
If g_DebugFlag = True Then
' Retrieve the name of this (running) script
Dim FSO, ScriptFileName
Set FSO = CreateObject("Scripting.FileSystemObject")
ScriptFileName = FSO.GetFile(WScript.ScriptFullName).Name
Set FSO = Nothing
On Error Resume Next
Dim oAPITemp
Set oAPITemp = MOMCreateObject("MOM.ScriptAPI")
oAPITemp.LogScriptEvent ScriptFileName, g_TraceEventNumber, lsEventInformation, sMessage
On Error Goto 0
End If
End Function
'---------------------------------------------------------------------------
' Verifies the expression. If equals to False then generates an error and quits the script
' Usage:
' Verify Not WMISet Is Nothing, "WMISet is invalid!"
' Verify WMISet.Count = 1, "Invalid quantity of services with name 'Server' (qty = " & WMISet.Count & ")."
'---------------------------------------------------------------------------
Function Verify(ByVal bBool, ByVal sMessage)
If bBool = False Then
ThrowScriptError sMessage, Null
End If
End Function
Function GetRegistryKeyValue(ByVal keyPath, ByVal key)
Dim oReg, strKeyValue
Set oReg = MOMCreateObject("WScript.Shell")
On Error Resume Next
strKeyValue = oReg.RegRead(keyPath & key)
If Err.Number <> 0 Then
ThrowScriptError "An error occurred while reading the registry: '" & keyPath & key & "'", Err.Description
strKeyValue = ""
End If
' resume error
On Error Goto 0
GetRegistryKeyValue = strKeyValue
End Function
'---------------------------------------------------------------------------
' Function: ExpressedInMB
' Usage:
' Parameter (SizeInBytes)
' Returns the Size Expressed in MBytes
'---------------------------------------------------------------------------
Function ExpressedInMB(byref SizeInBytes)
Dim NumberSizeExpInMB
NumberSizeExpInMB = Round(SizeInBytes / DISKSIZE_BYTES_IN_MB, 0)
ExpressedInMB = NumberSizeExpInMB
End Function
'Copyright (c) Microsoft Corporation. All rights reserved.
' Parameters that should be passed to this script
' 0 Computer (FQDN)
' 1 SleepTime - interval (in milliseconds) between samples
' 2 NumberOfSamples
SetLocale("en-us")
Call Main()
Sub Main()
VerifyNumberOfArguments(3)
Dim oArgs
Set oArgs = WScript.Arguments
Dim TargetComputer, SleepTime, NumberOfSamples
TargetComputer = oArgs(0)
SleepTime = oArgs(1)
NumberOfSamples = oArgs(2)
Dim objRefresher, oWMI, objRefreshableItem
Set objRefresher = CreateObject("WbemScripting.SWbemRefresher")
Set oWMI = WMIConnect("winmgmts:\\" & TargetComputer & "\root\cimv2")
Dim lNumProcessors
lNumProcessors = GetNumProcessors(oWMI)
Set objRefreshableItem = objRefresher.AddEnum(oWMI,"Win32_PerfFormattedData_PerfProc_Process")
objRefresher.Refresh
' List processes using more than 1% of processor time (take into account the number of CPU).
' Sample <NumberOfSamples> times waiting <SleepTime> milliseconds between samples.
Dim processDictionary, key
Set processDictionary = WScript.CreateObject("Scripting.Dictionary")
For i = 1 to NumberOfSamples
Wscript.Sleep SleepTime
objRefresher.Refresh
Dim Process
For Each Process in objRefreshableItem.ObjectSet
If Process.Name <> "_Total" and Process.Name <> "Idle" and Process.PercentProcessorTime > lNumProcessors Then
key = Process.Name&"::"&Process.IDProcess
If processDictionary.Exists(key) = true Then
processDictionary.Item(key) = CDbl(processDictionary.Item(key)) + CDbl(Process.PercentProcessorTime)
Else
processDictionary.Add key, CDbl(Process.PercentProcessorTime)
End If
End If
Next
Next
' Collected Samples
' Get the keys
Dim processKeys
processKeys = processDictionary.keys
'Iterate over all the process for five times
For i = 0 To processDictionary.Count -1
If processDictionary.Exists(processKeys(i)) = true Then
processName(i) = processKeys(i)
If Len(processName(i)) > maxProcessName Then
maxProcessName = Len(processName(i))
End If
processValue(i) = CDbl(CDbl(processDictionary.Item(processKeys(i))) / CDbl(NumberOfSamples) / CDbl(lNumProcessors))
End If
Next
' Sort the array using bubble sort
For i = 0 To processDictionary.Count -1
For j = i+1 To processDictionary.Count -1
If processValue(i) < processValue(j) Then
Dim swap, swap1
swap = processValue(i)
processValue(i) = processValue(j)
processValue(j) = swap
swap1 = processName(i)
processName(i) = processName(j)
processName(j) = swap1
End If
Next
Next
Wscript.Echo "% CPU Time(Avg) PID Binary Name "
Wscript.Echo "==============================================================================="
For i = 0 To processDictionary.Count -1
If processValue(i) <= 0 Then
Exit For
End If
Dim pValue
pValue = Fix(processValue(i)*10) /10
Dim pidPos
pidPos = InStr(processName(i), "::")
If IsNull(pidPos) Or pidPos = 0 Then
err.Clear
Else
Dim pidLength
pidLength = Len(Right(processName(i),Len(processName(i)) - pidPos-2))
Dim valueLength
valueLength= Len(pValue)
Dim OutPutString
OutPutString = " " & pValue & "%"
For j = 0 To 5 - valueLength
OutPutString = OutPutString & " "
Next
OutPutString = OutPutString &" " & Right(processName(i),Len(processName(i)) - pidPos-1)
For j = 0 To 8 - pidLength
OutPutString = OutPutString & " "
Next
OutPutString = OutPutString & " "& Left(processName(i),pidPos-1)
Wscript.echo OutPutString
End If
Next
End Sub
' Windows Server 2003, Windows XP, and Windows 2000: Because the NumberOfLogicalProcessors property
' is not available, NumberOfProcessors indicates the number of logical processors available in the
' system. In the case of a computer system that has two physical processors each containing two
' logical processors, the value of NumberOfProcessors is 4.
' For more information see "http://msdn2.microsoft.com/en-us/library/aa394102(VS.85).aspx"
Function GetNumProcessors(oWMI)
Dim WMISet, owObj
Set WMISet = WMIGetInstanceEx(oWMI, "Win32_ComputerSystem")
For Each owObj In WMISet
On Error Resume Next
GetNumProcessors = owObj.NumberOfLogicalProcessors
If Err.number <> 0 Then
GetNumProcessors = owObj.NumberOfProcessors
End If
On Error GoTo 0
Next
End Function </Script></ScriptBody>
<SecureInput/>
<TimeoutSeconds>300</TimeoutSeconds>
</ProbeAction>
</MemberModules>
<Composition>
<Node ID="PA"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.CommandOutput</OutputType>
<InputType>System!System.BaseData</InputType>
</ProbeActionModuleType>
Home
ENU 
Show References: