Query Installed Apps a Different Way

For whatever reason, in some environments, a WMI query of Win32_Product is God-awful slow.  I've seen this on Windows 7 and Windows 7 SP1 clients, as well as on Windows Server 2008 and 2008 R2.  The symptom can be seen from WIM script, WBEM, and using WMIC from a command console with very similar results:  The query hangs for 20-25 seconds and then begins executing in spurts.  Other Win32 classes work fine, from what I've seen, it's just Win32_Product for some reason.  One workaround is to dump a registry output file, and scrub it to make a "clean" output file.  You can port this to PowerShell or KiXtart if you want (or whatever you prefer, I really don't care as long as you're happy and that makes me happy so we're all happy. yay!)

'****************************************************************
' Filename..: installedApps.vbs
' Author....: David M. Stein aka Scriptzilla aka dipshit
' Date......: 10/20/2011
' Purpose...: save query of installed applications to local file
'****************************************************************

Const strInputFile  = "c:\regoutput.txt"
Const strOutputFile = "c:\installedApps.txt"

Const ForReading = 1
Const ForWriting = 2
Const adVarChar = 200

cmd = "reg query hklm\software\microsoft\windows\currentversion\uninstall /s >" & strInputFile

On Error Resume Next

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

wscript.echo "info: executing shell command to create temp file..."

objShell.Run "cmd /c " & cmd, 7, True

wscript.echo "info: getting temp file for input..."

If objFSO.FileExists(strInputFile) Then
 wscript.echo "info: reading temp file..."
 Set objFile = objFSO.OpenTextFile(strInputFile, ForReading)
 Set objFile2 = objFSO.CreateTextFile(strOutputFile, True)

 Set rs = CreateObject("ADODB.RecordSet")

 rs.CursorLocation = adUseClient
 rs.Fields.Append "productname", adVarChar, 255
 rs.Open

 Do Until objFile.AtEndOfStream
     strLine = objFile.Readline
     If Left(strLine, 25) = "    DisplayName    REG_SZ" Then
      strOutput = Trim(Mid(strLine, 30))
   rs.AddNew
   rs.Fields("productname").value = strOutput
   rs.Update
     End If
 Loop
 
 rs.Sort = "productname"
 
 Do Until rs.EOF
     objFile2.WriteLine(rs.Fields("productname").value)
  rs.MoveNext
 Loop
 rs.CLose
 Set rs = Nothing
 
 objFile.Close
 objFile2.Close
 wscript.echo "info: finished scrubbing input to new output file"
Else
 wscript.echo "fail: temp file not found"
End If

Set objFSO = Nothing
Set objShell = Nothing
'----------------------------------------------------------------

wscript.echo "info: processing complete!"

Comparing Processes: Before/After Launching an Application

I needed to capture a delta between running processes on my Windows 7 computer before and after launching a particular application.  I could have used some freeware and shareware apps for this, but I wanted something stupid simple (as far as output), not something I had to sift through and tinker with settings, etc.  I hope you find it useful. Beware of word-wrapping when copying this mess.

'****************************************************************
' Filename..: taskdump.vbs
' Author....: David M. Stein
' Date......: 07/27/2010
' Purpose...: display user contexts of running processes on remote computer
' Notes.....: run as admin (re: remote computer)
'****************************************************************
Option Explicit

Const ForReading = 1
Const ForWriting = 2
Const offset = 78 ' start point on each row of dump file
Const offlen = 50 ' end point on each row of dump file

Dim objFile, strLine, uid, ulist
Dim objArgs, objFSO, objShell, mode
Dim strComputer, temp, outf, retval

'----------------------------------------------------------------
' comment: check if computer name was provided to script
'----------------------------------------------------------------

Set objArgs = WScript.Arguments
If objArgs.Count = 0 Then
	strComputer = Trim(InputBox("Computer Name", "Computer Name"))
	mode = 2
Else
	strComputer = Trim(objArgs(0))
	mode = 1
End If

If strComputer = "" Then
	ShowUsage()
	wscript.Quit(1)
End If

wscript.echo "info: computer is " & strComputer

'----------------------------------------------------------------
' comment: continue on
'----------------------------------------------------------------

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

'----------------------------------------------------------------
' example dump...
'----------------------------------------------------------------
' Image Name	     PID Session Name        Session#    Mem Usage User Name		              CPU Time
' ========================= ======== ================ =========== ============ ================================================== ============
' System Idle Process              0	            0         28 K N/A			     0:43:57
' System	           4	            0        240 K NT AUTHORITY\SYSTEM		     0:00:13
' smss.exe	       548	            0        388 K NT AUTHORITY\SYSTEM
'----------------------------------------------------------------

'----------------------------------------------------------------
' comment: define output (dump) file path and name
'----------------------------------------------------------------

temp = objShell.ExpandEnvironmentStrings("%temp%")
outf = temp & "\" & strComputer & ".tsk"
ulist = ""

'----------------------------------------------------------------
' comment: run tasklist to produce dump file
'----------------------------------------------------------------

retval = objShell.Run("cmd /c tasklist /s " & strComputer & " /v >" & outf, 7, True)
wscript.echo "info: exit code was " & retval

'----------------------------------------------------------------
' comment: if dump file found, open and parse it
'----------------------------------------------------------------

If objFSO.FileExists(outf) Then
	wscript.echo "info: reading dump file..."
	On Error Resume Next
	Set objFile = objFSO.OpenTextFile(outf, ForReading)
	If err.Number = 0 Then
		Do Until objFile.AtEndOfStream
			strLine = Trim(objFile.Readline)
			If strLine <> "" Then
				uid = Trim(Mid(strLine, offset, offlen))
				' ignore user "N/A"
				If uid <> "N/A" And Left(uid, 3) <> "===" And Left(uid, 4) <> "User" Then
					If ulist = "" Then
						ulist = Ucase(uid)
					Else
						' only collect unique names
						If InStr(ulist, Ucase(uid)) < 1 Then
							ulist = ulist & vbTab & uid
						End If
					End If
				End If
			End If
		Loop
		objFile.Close
		' display results
		If mode = 1 Then
			wscript.echo Replace(ulist, vbTab, vbCRLF)
		Else
			MsgBox Replace(ulist, vbTab, vbCRLF), 64, "User Processes on " & Ucase(strComputer)
		End If
	Else
		wscript.echo "fail: error (" & err.Number & ") = " & err.Description
	End If
Else
	wscript.echo "fail: dump file not found"
End If

Sub ShowUsage()
	wscript.echo
	wscript.echo "usage: taskdump.vbs computername"
	wscript.echo
End Sub

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?