Bennett Adelson Technical Blog

Bennett Adelson Technical Blog

Confirming Basic Domain Controller Connectivity Through VBScript


On a recent domain migration project, the customer requested that the automated migration process being created would included a check for access to a domain controller for the current domain and for the new domain. In this customer’s environment, the vast majority of clients were Windows XP Professional machines without PowerShell deployed. Thus, the customer wanted all of the scripting done in either VBScript or basic CMD batch processing.  To meet this particular request, I used VBScript. Although there’s not anything magical about the result, I found that locating some of the details was tricky. This post describes the final script and some tips about getting to the final result.

Script Header

The script starts with a basic header:

' CheckDCConnectivity.vbs
' Confirms current connectivity to domain controllers for the legacy
' domain and new domain using "ping".
' Michael C. Bazarewsky, Bennett Adelson
' Version 2.0

' Returns:
' .... 0 for connectivity to both found
' .... 40000 for unable to get to legacy
' .... 40001 for unable to get to the new domain
' .... n for Err.Number value n

This header is basic comments and intro information. Nothing fancy. The error code values are up out of the way of the system error range and below the COM/OLE error range; the numbers are somewhat arbitrary but this ensures I am not stepping on errors Microsoft code is returning. For some other scripts I use the standard error codes (e. g. System Error Codes) where it makes sense. Here I did not because I wanted different error codes for the two specific domains and the generic codes don’t let me do that.

Moving on, we set variable declaration to be required and catch errors on our own. Later there will be code that shows the error catches; this allows us to have more control over error paths. I’m following best practice with respect to the variable declaration requirement as it helps catch typos and the like:

Option Explicit 
On Error Resume Next

The next line is a subroutine call:

ForceTo32BitHost

The subroutine is as follows:

