Class Error
Public Description
Public Number
Public Source
Sub Init(oErr)
Description = oErr.Description
Number = oErr.Number
Source = oErr.Source
End Sub
Sub Raise(strDescription)
Err.number = Number
Err.Description = Description
Err.Raise Number, Source, strDescription & GetErrorString(Err)
End Sub
End Class
Dim oError
Set oError = new Error
On Error Resume Next
Dim oAPI, oBag
Set oAPI = CreateObject("Mom.ScriptAPI")
Err.Clear
Dim IsTargetAgentless, oParams, bLogSuccess
Set oParams = WScript.Arguments
if oParams.Count < 1 Then
Wscript.quit -1
End if
bLogSuccess = CBool(oParams(0))'LogSuccessEvent
IsTargetAgentless= false
If Not(IsTargetAgentless) Then
Dim dtStart
dtStart = Now
DoDNSValidation
oAPI.ReturnItems
If Err <> 0 Then
CreateEvent EVENT_ID_SCRIPT_ERROR, _
EVENT_TYPE_WARNING, _
"An error occurred while executing '" & SCRIPT_NAME & "'" & _
vbCrLf & Err.Description & vbCrLf & "0x" & Hex(Err.number)
ElseIf bLogSuccess = True Then
strMessage = "The script '" & SCRIPT_NAME & "' completed in " & DateDiff("s", dtStart, Now) & " seconds."
CreateEvent EVENT_ID_SUCCESS, EVENT_TYPE_INFORMATION, strMessage
End If
Else
CreateEvent EVENT_ID_AGENTLESS, EVENT_TYPE_ERROR, "The AD Management Pack does not support the agentless management mode." & vbCrLf & _
"The script '" & SCRIPT_NAME & "' will not execute." & vbCrLf & _
"To prevent this alert being generated again, either change the monitoring " & _
"mode of this computer to agent-managed " & _
"or disable the rule that generated this alert."
End If
Sub DoDNSValidation()
On Error Resume Next
' Create an instance of OOMADs
Dim oOOMADS, bIsOK
bIsOK=True
Set oOOMADs = CreateObject("McActiveDir.ActiveDirectory")
If (0 <> Err.Number) Or (Not(IsObject(oOOMADs))) Then
Dim errorString
errorString = "The script '" & SCRIPT_NAME & "' failed to create object " & _
"'McActiveDir.ActiveDirectory'. This is an unexpected error." & vbCrLf & vbCrLf & _
GetErrorString(Err) & vbCrLf & vbCrLf & _
"The Active Directory Management Pack Objects (OOMADs) components are not installed on the Domain Controller. These components are required for the monitoring scripts to run successfully. See Alert Knowledge for additional details."
CreateEvent EVENT_ID_SCRIPT_ERROR, EVENT_TYPE_ERROR, errorString
End If
Dim strDomain
strDomain = oOOMADS.GetDomainForDC(".")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to get DNS Domain Name."
End If
If Right(strDomain, 1) = "." Then
strDomain = Left(strDomain, Len(strDomain) - 1)
End If
If Instr(strDomain, ".") = 0 Then
' Got a single-level name. Check to see if we're W2K-SP4 or above
' and if so, check for the registry key.
Dim oOS, oReg, strValue
Set oReg = CreateObject("WScript.Shell")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to CreateObject 'WScript.Shell'."
End If
For Each oOS in GetObject("winmgmts:").InstancesOf ("Win32_OperatingSystem")
If Err <> 0 Then
oError.Init(Err)
On Error Goto 0
oError.Raise "Failed to enumerate instances of 'Win32_OperatingSystem'."
End If
If CDbl(Left(oOS.Version, Len("5.1"))) = 5.1 Then
If oOS.ServicePackMajorVersion >= 4 Then
strValue = oReg.RegRead(REGKEY_W2K_UPDATETOPLEVELDOMAINZONES)
If Err.number = 0 Or Err.number = ERROR_FILENOTFOUND Then
If strValue <> "1" Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", "" & EVENT_ID_NODNSUPDATEFLAG
oAPI.AddItem oBag
bIsOK=false
CreateEvent EVENT_ID_NODNSUPDATEFLAG, EVENT_TYPE_ERROR, "DNS registrations of essential Domain controller records may be failing because the Active Directory Domain is a single label domain for Windows Server 2000 but the UpdateTopLevelDomainZones registry key has not been set to 1. For more information, see http://support.microsoft.com/kb/300684"
End If
Else
CreateEvent EVENT_ID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" & SCRIPT_NAME & "' " & vbCrLf & _
"failed to read the registry key '" & REGKEY_W2K3_UPDATETOPLEVELDOMAINZONES & _
"'. The error returned was " & GetErrorString(Err)
End If
End If
ElseIf CDbl(Left(oOS.Version, Len("5.2"))) >= 5.2 Then
strValue = oReg.RegRead(REGKEY_W2K3_UPDATETOPLEVELDOMAINZONES)
If Err.number = 0 Or Err.number = ERROR_FILENOTFOUND Then
If strValue <> "1" Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "BAD"
oBag.AddValue "EventID", "" & EVENT_ID_NODNSUPDATEFLAG
oAPI.AddItem oBag
bIsOK=false
CreateEvent EVENT_ID_NODNSUPDATEFLAG, EVENT_TYPE_ERROR, "DNS registrations of essential Domain controller records may be failing because the Active Directory Domain is a single label domain for Windows Server 2003 or newer but the UpdateTopLevelDomainZones registry key has not been set to 1. For more information, see http://support.microsoft.com/kb/300684"
End If
Else
CreateEvent EVENT_ID_SCRIPT_ERROR, EVENT_TYPE_WARNING, _
"The script '" & SCRIPT_NAME & "' " & vbCrLf & _
"failed to read the registry key '" & REGKEY_W2K3_UPDATETOPLEVELDOMAINZONES & _
"'. The error returned was " & GetErrorString(Err)
End If
End If
Exit For
Next
End If
If bIsOK = true Then
Set oBag = oAPI.CreateTypedPropertyBag(StateDataType)
oBag.AddValue "State", "GOOD"
oBag.AddValue "EventID", "" & EVENT_ID_DNSUPDATEFLAGOK
oAPI.AddItem oBag
End If
End Sub
'******************************************************************************
Sub CreateEvent(lngEventID, lngEventType, strMessage)
'
' Purpose: Creates a MOM event
'
' Parameters: lngEventID, the ID for the event
' lngEventType, the severity for the event. See constants at head of file
' strMessage, the message for the event
'
' Return: nothing
'
oAPI.LogScriptEvent "AD DNS Verification", lngEventID, lngEventType, strMessage
End Sub
'******************************************************************************
Function GetErrorString(oErr)
'
' Purpose: Attempts to find the description for an error if an error with
' no description is passed in.
'
' Parameters: oErr, the error object
'
' Return: String, the description for the error. (Includes the error code.)
'
Dim lErr, strErr
lErr = oErr
strErr = oErr.Description
On Error Resume Next
If 0 >= Len(strErr) Then
' If we don't have an error description, then check to see if the error
' is a 0x8007xxxx error. If it is, then look it up.
Const ErrorMask = &HFFFF0000
Const HiWord8007 = &H80070000
Const LoWordMask = 65535 ' This is equivalent to 0x0000FFFF
If (lErr And ErrorMask) = HiWord8007 Then
' Attempt to use 'net helpmsg' to get a description for the error.
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If Err = 0 Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " & (lErr And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErr = strMessage
End If
End If
End If
GetErrorString = vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
Home
RUS 
Show References: