' NAME: DC LDAP Ping.vbs
'
' AUTHOR:  alan dot kaplan at VA dot GOV
' DATE  : 2/12/2013
'
' COMMENT: Checks LDAP responsiveness of Domain Controllers 
'
'==========================================================================
Option Explicit
Dim oSI:Set oSI = CreateObject("ADSystemInfo")
Dim strDomain: strDomain= oSI.DomainDNSName
Dim aDCs
Dim Root:'Get the default ADsPath for the domain to search. 
Set root = GetObject("LDAP://rootDSE")
dim wshShell:Set wshShell = WScript.CreateObject("WScript.Shell")
Dim iStartTime
Dim i, oBind, iEndTime, iElapsedTime 
Dim bAlarm:bAlarm = False
Dim iAlarmTime: iAlarmTime = 5
Dim message, retval
Dim oConn:Set oConn = CreateObject("ADODB.Connection")
Dim oCommand: Set oCommand =   CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOObject"
oConn.Open "Active Directory Provider"
Set oCommand.ActiveConnection = oConn
oCommand.Properties("Page Size") = 100

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote: quote=chr(34)
    Dim strCmdLine, Argument
    
    strCmdLine = WScript.Path & "\cscript.exe //NOLOGO " & quote & WScript.scriptFullName & Quote
    
    If Wscript.Arguments.Count > 0 Then
        For Each Argument in Wscript.Arguments
            strCmdLine = strCmdLine & space(1) & quote & Argument & quote
        Next 
    End If
    
    wshShell.Run strCmdLine,1,False
    WScript.Quit            	'...and stop running as WScript    
End If


message = "This monitors LDAP binding on Domain Controllers by simpling binding. " & _
" to the server with LDAP://DCNAME.  Select a domain to test:"
strDomain = InputBox(message,"Domain",strDomain)
If strDomain = "" Then WScript.Quit

message= "Do you want an alarm if bind time exceeds a threshold?"
retval = MsgBox(message,vbYesNoCancel + vbQuestion,"Alarm")
If retval = vbCancel Then WScript.Quit

If retval = vbYes Then 
	bAlarm = True
	iAlarmTime = InputBox("Alarm threshold in seconds","Seconds",iAlarmTime)	
	If iAlarmTime = "" Then WScript.Quit
End If 
iAlarmTime = CDbl(iAlarmTime)

Dim bLoop:bLoop = False
Dim iWaitSecs:iWaitSecs = 30
retval = Msgbox("Continuous test?",vbYesNoCancel + vbQuestion,"Monitor Mode")
If retval = vbCancel then WScript.Quit
If retval = vbYes Then 
	bLoop = True
	iWaitSecs = InputBox("Wait time between loops in seconds","Seconds",iWaitSecs)	
	If iWaitSecs = "" Then WScript.Quit
End If 

GetDCList

aDCs = Sort(aDCs)

Do
	Main 
Loop Until bLoop = False


Sub Main 
	For i =0 To UBound (aDCs)
		iStartTime = Timer
		On Error Resume Next
		Err.clear
		Set oBind = GetObject("LDAP://" & aDcs(i))
		
		If Err = 0 Then 
			iEndTime = Timer 
			iElapsedTime =  iEndTime - iStartTime
			If bAlarm And iElapsedTime >=iAlarmTime Then 
				Beep 3
			End If 
			WScript.Echo aDcs(i) & vbTab &  Round (iElapsedTime,3) & " seconds" 
		Else
			WScript.Echo aDcs(i) & vbTab & "LDAP Bind Failed! " & Err.description
			If bAlarm Then Beep(3)
		End If 
	Next
	if bLoop Then 
		WScript.Echo "	Sleeping for " & iWaitSecs  & " seconds .... " & VbCrLf & VbCrLf 
		'Sleep is .001
		Wscript.Sleep iWaitSecs  * 1000
	End If 
End Sub  

Sub GetDCList ()
	Dim strQuery
	strDomain = UCase(strDomain)
	'This is the slow and long way, but it will get Domain Controllers even if they have been moved
	'out of the default container.
	
	Err.Clear
	On Error Resume Next
	Dim RS, objDC
	
	' Construct the LDAP query that will find all the domain controllers in the domain
	strQuery = "<LDAP://" & Root.Get("ConfigurationNamingContext") & _
		">;((objectClass=nTDSDSA));ADsPath;subtree"
		
	oCommand.CommandText = strQuery
	oCommand.Properties("Page Size") = 100
	Wscript.Echo "Getting list of Domain Controllers for " & strDomain & " ... "
	Set rs = oCommand.Execute
	If isEmpty(RS) or Err.number <> 0 Then 
		MsgBox  "Failed to get list of DCs",vbCritical + vbOKOnly,"AD Query Failed"
		WScript.Quit(100)
	End If 
	
	Dim strDCList
	Do While Not rs.eof 
		' Bind to the domain controller computer object
		' (This is the parent object of the result from the query)
		Set objDC = getobject(getobject(rs(0)).Parent)
				
		If instr(Ucase(objDC.dNSHostName),strDomain) Then 
			strDCList = strDCList & ucase(objDC.dnsHostName) & ","
	    End If
	     
	    rs.MoveNext
	Loop
	strDCList = Mid(strDCList,1, Len(strDCList) -1)
	aDCs = Split(strDCList,",")
	Wscript.Echo VbCrLf
End Sub 

Function Sort(arrSort)
	dim j, temp
	For i = UBound(arrSort) - 1 To 0 Step -1
	    For j= 0 to i
	        if arrSort(j)>arrSort(j+1) Then
	            temp=arrSort(j+1)
	            arrSort(j+1)=arrSort(j)
	            arrSort(j)=temp
	        End if
	    Next
	Next 
	Sort = arrSort
End Function


sub Beep(iTimes)
	dim ibeeps
	for ibeeps = 1 to iTimes
		'WScript.Echo "Beep!"
		wshShell.Run "cmd /C " & chr(34) & "@echo " & chr(7) & chr(34),0,True
		WScript.Sleep 500
	Next
End Sub 



Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function