Dim oSysInfo, oParams, sDomain, sError, sOutput
Dim iBindType, dtStart, oRoot, iTime
Set oParams = WScript.Arguments
if oParams.Count <> 1 then
wscript.echo "The number of command line arguments is incorrect: " & vbCrLf & _
"Expected: 1" & vbCrLf & _
"Actual: " & oParams.Count
Exit Sub
End if
iBindType = CInt(oParams(0))
set oSysInfo = CreateObject("ADSystemInfo")
sDomain = oSysInfo.DomainDNSName
On Error Resume Next
' Bind using non-SSL
If iBindType = 3 or iBindType = 1 Then
dtStart = Now
set oRoot = GetObject("LDAP://" & sDomain & "/rootDSE")
If (Err.Number <> 0) Then
wscript.echo "Unable to bind to Root DSE." & GetErrorString(Err)
Exit Sub
Else
iTime = DateDiff("s", dtStart, Now)
sOutput = "LDAP Bind Time: " & iTime & " second(s)" & vbCrLf
End If
End If
' Bind using SSL
If iBindType = 3 or iBindType = 2 Then
dtStart = Now
set oRoot = GetObject("LDAP://" & sDomain & ":636/rootDSE")
If (Err.Number <> 0) Then
sOutput = sOutput & "Unable to bind to Root DSE over SSL. The error was: " & GetErrorString(Err)
Else
iTime = DateDiff("s", dtStart, Now)
sOutput = sOutput & "LDAP Bind Time: " & iTime & " second(s)" & vbCrLf
End If
End If
wscript.echo sOutput
End Sub
'******************************************************************************
' Name: GetErrorString
'
' 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.)
'
Function GetErrorString(oErr)
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 & vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function