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 Distributed File Systems"""
.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
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 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
''******************************************************************************
' 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 = "Microsoft Windows DFS Client Side Monitoring"
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
Sub Main()
Dim aRootNames
aRootNames = Split(CStr(ScriptContext.Parameters.Get("UNCPaths")), ":")
Dim oFSO
Set oFSO = MomCreateObject("Scripting.FileSystemObject")
Dim e
Set e = New Error
Dim sAlertDescription
Dim sTargetPath
Dim oFolder
Dim oFile
For Each sTargetPath In aRootNames
On Error Resume Next
Set oFolder = oFSO.GetFolder(sTargetPath)
e.Save
On Error Goto 0
If e.Number = 0 Then
On Error Resume Next
For Each oFile In oFolder.Files
Exit For
Next
e.Save
On Error Goto 0
End If
If e.Number = 0 Then
ScriptContext.Echo "Passed"
Else
SubmitAlert ALERT_CRITICAL_ERROR, _
"A DFS destination is unreachable [" & sTargetPath & "]", _
"The DFS client side monitoring routine detected that the following destination is unreachable:" & vbCrLf & vbCrLf & _
sTargetPath & vbCrLf & vbCrLf & _
"The error code is: " & e.Description, _
"", "", "", ""
End If
Next
End Sub</Script></Body>
<Language>VBScript</Language>
<Name>Microsoft Windows DFS Client Side Monitoring</Name>
<Parameters>
<Parameter>
<Name>UNCPaths</Name>
<Value>$Config/Parameters/UNCPaths$</Value>
</Parameter>
</Parameters>
<ManagementPackId>[Microsoft.Windows.Server.DFS,,1.0.0.1]</ManagementPackId>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="RunScriptAction"/>
</Composition>
</Composite>
</ModuleImplementation>
<InputType>SystemLibrary!System.BaseData</InputType>
</WriteActionModuleType>