' Forces the script to run in the 32-bit host on a 64-bit machine
' cf. http://blogs.msdn.com/b/joshpoley/archive/2008/09/18/running-32bit-dependent-scripts-in-a-64bit-world.aspx
Sub ForceTo32BitHost
    Dim objShell, strCPU, strHost
    Dim strSysWOW64Host, strNewCommand, strArgument
    Dim objExec, intReturnCode
    
    Set objShell = CreateObject("WScript.Shell")
    strCPU = LCase(objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%"))
    strHost = LCase(WScript.FullName)
    
    If ((InStr(strHost, "system32") <> -1) And (strCPU = "amd64")) Then
        strSysWOW64Host = Replace(strHost, "system32", "syswow64") 
        strNewCommand = strSysWOW64Host + " //NoLogo """ & WScript.ScriptFullName + """"
        For Each strArgument in WScript.Arguments
            strNewCommand = strNewCommand + " """ + strArgument + """"
        Next
        WScript.Echo "Calling self with 32-bit host"
       
        ' Run the child script
        Set objExec = objShell.Exec(strNewCommand)       : CheckForError "Launching 32-bit script host with this script"
        
        Do While (objExec.Status = 0)
            If (Not objExec.StdOut.AtEndOfStream) Then
                WScript.Echo objExec.StdOut.ReadAll
            End If
            If (Not objExec.StdErr.AtEndOfStream) Then
                WScript.Echo objExec.StdErr.ReadAll
            End If
            WScript.Sleep 100
        Loop 
        
        ' Check the child results   
        intReturnCode = objExec.ExitCode
        If (intReturnCode <> 0) Then
            FailWithMessage intReturnCode, "Recursive call script failure " & intReturnCode & " from " & strNewCommand & vbCrLf
        End If
        WScript.Quit 0
    End If
End Sub

Now why am I doing this? The later code uses a 32-bit COM object, which on an x64 machine means we need to make sure we are in the 32-bit script host. If we aren’t, we can’t get to the COM object. You can try, but you will get an error 429, "ActiveX component can't create object" if you do. The blog post mentioned in the comment to the subroutine gives the initial reference source for the code, although that post uses JScript instead of VBScript and ignores StdErr. This subroutine shows some of the error handling calls as well, which I’m going to skip over explaining for now and come back to.

Next are the variable declarations:

Dim objSystemInfo, strCurrentDomain 
Dim objIADSTools 

Dim strCurrentDC, strNewDC, intReturnValue

Then, we ask for the current domain name of the system. I have seen more complicated versions of this code that use WMI to get to the Win32_ComputerSystem object (and in fact had that for a while in another script for the same project), but this is a lot shorter and works from Windows 2000 forward:

' What domain is the machine currently in?
Set objSystemInfo = CreateObject("ADSystemInfo")                                            : CheckForError "Creating object ADSystemInfo"
strCurrentDomain = objSystemInfo.DomainDNSName                                              : CheckForError "Looking up machine's current DNS domain name"
WScript.Echo "Current domain: " & strCurrentDomain

Again I’m going to skip the error handling for now. We need to get the domain controller name next; that’s where the 32-bit COM object comes in: IAdsTools.dll. This file initially was in the Windows Support Tools; the most recent version available that I could find is 1.1.0.2234 at the Microsoft download site (the Windows Support Tools for Windows Server 2003 Service Pack 2 – just download the CAB and pull the file out using Windows Explorer). The customer deployed the migration tool package using an MSI and their internal deployment tool so registering a COM component was not a big deal.

Anyway, once we have that available, we can then ask it to look up DCs through the standard OS mechanism:

' What DC will the OS use for the current domain?
Set objIADSTools = CreateObject("IADsTools.DCFunctions")                                    : CheckForError "Creating object IADsTools.DCFunctions"
objIADSTools.SetDsGetDcNameFlags = "DS_FORCE_REDISCOVERY,DS_IS_DNS_NAME,DS_RETURN_DNS_NAME" : CheckForError "Setting DS Get DC Name Flags"
intReturnValue = objIADSTools.DsGetDcName(CStr(strCurrentDomain), "", 1)                    : CheckForError "Looking up current domain controller for current domain"
If (intReturnValue <> 0) Then
    FailWithMessage intReturnValue, "Looking up current domain controller for current domain"
End If
strCurrentDC = objIADSTools.DCName                                                          : CheckForError "Getting the located DC name for current domain"
WScript.Echo "DC for current domain: " & strCurrentDC

This is where a couple of things come up that caused me substantial pain that I hope I can save you. Specifically, there were two pieces:

  1. The documentation for SetDsGetDcNameFlags is at best misleading. It took me looking into the COM object with the OleView tool form the Windows SDK to figure out that SetDsGetDcNameFlags is actually a property, not a method, on the DCFunctions interface. The Windows SDK can be installed from the Microsoft download site; I haven’t linked to it because it gets updated fairly often and I don’t want to have a stale link.
  2. The "everything is a Variant" nature of VBScript caused me pain with DsGetDcName, hence the explicit string conversion.

Now that the script has the DC name, it can attempt to ping it:

' Can we ping it? 
If Not Ping(strCurrentDC) Then 
    FailWithMessage 40000, "Cannot ping current DC"
End If 

What is the Ping subroutine? Glad you asked:

' This function returns True if the specified host could be pinged.
' strHostName can be a computer name or IP address.
' The Win32_PingStatus class used in this function requires Windows XP or later.
' This function is based on the TestPing function in a sample script by Don Jones
' http://www.scriptinganswers.com/vault/computer%20management/default.asp#activedirectoryquickworkstationinventorytxt
' credit: http://www.robvanderwoude.com/vbstech_network_ping.php
Function Ping(strHostName)

    ' Standard housekeeping
    Dim colPingResults, objPingResult, strQuery

    ' Define the WMI query
    strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & strHostName & "'"

    ' Run the WMI query
    Set colPingResults = GetObject("winmgmts:root\cimv2").ExecQuery(strQuery)

    ' Translate the query results to either True or False
    For Each objPingResult In colPingResults
        If Not IsObject(objPingResult) Then
            Ping = False
        Else
            If objPingResult.StatusCode = 0 Then
                Ping = True
            Else
                Ping = False
            End If
            WScript.Echo "Ping status code for " & strHostName & ": " & _
                objPingResult.StatusCode
        End If
    Next

    Set colPingResults = Nothing
End Function

A lot of code, but the short explanation is that the script is using the ICMP ping functionality added to WMI in Windows XP/Server 2003 to ping the remote host.

Moving on further, it’s the same work for the new domain instead of the legacy domain:

' What DC will the OS use for the new domain?
intReturnValue = objIADSTools.DsGetDcName("NewDomain.name")                                   : CheckForError "Looking up current domain controller for NewDomain.name"
If (intReturnValue <> 0) Then
    FailWithMessage intReturnValue, "Looking up current domain controller for NewDomain.name"
End If
strNewDC = objIADSTools.DCName                                                              : CheckForError "Getting the located DC name for NewDomain.name"
WScript.Echo "DC for NewDomain.name: " & strNewDC

' Can we ping it?
If Not Ping(strNewDC) Then
    FailWithMessage 40001, "Cannot ping NewDomain.name DC"
End If

WScript.Echo "Connectivity appears valid, returning with exit code 0"
WScript.Quit 0

Yes, this code is slightly redundant – I should probably have a lookup/ping subroutine instead of clipboard inheritence. And, the new domain name should be in a constant rather than repeated in several places to make it easier to change. Feel free to do a better job!

So that’s the main part of the script. All that’s left is the error handling. This is not the prettiest code but it meets the need here:

' Check to see if we have an outstanding error condition
Sub CheckForError(strLocation)
    If Err.Number <> 0 Then
        WScript.Echo "UNEXPECTED ERROR INTERCEPTED: " & strLocation
        FailWithMessage Err.Number, "Description: " & Err.Description
    End If
End Sub

' Fail with the given exit code and message
Sub FailWithMessage(intExitCode, strMessage)
    WScript.Echo intExitCode & ": " & strMessage
    WScript.Quit intExitCode
End Sub

The complete script is below:

' CheckDCConnectivity.vbs
' Confirms current connectivity to domain controllers for the legacy
' domain and new domain using "ping".
' Michael C. Bazarewsky, Bennett Adelson
' Version 2.0

' Returns:
' .... 0 for connectivity to both found
' .... 40000 for unable to get to legacy
' .... 40001 for unable to get to the new domain
' .... n for Err.Number value n

Option Explicit
On Error Resume Next

ForceTo32BitHost

Dim objSystemInfo, strCurrentDomain
Dim objIADSTools
Dim strCurrentDC, strNewDC, intReturnValue

' What domain is the machine currently in?
Set objSystemInfo = CreateObject("ADSystemInfo")                                            : CheckForError "Creating object ADSystemInfo"
strCurrentDomain = objSystemInfo.DomainDNSName                                              : CheckForError "Looking up machine's current DNS domain name"
WScript.Echo "Current domain: " & strCurrentDomain

' What DC will the OS use for the current domain?
Set objIADSTools = CreateObject("IADsTools.DCFunctions")                                    : CheckForError "Creating object IADsTools.DCFunctions"
objIADSTools.SetDsGetDcNameFlags = "DS_FORCE_REDISCOVERY,DS_IS_DNS_NAME,DS_RETURN_DNS_NAME" : CheckForError "Setting DS Get DC Name Flags"
intReturnValue = objIADSTools.DsGetDcName(CStr(strCurrentDomain), "", 1)                    : CheckForError "Looking up current domain controller for current domain"
If (intReturnValue <> 0) Then
    FailWithMessage intReturnValue, "Looking up current domain controller for current domain"
End If
strCurrentDC = objIADSTools.DCName                                                          : CheckForError "Getting the located DC name for current domain"
WScript.Echo "DC for current domain: " & strCurrentDC

' Can we ping it?
If Not Ping(strCurrentDC) Then
    FailWithMessage 40000, "Cannot ping current DC"
End If

' What DC will the OS use for the new domain?
intReturnValue = objIADSTools.DsGetDcName("NewDomain.Name")                                   : CheckForError "Looking up current domain controller for NewDomain.Name"
If (intReturnValue <> 0) Then
    FailWithMessage intReturnValue, "Looking up current domain controller for NewDomain.Name"
End If
strNewDC = objIADSTools.DCName                                                              : CheckForError "Getting the located DC name for NewDomain.Name"
WScript.Echo "DC for Newdomain.Name: " & strNewDC

' Can we ping it?
If Not Ping(strNewDC) Then
    FailWithMessage 40001, "Cannot ping NewDomain.Name DC"
End If

WScript.Echo "Connectivity appears valid, returning with exit code 0"
WScript.Quit 0

' Check to see if we have an outstanding error condition
Sub CheckForError(strLocation)
    If Err.Number <> 0 Then
        WScript.Echo "UNEXPECTED ERROR INTERCEPTED: " & strLocation
        FailWithMessage Err.Number, "Description: " & Err.Description
    End If
End Sub

' Fail with the given exit code and message
Sub FailWithMessage(intExitCode, strMessage)
    WScript.Echo intExitCode & ": " & strMessage
    WScript.Quit intExitCode
End Sub

' This function returns True if the specified host could be pinged.
' strHostName can be a computer name or IP address.
' The Win32_PingStatus class used in this function requires Windows XP or later.
' This function is based on the TestPing function in a sample script by Don Jones
' http://www.scriptinganswers.com/vault/computer%20management/default.asp#activedirectoryquickworkstationinventorytxt
' credit: http://www.robvanderwoude.com/vbstech_network_ping.php
Function Ping(strHostName)

    ' Standard housekeeping
    Dim colPingResults, objPingResult, strQuery

    ' Define the WMI query
    strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & strHostName & "'"

    ' Run the WMI query
    Set colPingResults = GetObject("winmgmts:root\cimv2").ExecQuery(strQuery)

    ' Translate the query results to either True or False
    For Each objPingResult In colPingResults
        If Not IsObject(objPingResult) Then
            Ping = False
        Else
            If objPingResult.StatusCode = 0 Then
                Ping = True
            Else
                Ping = False
            End If
            WScript.Echo "Ping status code for " & strHostName & ": " & _
                objPingResult.StatusCode
        End If
    Next

    Set colPingResults = Nothing
End Function

' Forces the script to run in the 32-bit host on a 64-bit machine
' cf. http://blogs.msdn.com/b/joshpoley/archive/2008/09/18/running-32bit-dependent-scripts-in-a-64bit-world.aspx
Sub ForceTo32BitHost
    Dim objShell, strCPU, strHost
    Dim strSysWOW64Host, strNewCommand, strArgument
    Dim objExec, intReturnCode
    
    Set objShell = CreateObject("WScript.Shell")
    strCPU = LCase(objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%"))
    strHost = LCase(WScript.FullName)
    
    If ((InStr(strHost, "system32") <> -1) And (strCPU = "amd64")) Then
        strSysWOW64Host = Replace(strHost, "system32", "syswow64") 
        strNewCommand = strSysWOW64Host + " //NoLogo """ & WScript.ScriptFullName + """"
        For Each strArgument in WScript.Arguments
            strNewCommand = strNewCommand + " """ + strArgument + """"
        Next
        WScript.Echo "Calling self with 32-bit host"
       
        ' Run the child script
        Set objExec = objShell.Exec(strNewCommand)       : CheckForError "Launching 32-bit script host with this script"
        
        Do While (objExec.Status = 0)
            If (Not objExec.StdOut.AtEndOfStream) Then
                WScript.Echo objExec.StdOut.ReadAll
            End If
            If (Not objExec.StdErr.AtEndOfStream) Then
                WScript.Echo objExec.StdErr.ReadAll
            End If
            WScript.Sleep 100
        Loop 
        
        ' Check the child results   
        intReturnCode = objExec.ExitCode
        If (intReturnCode <> 0) Then
            FailWithMessage intReturnCode, "Recursive call script failure " & intReturnCode & " from " & strNewCommand & vbCrLf
        End If
        WScript.Quit 0
    End If
End Sub

I hope this helps you with your migration efforts or just with general script tasks!

– Michael C. Bazarewsky

1 Comment

  1. D. Frailey

    Thanks for also providing very a vbscript example of how to do a network connectivity test (icmp ping) without the annoying black console window!

Leave a Reply or Comment

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: