'*************************************************************************
' $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 name this rule is running against
' 1 Use MacAddress for discovery (true), otherwise NetConnectionID
If CBool(IsUseMacAddress) = True Then
sQuery = sQuery & "MacAddress <> Null And ServiceName <> 'PptpMiniport' And ServiceName <> 'RasPppoe' And ServiceName <> 'VMSMP'"
Else
sQuery = sQuery & "NetConnectionID <> Null And ServiceName <> 'VMSMP'"
End If
Set WMISet = WMIGetInstance("winmgmts:\\" + sTargetComputer + "\root\cimv2", sQuery)
' If at least one network adapter has NetConnectionID then it is supported.
' In this case we should discover network adapters only with NetConnectionID <> "".
Dim IsCheckNetConnectionID, sNetConnectionID, bHasItems, sNetConnectionStatus, bNetConnectionStatus, bIsDisabled
IsCheckNetConnectionID = IsNetConnectionIDSupported(WMISet)
bHasItems = False
For Each owObj in WMISet
Dim oInterface, WMISet2, WMIPropSet, WMIProp, sPerfMonInstanceName, sDeviceID, sName, nCurrentBandwidth, owObj2, nBytesSentPersec, nBytesReceivedPersec, nBytesTotalPersec
' The Network Adapter information does not get populated correctly under Server 2008 Core.
' The NetConnectionStatus parameter is always NULL, so under Server 2008 Core this discovery
' will return all Network Adapters - both enabled and disabled.
' For more information see bugs "Windows OS Bugs", #2030782 & "Windows 7", #119223
sNetConnectionStatus = GetWMIProperty(owObj, "NetConnectionStatus", wbemCimtypeUseDefault, ErrAction_None)
If sNetConnectionStatus = "0" Then
bIsDisabled = True
Else
bIsDisabled = False
End If
If boolUseWIN2012 = true Then
' Checks if OS is at least Windows Server 2012
Set WMIPropSet = WMIExecQuery("winmgmts:\\" + sTargetComputer + "\root\cimv2", "associators of {win32_NetworkAdapter='" & sDeviceID &"'} where ResultClass=Win32_PnPEntity")
For Each WMIProp in WMIPropSet
sPerfMonInstanceName = GetPerfmonInstance(GetWMIProperty(WMIProp, "Name", wbemCimtypeUseDefault, ErrAction_None))
Next
else
' Default for early versions than Windows Server 2012
Set WMIPropSet = WMIExecQuery("winmgmts:\\" + sTargetComputer + "\root\cimv2", "associators of {win32_NetworkAdapter='" & sDeviceID &"'} where ResultClass=win32_NetWorkAdapterConfiguration")
For Each WMIProp in WMIPropSet
sPerfMonInstanceName = GetPerfmonInstance(GetWMIProperty(WMIProp, "Description", wbemCimtypeUseDefault, ErrAction_None))
Next
end If
If (CBool(IsCheckNetConnectionID) = False) Or sNetConnectionID <> "" Then
If boolUseWIN2012 = true Then
' Checks if OS is at least Windows Server 2012
sQuery = "Win32_PerfFormattedData_Tcpip_NetworkAdapter Where Name ='" & sPerfMonInstanceName & "'"
else
' Default for early versions than Windows Server 2012
sQuery = "Win32_PerfFormattedData_Tcpip_NetworkInterface Where Name ='" & sPerfMonInstanceName & "'"
end if
Set WMISet2 = WMIGetInstance("winmgmts:\\" + sTargetComputer + "\root\cimv2", sQuery)
If not IsEmpty(WMISet2) and (WMISet2.Count = 1) Then
If boolUseWIN2012 = true Then
' Checks if OS is at least Windows Server 2012
Set oInterface = WMISet2.Item("Win32_PerfFormattedData_Tcpip_NetworkAdapter='" & sPerfMonInstanceName & "'") 'Expected that will be only one object in set beacause the 'name' property is the key one.
else
' Default for early versions than Windows Server 2012
Set oInterface = WMISet2.Item("Win32_PerfFormattedData_Tcpip_NetworkInterface='" & sPerfMonInstanceName & "'") 'Expected that will be only one object in set beacause the 'name' property is the key one.
end if
If not(Len(CStr(nCurrentBandwidth)) = 0 or Len(CStr(nBytesSentPersec)) = 0 or Len(Cstr(nBytesReceivedPersec)) = 0 or Len(CStr(nBytesTotalPersec)) = 0) Then
Dim Counters, oCounter
Set Counters = CreateObject("Scripting.Dictionary")
Counters.Add CN_PercentBandwidthUsedRead, CalculatePercent(nBytesReceivedPersec,nCurrentBandwidth/8) ' Divide CurrentBandwidth by 8 to convert it from bits to bytes.
Counters.Add CN_PercentBandwidthUsedWrite, CalculatePercent(nBytesSentPersec, nCurrentBandwidth/8)
Counters.Add CN_PercentBandwidthUsedTotal, CalculatePercent(nBytesTotalPersec,nCurrentBandwidth/8)
If Not CBool(bHasItems) Then
bHasItems = True
End If
For Each oCounter in Counters.Keys
Set oBag = oAPI.CreateTypedPropertyBag(2)
With oBag
.AddValue "IsNotEmpty", bHasItems
.AddValue "IsDisabled", bIsDisabled
.AddValue "PerfInstance", sPerfMonInstanceName
.AddValue "PerfCounter", oCounter
.AddValue "PerfValue", Counters.Item(oCounter)
End With
oAPI.AddItem oBag
Next
End If
End If
End If
Next
If not CBool(bHasItems) Then
Dim oEmptyBag
Set oEmptyBag = oAPI.CreateTypedPropertyBag(2)
With oEmptyBag
.AddValue "IsNotEmpty", bHasItems
.AddValue "PerfInstance", ""
.AddValue "PerfCounter", ""
.AddValue "PerfValue", ""
End With
oAPI.AddItem oEmptyBag
End If
oAPI.ReturnItems
End Sub
Function CalculatePercent(ByVal nDivident, ByVal nDivider)
Dim nResult
nResult = 0
If (nDivider <> 0) and (nDivident <> 0) Then
nResult = nDivident/nDivider*100
End If
CalculatePercent = nResult
End Function
Function GetPerfmonInstance(ByVal sName)
sName = Replace(sName,"(","[")
sName = Replace(sName,")","]")
sName = Replace(sName,"/","_")
sName = Replace(sName,"#","_")
GetPerfmonInstance = sName
End Function
Function IsNetConnectionIDSupported(WMISet)
Dim owObj, sNetConnectionID
For Each owObj In WMISet
sNetConnectionID = GetWMIProperty(owObj, "NetConnectionID", wbemCimtypeUseDefault, ErrAction_None)
If sNetConnectionID <> "" Then
IsNetConnectionIDSupported = True
Exit Function
End If
Next
IsNetConnectionIDSupported = False
End Function
'******************************************************************************
' FUNCTION: CheckByOSCurrentVersion
' DESCRIPTION: Returns True if the Registry Key for CurrentVersion
' is equal the target OS Versions Number.
' RETURNS: Boolean: True, if build is greater or equal than the given number
'******************************************************************************
Private Function CheckByOSCurrentVersion() 'As Boolean
Dim strCurrentOSVer
Select Case strCurrentOSVer
Case WIN_SRV_2012_OSVer
CheckByOSCurrentVersion = True
Case WIN_SRV_2012R2_OSVer
CheckByOSCurrentVersion = True
Case Else
CheckByOSCurrentVersion = False
End Select
Home
ENU 
Show References: