Query AD Computers with Custom HOSTS File Entries

'****************************************************************
' Filename..: enum_ad_host_files.vbs
' Author....: David M. Stein
' Date......: 04/15/2012
' Purpose...: search for hosts files with custom entries
'****************************************************************
dns_netbios = "short_name_of_your_active_directory_domain"

Const ForReading = 1
Const ForWriting = 2

wscript.echo "info: scanning domain = " & dns_netbios

Set objDom = GetObject( "WinNT://" & dns_netbios )
Set objFSO = CreateObject("Scripting.FileSystemObject")

tcount = 0

For each obj in objDom
 If Lcase(obj.Class) = "computer" Then
  computerName = obj.Name
  wscript.echo "info: " & computerName
  tcount = tcount + 1
  CheckHosts computerName
 End If
Next

Sub CheckHosts(cn)
 Dim filename, objFile, strLine, found
 filename = "\\" & cn & "\admin$\system32\drivers\etc\hosts"
 wscript.echo "info: searching for: " & filename
 If objFSO.FileExists(filename) Then
  On Error Resume Next
  Set objFile = objFSO.OpenTextFile(filename, ForReading)
  If err.Number = 0 Then
   Do Until objFile.AtEndOfStream
    strLine = Trim(objFile.Readline)
    If Left(strLine,1) <> "#" And strLine <> "" Then
     found = True
    End If
   Loop
   objFile.Close
   
   If found = True Then 
    wscript.echo "info: custom entry found!"
   Else
    wscript.echo "info: no custom entries found."
   End If
  Else
   wscript.echo "fail: error (" & err.Number & ") = " & err.Description
  End If
   
 Else
  wscript.echo "fail: unable to locate hosts file on " & cn
 End If
End Sub

wscript.echo "info: " & tcount & " account objects found"

Automating Domain Controller Diagnostics, Version 2.0, Part 2 of 2

This is the follow-up script to part 1 (see "Automating Domain Controller Diagnostics, Version 2.0").  This script runs on the member server which has the "Logs$" share, using a scheduled task.  Make sure the scheduled task runs AFTER the individual scheduled tasks on each domain controller are all completed.  I strongly suggest you stagger the individual scheduled tasks a little to avoid impacting all domain controllers at the same time, so the task that runs this script should be run a few minutes or an hour AFTER the last of those is completed.

Configure the scheduled task to run this script as the local SYSTEM account.

As always: This script is provided as-is without any warranties, implied or explicit.  Use at YOUR OWN RISK.  Edit and test in a safe environment before using in a production environment.

'**************************************************************
' Filename: dc_diagnostics_report.vbs
' Author:   David Stein
' Date:     11/20/07
' Purpose:  Open and Parse report files to produce final report
'**************************************************************
Const collectionServer = "\\memberserver"
Const DebugMode  = True
Const SendAlerts = True
Const mailServer = "mailserver.mydomain.local"
Const alertList  = "Server Admins <it_server_admins@MYDOMAIN.LOCAL>"
Const alertFrom  = "IT REPORTS <donotreply @MYDOMAIN.LOCAL>"
Const ForReading = 1
Const ForWriting = 2
Const Verbosity  = False
Const threshold  = 1
Const scriptVer  = "11.20.07"

'--------------------------------------------------------------
' declare variables
'--------------------------------------------------------------

Dim fso, filename, filedate, totalcount, s
Dim dcdiag_status, dcdiag_list, collectionFolder
Dim netdiag_status, netdiag_list
Dim repadmin_status, repadmin_list
Dim errorsFound, dcdiag_errors, netdiag_errors, repadmin_errors
Dim dclist, ndlist, rplist, strServer
Dim listd, listn, listr, shortdate, currenttime

shortdate   = FormatDateTime(Now,vbShortDate)
currentTime = FormatDateTime(Now,vbLongTime)
collectionFolder = collectionServer & "\logs$"

'--------------------------------------------------------------
' initialize list and counter variables
'--------------------------------------------------------------

dclist = ""
ndlist = ""
rplist = ""

totalcount      = 0
errorsFound     = 0
dcdiag_errors   = 0
netdiag_errors  = 0
repadmin_errors = 0

dcdiag_list   = ""
netdiag_list  = ""
repadmin_list = ""

'--------------------------------------------------------------
' diagnostics printer
'--------------------------------------------------------------

Sub DebugPrint(s)
    If DebugMode Then
        wscript.echo s
    End If
End Sub

'--------------------------------------------------------------
' main process
'--------------------------------------------------------------

Sub Main()
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FolderExists(collectionFolder) Then
        dcdiag_status   = CountReportFiles("dcdiag")
        netdiag_status  = CountReportFiles("netdiag")
        repadmin_status = CountReportFiles("repadmin")

        totalcount = (dcdiag_status + netdiag_status + repadmin_status)

        debugprint "info: " & dcdiag_status & " dcdiag report files"

        For each s in Split(dcdiag_list,",")
            If Trim(s) <> "" Then
                debugprint "  " & Trim(s)
            End If
        Next

        debugprint "info: " & netdiag_status & " netdiag report files"

        For each s in Split(netdiag_list,",")
            If Trim(s) <> "" Then
                debugprint "  " & Trim(s)
            End If
        Next

        debugprint "info: " & repadmin_status & " repadmin report files"

        For each s in Split(repadmin_list,",")
            If Trim(s) <> "" Then
                debugprint "  " & Trim(s)
            End If
        Next

        debugprint "info: " & totalcount & " total report files"

        listd = IterateReportFiles("dcdiag")
        listn = IterateReportFiles("netdiag")
        listr = IterateReportFiles("repadmin")

        debugprint "-------------------------------------------" & _
            vbCRLF & "detail results..." & _
            vbCRLF & "-------------------------------------------"
        debugprint listd & _
            vbCRLF & "-------------------------------------------"
        debugprint listn & _
            vbCRLF & "-------------------------------------------"
        debugprint listr & _
            vbCRLF & "-------------------------------------------"
        If SendAlerts Then
            Dim msgBody, msgSub
            If errorsFound > 0 Then
                msgSub = "Domain Controller Status Alert"
            Else
                msgSub = "Domain Controller Status Report"
            End If
            msgBody = msgSub & _
                vbCRLF & "----------------------------------" & _
                vbCRLF & "Errors/Warnings: " & errorsFound & _
                vbCRLF & "Processed: " & shortdate & " at " & currentTime & _
                vbCRLF & "----------------------------------" & vbCRLF

            For each s in Split(dcdiag_list,",")
                If Trim(s) <> "" Then
                    msgBody = msgBody & Trim(s) & vbCRLF
                End If
            Next
            msgBody = msgBody & _
                vbCRLF & "----------------------------------" & _
                vbCRLF & "Details Follow..." & _
                vbCRLF & "----------------------------------"
            msgBody = msgBody & _
                vbCRLF & "DCDIAG Results: " & _
                vbCRLF & listd & _
                vbCRLF & vbCRLF & "NETDIAG Results: " & _
                vbCRLF & listn & _
                vbCRLF & vbCRLF & "REPADMIN Results: " & _
                vbCRLF & listr & _
                vbCRLF & "----------------------------------" & _
                vbCRLF & "Note: log report files are collected at" & _
                vbCRLF & "the following UNC location and may be" & _
                vbCRLF & "accessed there for diagnostics review..." & _
                vbCRLF & collectionFolder & _
                vbCRLF & "script: dc_diagnostics_report.vbs, version: " & scriptVer

            SendMail alertList, alertFrom, msgSub, msgBody, "TEXT"
        End If
    Else
        ' folder not found
    End If
    Set fso = Nothing
End Sub

'----------------------------------------------------------------
' description:
'----------------------------------------------------------------

Function ServerFileName(sFilename)
    Dim tmp, retval
    tmp = Split(sFilename, "_")
    On Error Resume Next
    retval = tmp(0)
    If err.Number <> 0 Then
        retval = Left(sFilename,9)
    End If
    ServerFileName = retval
End Function

'--------------------------------------------------------------
' count, separate and process log files
'--------------------------------------------------------------

Function CountReportFiles(reportClass)
    Dim fld, f, filename, filedate, counter, retval, age
    counter = 0
    retval = "Server" & vbTab & "Reported" & vbCRLF
    Set fld = fso.GetFolder(collectionFolder)
    For each f in fld.Files
        filename = f.Name
        filedate = f.DateLastModified
        If InStr(1, filename, reportClass) > 0 Then
            age = DateDiff("d", filedate, shortdate)
            If Abs(age) > threshold Then
                retval = retval & ServerFileName(filename) & vbTab & filedate & " **,"
            Else
                retval = retval & ServerFileName(filename) & vbTab & filedate & ","
            End If
            counter = counter + 1
        End If
    Next
    Set fld = Nothing
    Select Case reportClass
        Case "dcdiag":
            dcdiag_list = retval
        Case "netdiag":
            netdiag_list = retval
        Case "repadmin":
            repadmin_list = retval
    End Select
    CountReportFiles = counter
End Function

'--------------------------------------------------------------
' loop through log files
'--------------------------------------------------------------

Function IterateReportFiles(rType)
    Dim fld, f, filename, filepath, retval
    retval = ""
    Set fld = fso.GetFolder(collectionFolder)
    For each f in fld.Files
        filename = f.Name
        filepath = collectionFolder & "\" & filename
        If InStr(1, filename, rType) > 0 Then
            retval = retval & AnalyzeReportFile(filepath, rType, ServerFileName(filename))
        End If
    Next
    Set fld = Nothing
    IterateReportFiles = retval
End Function

'----------------------------------------------------------------
' description:
'----------------------------------------------------------------

Function CompareFileDates(d1, d2)
    Dim retval
    retval = DateDiff("d", d1, d2)
    CompareFileDates = retval
End Function

'--------------------------------------------------------------
' open, parse and return result from log file
'--------------------------------------------------------------

Function AnalyzeReportFile(filespec, reportClass, strServer)
    Dim theFile, retval, ln
    retval = ""
    Set theFile = fso.OpenTextFile(filespec, ForReading, False)

    Do While theFile.AtEndOfStream <> True
        ln = Trim(theFile.ReadLine)

        Select Case reportClass
            '----------------------------------------------
            ' DCDIAG analysis
            '----------------------------------------------

            Case "dcdiag":
                If InStr(1,ln,"Failed") > 0 Then
                    retval = retval & strServer & " ... ERROR: " & ln & _
                        vbCRLF & "....log: " & filespec & vbCRLF
                    dcdiag_errors = dcdiag_errors + 1
                    dclist = dclist & strServer & ","
                    errorsFound = errorsFound + 1
                ElseIf InStr(1,ln,"Warning") > 0 Then
                    retval = retval & strServer & " ... WARNING: " & ln & _
                        vbCRLF & "....log: " & filespec & vbCRLF
                    dcdiag_errors = dcdiag_errors + 1
                    dclist = dclist & strServer & ","
                    errorsFound = errorsFound + 1
                End If

            '----------------------------------------------
            ' NETDIAG analysis
            '----------------------------------------------

            Case "netdiag":
                Select Case Left(ln,36)
                    Case "REPLICATION-RECEIVED LATENCY WARNING":
                        retval = retval & strServer & " ... WARNING: " & ln & _
                            vbCRLF & "....log: " & filespec & vbCRLF
                        errorsFound = errorsFound + 1
                        netdiag_errors = netdiag_errors + 1
                        ndlist = ndlist & strServer & ","
                End Select

                Select Case Left(ln,25)
                    Case ".........................":
                        If InStr(1,ln,"fail") > 0 Then
                            netdiag_errors = netdiag_errors + 1
                            errorsFound = errorsFound + 1
                            ndlist = ndlist & strServer & ","
                            retval = retval & strServer & " ... ERROR: " & Mid(ln,27) & _
                                vbCRLF & "....log: " & filespec & vbCRLF
                        ElseIf InStr(1,ln,"FATAL") > 0 Then
                            netdiag_errors = netdiag_errors + 1
                            errorsFound = errorsFound + 1
                            ndlist = ndlist & strServer & ","
                            retval = retval & strServer & " ... FATAL: " & Mid(ln,27) & _
                                vbCRLF & "....log: " & filespec & vbCRLF
                        End If
                End Select

            '----------------------------------------------
            ' REPADMIN analysis
            '----------------------------------------------

            Case "repadmin":
                Select Case Left(ln,14)
                    Case "Last attempt @":
                        If InStr(1,ln,"fail") > 0 Then
                            errorsFound = errorsFound + 1
                            repadmin_errors = repadmin_errors + 1
                            rplist = rplist & strServer & ","
                            retval = retval & strServer & " ... ERROR: " & Mid(ln,16) & _
                                vbCRLF & "....log: " & filespec & vbCRLF
                        End If
                End Select
        End Select
    Loop
    If retval = "" Then
        retval = strServer & " ... OK" & vbCRLF
    End If
    theFile.Close
    Set theFile = Nothing
    AnalyzeReportFile = retval
End Function

'--------------------------------------------------------------
' send email
'--------------------------------------------------------------

Sub SendMail(sTo, sFrom, sSubject, sBody, sFormat)
    Dim objMessage
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = sSubject
    objMessage.Sender  = sFrom
    objMessage.To = sTo
    If sFormat = "TEXT" Then
        objMessage.TextBody = sBody
    Else
        objMessage.HTMLBody = sBody
    End If
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    debugprint "info: (sendmail) message sent to " & sTo
End Sub

Main()

Wscript.Quit

Automating Domain Controller Diagnostics, Version 2.0

I posted a portion of this some time ago, but this week I received the fourth inquiry about the full version, so I guess it’s time to post it.  Here goes…

Create a shared folder on each domain controller named "Data$" and assign permissions to only the "Domain Admins" security group.  Remove all others from the permissions set.

Install the Support Tools and latest versions of DCDIAG.exe, NETDIAG.exe, and REPADMIN.exe on each domain controller.  Make SURE they are the same versions on all of them.

Create a share named "Scripts$" on a central domain member server.  Assign permissions to allow "Domain Controllers" security group to have Read permissions.  Assign "Domain Admins" to have full control permissions.

Create a share named "Logs$" on a central domain member server (can be the same member server as the one above).  Assign permissions to allow "Domain Controllers" security group to have Change permissions (read/write/modify/delete).  Assign "Domain Admins" group full control.

Put the script below into the "Scripts$" share.

On each domain controller, create a scheduled task to run the script from the "Scripts$" UNC path at a chosen interval (daily, weekly, monthly, quarterly, whatever) using the local "SYSTEM" account.  The "SYSTEM" account operates in the context of the computer (the domain controller on which it is executed) and therefore becomes a member of the "Domain Controllers" group when it attempts to access remote resources (across the LAN/WAN).

When the scheduled task executes the script, it should dump the output files into the local "Data$ share.  Another script will be posted soon which crawls through the collected files to produce a summary report of how your domain controllers are doing (with respect to the diagnostics reports for each).

Option Explicit
'**************************************************************
' Filename: dc_diagnostics.vbs
' Author:   David Stein
' Date:     11/19/07
' Purpose:  Run and Report Diagnostics on Domain Controllers

'**************************************************************
' copyright: free for derivative use without any warranties
' provided, explicit or implicit, provided that the above info
' with author name is included (provide attribution)

'**************************************************************
Const DebugMode = True
Const collectionFolder = "\\memberserver\logs$\"
Const alertList    = "EMAIL_ADDRESS@mydomain.local"
Const alertFrom    = "IT REPORTS <donotreply@MYDOMAIN.LOCAL>"
Const mailServer   = "mail.mydomain.local"
Const localShare   = "Data$"

Const bRunDCDIAG   = True
Const bRunNETDIAG  = True
Const bRunREPADMIN = True
Const DeleteTempFiles = False
Const SendAlerts   = True
Const SendOnErrorsOnly = True

Const bVerbose = False

'--------------------------------------------------------------
' declare variables
'--------------------------------------------------------------

Dim objShell, objFSO, strServerName, strServerData
Dim strMonthNum, strDayNum, strYear
Dim datestamp, dcDiagReport, netDiagReport, repAdminReport
Dim statlog, errorCount
errorCount = 0

'--------------------------------------------------------------
' diagnostics status display
'--------------------------------------------------------------

Sub DebugPrint(code, strval)
    If DebugMode Then
        wscript.echo Now & vbTab & code & vbTab & strval
    End If
End Sub

'--------------------------------------------------------------
' run DCDIAG report
'--------------------------------------------------------------

Sub RunDCDiag()
    Dim cmdstr
    cmdstr = "%comspec% /c dcdiag >" & dcDiagReport
    DebugPrint "info", "" & cmdstr
    objShell.Run cmdstr, 1, True
    DebugPrint "info", "dcdiag process completed."
End Sub

'--------------------------------------------------------------
' run NETDIAG report
'--------------------------------------------------------------

Sub RunNetDiag()
    Dim cmdstr
    cmdstr = "%comspec% /c netdiag >" & netDiagReport
    DebugPrint "info", "" & cmdstr
    objShell.Run cmdstr, 1, True
    DebugPrint "info", "netdiag process completed."
End Sub

'--------------------------------------------------------------
' run REPADMIN /SHOWREPS report
'--------------------------------------------------------------

Sub RunRepAdmin()
    Dim cmdstr
    cmdstr = "%comspec% /c repadmin /showreps >" & repAdminReport
    DebugPrint "info", "" & cmdstr
    objShell.Run cmdstr, 1, True
    DebugPrint "info", "repadmin process completed."
End Sub

'--------------------------------------------------------------
' upload report files to remote collection point
'--------------------------------------------------------------

Sub CollectReports()
    DebugPrint "info", "uploading reports to remote collection point..."
    
    If bRunDCDIAG Then
        If objFSO.FileExists(dcDiagReport) Then
            DebugPrint "info", "uploading dcdiag report to collection point..."
            'debugprint "*** " & dcDiagReport
            objFSO.CopyFile dcDiagReport, collectionFolder, True
            If DeleteTempFiles = True Then
                DebugPrint "info", "deleting local dcdiag report file..."
                objFSO.DeleteFile dcDiagReport
            End If
            DebugPrint "info", "dcdiag report uploaded successfully."
            DebugPrint "info", "collection-point: " & collectionFolder
            statlog = statlog & vbCRLF & "dcdiag report uploaded successfully."
        Else
            statlog = statlog & vbCRLF & "error: dcdiag report failure!"
            DebugPrint "error", "dcdiag report file not found."
            errorCount = errorCount + 1
        End If
    End If

    If bRunNETDIAG Then
        If objFSO.FileExists(netDiagReport) Then
            DebugPrint "info", "uploading netdiag report to collection point..."
            objFSO.CopyFile netDiagReport, collectionFolder, True
            If DeleteTempFiles = True Then
                DebugPrint "info", "deleting local netdiag report file..."
                objFSO.DeleteFile netDiagReport
            End If
            DebugPrint "info", "netdiag report uploaded successfully."
            DebugPrint "info", "collection-point: " & collectionFolder
            statlog = statlog & vbCRLF & "netdiag report uploaded successfully."
        Else
            statlog = statlog & vbCRLF & "error: netdiag report failure!"
            DebugPrint "error", "netdiag report file not found."
            errorCount = errorCount + 1
        End If
    End If

    If bRunREPADMIN Then
        If objFSO.FileExists(repAdminReport) Then
            DebugPrint "info", "uploading repadmin report to collection point..."
            objFSO.CopyFile repAdminReport, collectionFolder, True
            If DeleteTempFiles = True Then
                DebugPrint "info", "deleting local repadmin report file..."
                objFSO.DeleteFile repAdminReport
            End If
            DebugPrint "info", "repadmin report uploaded successfully."
            DebugPrint "info", "collection-point: " & collectionFolder
            statlog = statlog & vbCRLF & "repadmin report uploaded successfully."
        Else
            statlog = statlog & vbCRLF & "error: repadmin report failure!"
            DebugPrint "error", "repadmin report file not found."
            errorCount = errorCount + 1
        End If
    End If
End Sub

'--------------------------------------------------------------
' send email
'--------------------------------------------------------------

Sub SendMail(sTo, sFrom, sSubject, sBody, sFormat)
    Dim objMessage
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = sSubject
    objMessage.Sender = sFrom
    objMessage.To = sTo
    If sFormat = "TEXT" Then
        objMessage.TextBody = sBody
    Else
        objMessage.HTMLBody = sBody
    End If
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Set objMessage = Nothing
    DebugPrint "info", "(sendmail) message sent to " & sTo
End Sub

'--------------------------------------------------------------
' function: return padded string using parameters
'      arg: strval (string - value being padded)
'      arg: intLen (integer - string length to meet)
'      arg: sChar  (string - value to append or prefix to string)
'      arg: sSide  (string - side of string to pad, "L" or "R")
'--------------------------------------------------------------

Function PadString(strval, intLen, sChar, sSide)
    Dim retval
    retval = Trim(strval)
    Do While Len(retval) < intLen
        If Ucase(sSide) = "L" Then
            retval = sChar & retval
        Else
            retval = retval & sChar
        End If
    Loop
    PadString = retval
End Function

'--------------------------------------------------------------
' main subroutine
'--------------------------------------------------------------

Sub Main()
    Dim msgSub, msgBody
    Set objShell = Wscript.CreateObject("Wscript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    strServerName = objShell.ExpandEnvironmentStrings("%computername%")
    strServerData = "\\" & strServerName & "\" & localShare & "\"

    statlog = ""

    strMonthNum = DatePart("m", Now)
    If Len(strMonthNum) = 1 Then
        strMonthNum = "0" & strMonthNum
    End If

    strDayNum   = DatePart("d", Now)
    If Len(strDayNum) = 1 Then
        strDayNum = "0" & strDayNum
    End If

    strYear     = DatePart("yyyy", Now)
    datestamp   = strMonthNum & strDayNum & Right(strYear,2)

    DebugPrint "info", "datestamp = " & datestamp
    DebugPrint "info", "servername = " & strServerName

    If bRunDCDIAG Then
        dcDiagReport   = strServerData & strServerName & "_dcdiag.txt"
        RunDCDiag()
    End If

    If bRunNETDIAG Then
        netDiagReport  = strServerData & strServerName & "_netdiag.txt"
        RunNetDiag()
    End If

    If bRunREPADMIN Then
        repAdminReport = strServerData & strServerName & "_repadmin.txt"
        RunRepAdmin()
    End If

    CollectReports()

    If SendAlerts = True Then
        If SendOnErrorsOnly = True Then
            ' send alert only when errors occur...

            If errorCount > 0 Then
                msgSub = "DC Status Check: ERROR - " & strServerName
                msgBody = "DC Status Check: ERROR - " & strServerName & vbCRLF & _
                    "------------------------------" & vbCRLF & _
                    "One or more diagnostic reports could not" & vbCRLF & _
                    "be generated or collected from " & strServerName & vbCRLF & _
                    "------------------------------"
                SendMail alertList, alertFrom, msgSub, msgBody, "TEXT"
            End If
        Else
          ' send alert for any status, not just errors...

            msgsub = "DC Status Check: SUCCESS - " & strServerName
            If bVerbose Then
                msgbody = strServerName & " Diagnostics Process Report" & vbCRLF & _
                    "----------------------------" & vbCRLF & _
                    "Diagnostics reports have been processed on this " & _
                    "domain controller with the following results. " & _
                    "Reports have been uploaded to the central collection " & _
                    "point for further processing." & vbCRLF & _
                    "----------------------------" & vbCRLF & statlog
            Else
                msgbody = strServerName & " Diagnostics Process Report" & vbCRLF & _
                    "----------------------------" & vbCRLF & _
                    "Diagnostics reports were uploaded successfully."
            End If
            SendMail alertList, alertFrom, msgSub, msgBody, "TEXT"
        End If
    End If

    Set objFSO = Nothing
    Set objShell = Nothing
End Sub

'--------------------------------------------------------------

Call Main()

wscript.Quit

Automate DCDiag on your Domain Controllers

I’ve been doing this for (literally) years.  About 7 years to be exact.  You can do this with NETDIAG, REPADMIN and several other “diagnostic” utilities that work from the command line.

The idea is to wrap the diagnostic operation inside a script so that you can capture the output in a text file, then turn around and open the text file to parse it for what you want.  Then you can do almost anything with that information:

• Generate a summary report file
• Send the results into a database table
• Send the results as an e-mail report
• and on and on and on…

There are several ways to set this up as well.  For this example I’m using a VBScript file, a domain user (aka “service” or “proxy”) account, and the Windows Task Scheduler on a Windows Server 2008 domain controller.  This works just fine on Windows Server 2003 and Windows Server 2008 R2 as well.

The Script:

Const logFileName = "x:\logs\dcdiag.log"
Const ForReading = 1
Const ForWriting = 2

Dim objShell, objFSO, computer, domain, cmdstr
Dim objFile, testLabel, passed, failed

Set objShell = CreateObject("Wscript.Shell")
Set objFSO   = CreateObject("Scripting.FileSystemObject")

computer = Ucase(objShell.ExpandEnvironmentStrings("%computername%"))
domain   = Ucase(objShell.ExpandEnvironmentStrings("%userdnsdomain%"))

cmdstr = "cmd /c dcdiag /v >" & logFileName

objShell.Run cmdstr, 1, True

If objFSO.FileExists(logFileName) Then
    passed = 0
    failed = 0
	
    Set objFile = objFSO.OpenTextFile(logFileName, ForReading)

    Do Until objFile.AtEndOfStream
        strLine = objFile.Readline
    
        testLabel = Mid(strLine, 36)

        If InStr(1, testLabel, computer & " passed test") > 0 Then
            wscript.echo testLabel
            passed = passed + 1
        ElseIf InStr(1, testLabel, computer & " failed test") > 0 Then
            wscript.echo testLabel
            failed = failed + 1
        ElseIf InStr(1, testLabel, domain & " passed test") > 0 Then
            wscript.echo testLabel
            passed = passed + 1
        ElseIf InStr(1, testLabel, domain & " failed test") > 0 Then
            wscript.echo testLabel
            failed = failed + 1
        Else
            '
        End If
    Loop
    objFile.Close
    Set objFSO = Nothing

    wscript.echo "Passed " & passed & " tests"
    wscript.echo "Failed " & failed & " tests"	
Else
    wscript.echo "fail: log file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing

The Explanation:

The top section defines the path and filename for the output file we’re going to capture and analyze.  Next we define some variables.  Then we instantiate the Shell and FileSystemObject object interfaces. 

We use the Shell object to fetch the name of the computer and the domain name. We need those to help sift through the output file and find the matching lines we want to look at.  The Shell object is also used to run the DCDIAG command via the “Run” method.

After running the shell command, we then check if the output file exists.  If it does, we open it and read through it line-by-line looking for matching strings.  Within each matching string we look for “passed” or “failed” and count them up as well as echo them to the command prompt.

At the end we mop up and then display the tally for passed and failed tests.

Important Note: This is only ONE form of doing this.  There is no limit to what you CAN do.  For example, instead of echoing the testLabel contents, we could concatenate them into a report text block and send it via CDOsys (e-mail) or stuff it into a database via ADO or XML or generate an XML or HTML report, or even stuff it directly into a Microsoft Word or Excel document.  The possibilities are endless.

If anyone is interested in variations on this just post a comment and I’ll see what I can do.  I hope this helps someone out there?

VBScript Query All Domain Controllers for a User Account Status

Query all domain controllers for the status of a specified user account. This can come in handy when there are suspected replication problems in AD and some domain controllers are not up to date on a given account (locked, disabled, modified, etc.).

Const userid = "ServiceAccount20"
Const ou = "OU=ServiceAccounts,OU=IT,OU=Corp,DC=contoso,DC=com"

Const pageSize = 1000
Const ADS_SCOPE_SUBTREE = 2

Set dso = GetObject("LDAP:")

'----------------------------------------------------------------

Function Domain_LDAP()
    Dim retval, objRootDSE
    Set objRootDSE = GetObject("LDAP://RootDSE")
    retval = objRootDSE.Get("defaultNamingContext")
    Domain_LDAP = retval
End Function

'----------------------------------------------------------------
' function: 
'----------------------------------------------------------------

Function CName(strval)
    Dim tmp
    tmp = Replace(strval, "CN=NTDS Settings,CN=", "")
    CName = Split(tmp, ",")(0)
End Function

'----------------------------------------------------------------
' function: 
'----------------------------------------------------------------

Function DomainControllers()
    Dim objConnection, objCommand, objRecordSet
    Dim dn, retval : retval = ""

    dcn = Domain_LDAP()

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.CommandText = _
        "SELECT distinguishedName FROM " & _
        "'LDAP://cn=Configuration," & dcn & "' " & _
        "WHERE objectClass='nTDSDSA'"

    objCommand.Properties("Page Size") = pageSize
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst

    wscript.echo "info: querying for list of domain controllers..."

    Do Until objRecordSet.EOF
        dn = objRecordSet.Fields("distinguishedName").Value
        If retval <> "" Then
            retval = retval & vbTab & dn
        Else
            retval = dn
        End If
        objRecordSet.MoveNext
    Loop
    DomainControllers = retval
End Function

'----------------------------------------------------------------

wscript.echo "info: user account = " & userid
dclist = DomainControllers()

wscript.echo "info: querying user account status from each domain controller..."

For each strDC in Split(dclist, vbTab)
    cn = CName(strDC)
    dcn = Replace(strDC, "CN=NTDS Settings,", "")
 
    Set objUser = GetObject("LDAP://" & cn & "/CN=" & userid & "," & ou)
    On Error Resume Next
 
    ' refer to http://support.microsoft.com/kb/305144
 
    uac = objUser.Get("userAccountControl")
    If err.Number <> 0 Then
        wscript.echo err.Number & " - " & err.Description
    Else
        ' add more cases below if you prefer, or logand the results
        Select Case uac
            Case 512: wscript.echo "info: " & cn & " = normal"
            Case 16: wscript.echo "info: " & cn & " = locked"
            Case 2: wscript.echo "info: " & cn & " = disabled"
            Case 65536: wscript.echo "info: " & cn & " = never-expires"
            Case Else: wscript.echo "info: " & cn & " = unknown: " & uac
        End Select
    End If
Next

VBScript / ASP Secure LDAP Query of User Group Membership

Check if a user is a member of a specified domain security group using a secure LDAP query with ADsDSoObject provider. Works for ASP and VBScript using a specified domain service/proxy user account (when anonymous LDAP is disabled).

Example:
If IsMemberOf("SalesManagers", "JohnDoe") Then
    Response.Write "is a member"
End If

Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"
Const ADS_SCOPE_SUBTREE = 2

Function IsMemberOf(groupName, uid)
    Dim objConnection, objCommand, objRecordSet
    Dim retval : retval = False
    Dim i, gplen : gplen = Len(groupName)+3
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand =   CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT memberof FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            For each m in objRecordSet.Fields("memberof").value
                If Left(Ucase(m),gplen) = Ucase("CN=" & groupname) Then
                    retval = True
                End If
            Next
        Next
        objRecordSet.MoveNext
    Loop
    objRecordSet.Close
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    IsMemberOf = retval
End Function

VBScript Enumerate AD OUs and Containers

Dim objDSE, strDefaultDN, strDN, objContainer, objChild
Const enumContainersAlso = False

Set objRootDSE = GetObject("LDAP://rootDSE")
strDefaultDN = Domain_LDAP()
Set objContainer = GetObject("LDAP://" & strDefaultDN)

Call ListObjects(objContainer, "")

Function Domain_LDAP()
    Dim retval
    retval = objRootDSE.Get("defaultNamingContext")
    Domain_LDAP = retval
End Function

Function Domain_NetBIOS(ldapdn)
 Domain_NetBIOS = Replace(Replace(ldapdn,"DC=",""),",",".")
End Function

Sub ListObjects(objADObject, strSpace)
    Dim objChild
    For Each objChild in objADObject
        Select Case objChild.Class
            Case "organizationalUnit":
                objName = Mid(objChild.Name,4)
                objContainer = objChild.distinguishedName
                wscript.echo strSpace & "(o) " & objName
                Call ListObjects(objChild, "....")
            Case "container":
                If enumContainersAlso Then
                    objName = Mid(objChild.Name,4)
                    objContainer = objChild.distinguishedName
                    wscript.echo strSpace & "(c) " & objName
                End If
                Call ListObjects(objChild, "....")
        End Select
    Next
End Sub

VBScript Get Active Directory Environment Data

Set objRootDSE = GetObject("LDAP://rootDSE")
 
wscript.Echo "defaultNamingContext = " & objRootDSE.Get("defaultNamingContext")
wscript.Echo "rootdomainNamingContext = " & objRootDSE.Get("rootDomainNamingContext")
wscript.Echo "configurationNamingContext = " & objRootDSE.Get("configurationNamingContext")
wscript.Echo "dnsHostName = " & objRootDSE.Get("dnsHostName")
wscript.echo "CN: " & GetCN(objRootDSE.Get("defaultNamingContext"))

Function GetCN(dn)
    Dim retval
    retval = Split(dn, ",")
    GetCN = Mid(retval(0),4)
End Function

LDAP Query for User Accounts Created Since a Specific Date

Just modify the date string to use the YYYYMMDDHHMMSS.0Z format. So, for June 1, 2009, you would specify "20090601000000.0Z"

(&(objectCategory=user)(whenCreated>=20090601000000.0Z))

LDAP Query for Printers = HP DesignJet Plotters

(&(&
(uncName=*)
(objectCategory=printQueue)
(objectCategory=printQueue)
(driverName=*DesignJet*)
))

LDAP Query for Windows Server 2003 SP1 Computers in AD

(&(&(&(&(&(&(&(&(&(&
(objectCategory=Computer)
(operatingSystem=Windows Server 2003*)
(operatingSystemServicePack=Service Pack 1)
))))))))))