''******************************************************************************
' Name: CreateAlert
'
' Purpose: Creates, but does not submit, an alert
'
' Parameters:
' iSeverity - The severity of the alert.
' sName - The name of the alert.
' sDescription - The alert description.
' sRole - The server role
' sInstance - The server role instance for which to issue a state alert.
' sComponent - The component affected
' iProblemState - The problem state
'
Function CreateAlert(ByVal iSeverity, ByVal sName, ByVal sDescription, ByVal sRole, ByVal sInstance, ByVal sComponent, ByVal iProblemState)
Dim oAlert
Set oAlert = ScriptContext.CreateAlert()
oAlert.Name = sName
oAlert.Description = sDescription
oAlert.AlertSource = "DHCP Server - Service Discovery"
oAlert.AlertLevel = iSeverity
'If there is a role, instance and component specified then this is a state alert
If sRole <> "" And sInstance <> "" And sComponent <> "" Then
oAlert.ProblemState = iProblemState
oAlert.ServerRole = sRole
oAlert.ServerRoleInstance = sInstance
oAlert.Component = sComponent
oAlert.ComponentInstance = ""
End If
Set CreateAlert = oAlert
End Function
''******************************************************************************
' Name: Submit Alert
'
' Purpose: Raises an alert
'
' Parameters:
' iSeverity - The severity of the alert.
' sName - The name of the alert.
' sDescription - The alert description.
' sRole - The server role
' sInstance - The server role instance for which to issue a state alert.
' sComponent - The component affected
' iProblemState - The problem state
'
Sub SubmitAlert(ByVal iSeverity, ByVal sName, ByVal sDescription, ByVal sRole, ByVal sInstance, ByVal sComponent, ByVal iProblemState)
ScriptContext.Submit CreateAlert(iSeverity, sName, sDescription, sRole, sInstance, sComponent, iProblemState)
End Sub
Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
Dim sErrDescription, sErrNumber
sErrDescription = oErr.Description
sErrNumber = oErr.Number
On Error Resume Next
Dim oScriptErrorEvent
Set oScriptErrorEvent = ScriptContext.CreateEvent()
With oScriptErrorEvent
.EventNumber = 40000
.EventType = EVENT_TYPE_ERROR
.Message = sMessage
.SetEventParameter """Microsoft Windows DHCP Server"""
.SetEventParameter sMessage
.SetEventParameter sErrDescription
.SetEventParameter sErrNumber
End With
ScriptContext.Submit oScriptErrorEvent
ScriptContext.Echo "ThrowScriptError('" & sMessage & "')"
End Function
Function ThrowScriptError(Byval sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
ScriptContext.Quit()
End Function
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
Function MomGetObject(ByVal sMoniker)
Set MomGetObject = Nothing
Dim oError
Set oError = New Error
On Error Resume Next
Set MomGetObject = GetObject(sMoniker)
oError.Save
On Error Goto 0
If oError.Number <> 0 Then ThrowScriptErrorNoAbort "Unable to get the object '" & sMoniker & "'", oError
End Function
'Define global vars
Dim g_oUtil
'=============
' Method: Main
' Description: The Sub called by MOM Runtime (with ScriptContext object)
'=============
Sub Main()
'log information
Set g_oUtil = new Util
Call g_oUtil.SetDebugLevel(g_oUtil.DBG_ERROR)
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "DHCP Service Discovery starting: at machine local time: " + CStr(Time))
DoDHCPDiscovery
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Done with Service Discovery Script at local time: " + CStr(time))
End Sub
'=============
' Method: DoDHCPDiscovery
' Description: Perform DHCP service discovery.
'=============
Sub DoDHCPDiscovery()
Dim objDiscData
Dim oDHCPCollection
Dim oDHCPInstance
Dim strIsAuthorized
Dim bIsAuthorized
Set oDHCPCollection = objDiscData.CreateCollection
With oDHCPCollection
.ClassID = DHCP_CLASS_ID
.AddScopeFilter COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID, ScriptContext.TargetComputerIdentity
.AddScopeProperty DHCP_IS_AUTHORIZED_ATTRIBUTE_ID
If strIsAuthorized = "" Then .AddScopeComponent DHCP_AUTHORIZED_COMPONENT_ID
End With
Set oDHCPInstance = oDHCPCollection.CreateInstance
With oDHCPInstance
.AddKeyProperty DHCP_SERVER_NAME_ATTRIBUTE_ID, ScriptContext.TargetNetbiosComputer
.AddProperty DHCP_IS_AUTHORIZED_ATTRIBUTE_ID, strIsAuthorized
End With
'submit the discovery data packet
Call g_oUtil.LogMessage(g_oUtil.DBG_TRACE, "Submitting Discovery data packet.")
ScriptContext.Submit objDiscData
' Commenting out as we no longer use the script to check out auth status. Instead we use ntevents and a event rule to set state.
'SetAuthorizationState bIsAuthorized
End Sub
Sub SetAuthorizationState(ByVal bIsAuthorized)
If IsNull(bIsAuthorized) Then Exit Sub
Dim iAlertLevel
Dim sAlertDescription
Dim iProblemState
Select Case bIsAuthorized
Case True
iAlertLevel = ALERT_SUCCESS
sAlertDescription = "DHCP is authorized"
iProblemState = PROBLEMSTATE_GREEN
Case False
iAlertLevel = ALERT_CRITICAL_ERROR
sAlertDescription = "DHCP is not authorized"
iProblemState = PROBLEMSTATE_RED
End Select
SubmitAlert iAlertLevel, _
"DHCP Authorization", _
sAlertDescription, _
DHCP_CLASS_ID, _
ScriptContext.TargetNetbiosComputer, _
DHCP_AUTHORIZED_COMPONENT_ID, _
iProblemState
End Sub
'Returns true if authorized, false if not, and null on error
Function IsAuthorized()
IsAuthorized = Null
Dim oRootDSE
On Error Resume Next
Set oRootDSE = GetObject("LDAP://rootdse")
On Error Goto 0
If Not IsValidObject(oRootDSE) Then Exit Function
Dim sConfigNC
sConfigNC = oRootDSE.Get("configurationNamingContext")
Dim oNetServicesContainer
Set oNetServicesContainer = MomGetObject("LDAP://CN=NetServices,CN=Services," & sConfigNC)
If Not IsValidObject(oNetServicesContainer) Then Exit Function
Dim aDHCPServers
Dim sDHCPServer
oNetServicesContainer.Filter = Array("dHCPClass")
Dim oAuthorizedServer
For Each oAuthorizedServer In oNetServicesContainer
aDHCPServers = Empty
On Error Resume Next
aDHCPServers = oAuthorizedServer.GetEx("dhcpServers")
On Error Goto 0
If Not IsEmpty(aDHCPServers) Then
For Each sDHCPServer In aDHCPServers
If DHCPServerDNSNameMatch(sDHCPServer, ScriptContext.TargetComputer) Then
IsAuthorized = True
Exit Function
End If
Next
End If
Next
IsAuthorized = False
End Function
Function DHCPServerDNSNameMatch(ByVal sDHCPServer, ByVal sDNSName)
DHCPServerDNSNameMatch = (InStr(1, sDHCPServer, "$s" & sDNSName & "$", vbTextCompare) <> 0)
End Function
'==========================================================================
' Class: Util
' Description: Utility methods for logging, creating MOM alert
'==========================================================================
Class Util
' Used to say to LogMessage when/how to print the message.
Public DBG_NONE
Public DBG_ERROR
Public DBG_WARNING
Public DBG_TRACE
'=============
' Method: Class_Initialize
' Description: This is the constructor
' Parameters:
'=============
Private Sub Class_Initialize()
' Initialize Debug level constants
DBG_TRACE = 1
DBG_WARNING = 2
DBG_ERROR = 3
DBG_NONE = 4
'by default only errors are logged
m_nDebugLevel = DBG_ERROR
End Sub
'=============
' Method: Class_Terminate
' Description: This is the destructor
' Parameters:
'=============
Private Sub Class_Terminate()
End Sub
'=============
' Method: SetDebugLevel
' Description: To change the debugging output level of information
' generated by this utility.
' Parameters:
' nLevel - Level, either DBG_NONE, DBG_TRACE,
' DBG_WARNING or DBG_ERROR
'=============
Public Sub SetDebugLevel(ByVal nLevel)
m_nDebugLevel = nLevel
End Sub
'=============
' Method: LogMessage
' Description: Log a debug message to ScriptContext
' Parameters:
' nLevel - Debug level for the message that we're logging.
' strMessage - The message to write to the trace.
'=============
Public Sub LogMessage( _
ByVal nLevel, _
ByVal strMessage _
)
If (nLevel >= m_nDebugLevel) Then
if (nLevel = DBG_ERROR) Then
ScriptContext.Echo "[Error]: " + strMessage
ElseIf (nLevel = DBG_WARNING) Then
ScriptContext.Echo "[Warning]: " + strMessage
ElseIf (nLevel = DBG_TRACE) Then
ScriptContext.Echo "[Trace]:" + strMessage
End If
End If
End Sub
End Class</Script></Body>
<Language>VBScript</Language>
<Name>DHCP Server - Service Discovery</Name>
<Parameters/>
<ManagementPackId>[Microsoft.Windows.Server.DHCP,,1.0.0.1]</ManagementPackId>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="RunScriptAction"/>
</Composition>
</Composite>
</ModuleImplementation>
<InputType>SystemLibrary!System.BaseData</InputType>
</WriteActionModuleType>
Home
Show References: