'==========================================================================
'File: TestDomainControllers.vbs
'Version: 1.0
'Author: Bennett Scharf cell:303-520-6021 http://www.bennett-scharf.com
'For: n/a
'Purpose: Used to automatically run DCDIAG.EXE against all domain controllers in a forest
' and send an e-mail alert when a problem is found. This would normally be run
' once a day using the Task Scheduler.
'Creation Date: 18 Feb 07
'Revision Date: n/a
'Related Files: * Cscript.exe -vbscript console command intrepreter part of standard OS install
' * DCDIAG.EXE standard windows utility.
' * VBSendMail.dll a COM component for for sending SMTP mail
'Registry Settings N/A
'
'Operating System: Tested on Windows XP, 2003
'Usage: cscript TestDomainControllers.vbs
'Exit codes: none implemented
'==========================================================================
Option Explicit
Dim strDCList(), strSuspectDCList
' Mofify the following constants to suit your environment
Const strSMTPHost = "127.0.0.1" 'The DNS Name or IP address of your SMTP server
Const strRecipients = "someName@someDomain.com; someOtherName@someDomain.com" 'semicolon delimited list
Const strFromAddress = "someName@someDomain.com" 'The "From:" address for e-mail alerts
EnumerateDCs
If DCDiagFailure Then
'WScript.Echo "A problem was detected by DCDiag.exe on the following domain controllers" _
' & vbCrLf & strSuspectDCList & vbCrLf & " Please investigate."
'SendMail
Else
'WScript.Echo "failure not detected"
End If
Sub EnumerateDCs
' Thanks to Richard L. Mueller, Hilltop Lab - http://www.rlmueller.net
' for the code for this subroutine
Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
Dim adoRecordset, objDC, objSite, i
' Determine configuration context from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
' Use ADO to search Active Directory for ObjectClass nTDSDSA.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
strQuery = "<LDAP://" & strConfig _
& ">;(ObjectClass=nTDSDSA);AdsPath;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
' The parent object of each object with ObjectClass=nTDSDSA is a Domain
' Controller. The parent of each Domain Controller is a "Servers"
' container, and the parent of this container is the "Site" container.
i = 0
Do Until adoRecordset.EOF
Set objDC = GetObject( _
GetObject(adoRecordset.Fields("AdsPath")).Parent)
Set objSite = GetObject(GetObject(objDC.Parent).Parent)
' Wscript.Echo "Domain Controller: " & objDC.cn & vbCrLf _
'& "DNS Host Name: " & objDC.DNSHostName & vbCrLf _
'& "Site: " & objSite.name
ReDim Preserve strDCList(i)
strDCList(i) = objDC.cn
i=i+1
adoRecordset.MoveNext
Loop
adoRecordset.Close
' Clean up.
adoConnection.Close
Set objRootDSE = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
Set adoRecordset = Nothing
Set objDC = Nothing
Set objSite = Nothing
'Wscript.Echo "Done Enumerating DCs"
End Sub
Function DCDiagFailure
'Runs DCDiag against list of DCs. If the string 'failed' is found then the name
'of the suspect DC and the failure string is cocatenated to the global variable strSuspectDCList.
'Also when a failure is found, the function returns True
Dim objShell, strDC, objExecObject, bolDcFailedTest, strrText
Set objShell = WScript.CreateObject("WScript.Shell")
bolDcFailedTest = False
For Each strDC In strDCList
'WshShell.Run "%COMSPEC% /c dcdiag /s:" & i & " >> " & strInputFileName,,True
Set objExecObject = objShell.Exec("%COMSPEC% /c dcdiag /s:" & strDC)
Do Until objExecObject.StdOut.AtEndOfStream
strText = objExecObject.Stdout.ReadLine()
If InStr(1, strText, "failed", vbTextCompare)Then
strSuspectDCList= strSuspectDCList & ", " & strDC & ": " & strText & vbCrLf
bolDcFailedTest = True
End If
Loop
Next
DCDiagFailure = bolDcFailedTest
End Function
Sub SendAlert
'Send alert via SMTP
Dim objSendMail
Set objSendMail = CreateObject("vbSendMail.clsSendMail")
objSendMail.SMTPHost = strSMTPHost
objSendMail.From = strFromAddress
objSendMail.FromDisplayName = "Alert! DCDiag Results"
objSendMail.Recipient = strRecipients
objSendMail.Message = "A problem was detected by DCDiag.exe on the following domain controllers" _
& vbCrLf & strSuspectDCList & vbCrLf & " Please investigate."
objSendMail.Send
Set objSendMail = Nothing
End Sub