It's Scripting Time Again! AD Server Descriptions

This issue has come up a LOT in my career, but I don't know why.  It seems like something that Microsoft should address with some "feature" or utility or something.  What I'm blabbering about is updating the description for each Active Directory server account to match whatever the local computer description is.  The local computer description is what you see (and can update) from the Computer "Properties" form.

Local Computer Description

Active Directory Computer Description

It came up again tonight when a friend (called asking for help.  I happened to have the pieces of code on my server and glued them together in a few minutes (the mess below).  Every time I do something like this, I see horrifically bad coding habits from years past and do my best to clean them up before sharing them.

Is this Earth-shatteringly unique?  No.  Is it the only script of its kind? No.  Can you find alternatives on the web that will do just as well?  Absolutely.  If I get a little spare time, I will try to post this in PowerShell format (unless you want to submit that and I will post it, giving you full credit).

In any case, I hope this helps someone out there.  Read the WARNING and DISCLAIMER at the bottom!

'****************************************************************
' Filename..: server_descriptions.vbs
' Author....: David M. Stein
' Date......: 11/26/2012
' Purpose...: update AD computer descriptions from local descriptions

' Usage.....: cscript server_descriptions.vbs >output.log

' (note: the above redirect to output.log is optional)
'****************************************************************

Set objRootDSE = GetObject("LDAP://rootDSE")
ldapRoot = objRootDSE.Get("defaultNamingContext")

Const ADS_SCOPE_SUBTREE = 2
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D

' parse out NetBIOS domain name (e.g. "CONTOSO.COM")
nbDomain = Mid(Split(ldapRoot,",")(0),4)

wscript.echo "info: LDAP root is " & ldapRoot
wscript.echo "info: NetBIOS domain is " & nbDomain

serverlist = GetServerList()

For each strServer in Split(serverlist, ",")
  wscript.echo "server_name...: " & strServer
  strOUpath  = ComputerOU(strServer)
  localDesc  = GetLocalDescription(strServer)
  domainDesc = ADComputerDescription(strOUpath)

  If localDesc = "" Then
    localDesc = "NOT_DEFINED"
  End If

  wscript.echo "ou_path.......: " & strOUPath
  wscript.echo "local_descrip.: " & localDesc
  wscript.echo "domain_descrip: " & domainDesc

  If localDesc <> "NOT_DEFINED" Then
    try = ChangeADDescription(strOUPath, localDesc)
    wscript.echo "desc_updated..: " & try

  End If

  wscript.echo "----------------------------------------"
Next

'----------------------------------------------------------------
' function: get list of servers from domain using OS captions
'----------------------------------------------------------------

Function GetServerList()
  Dim conn, cmd, query, retval : retval = ""
  Dim rs, strOS, strName, counter : counter = 0

  wscript.echo "info: querying server names from active directory..."

  Set cmd = CreateObject("ADODB.Command")
  Set conn = CreateObject("ADODB.Connection")
  conn.Provider = "ADsDSOObject"
  conn.Open "Active Directory Provider"
  cmd.ActiveConnection = conn
  

  query = ";(objectCategory=computer);" & _
    "name,distinguishedName,operatingSystem;subtree"

  cmd.CommandText = query
  cmd.Properties("Page Size") = 100
  cmd.Properties("Timeout") = 30
  cmd.Properties("Cache Results") = False

  Set rs = cmd.Execute

  Do Until rs.EOF
    strOS = rs.Fields("operatingSystem").value
    If InStr(UCase(strOS), "SERVER") > 0 Then   
      strName = rs.Fields("name").value   
      If retval <> "" Then
        If InStr(retval, strName) < 1 Then
          retval = retval & "," & strName
          counter = counter + 1
        End If
      Else
        retval = strName
        counter = counter + 1
      End If
    End If
    rs.MoveNext
  Loop

  rs.Close
  conn.Close
  Set rs = Nothing
  Set cmd = Nothing
  Set conn = Nothing

  wscript.echo "info: " & counter & " servers were found"
  GetServerList = retval

End Function

'----------------------------------------------------------------
' function: get current computer OU from active directory
'----------------------------------------------------------------
 
Function ComputerOU(netBiosName)
  Dim objConnection, objCommand, objRecordSet, strQuery
  Set objConnection = CreateObject("ADODB.Connection")
  Set objCommand = CreateObject("ADODB.Command")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  Set objCommand.ActiveConnection = objConnection
  objCommand.Properties("Page Size") = 1000
  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
  strQuery = "Select ADsPath From 'LDAP://" & ldapRoot & _
    "' WHERE objectCategory='computer'" & _
    " AND name='" & netBiosName & "'"
  
  On Error Resume Next
  objCommand.CommandText = strQuery
  Set objRecordSet = objCommand.Execute
  objRecordSet.MoveFirst
  Do Until objRecordSet.EOF
    strResult = objRecordSet.Fields("ADsPath").Value
    objRecordSet.MoveNext
  Loop
  ComputerOU = strResult
End Function

'----------------------------------------------------------------
' description: get local description from remote computer via WMI
'----------------------------------------------------------------

Function GetLocalDescription(strName)
  Dim objWMI, colItems, objItem

  Dim query, retval : retval = ""

  On Error Resume Next
  Set objWMIService = GetObject("winmgmts:\\" & strName & "\root\CIMV2") 

  If err.Number = 0 Then

    query = "SELECT * FROM Win32_OperatingSystem"
    Set colItems = objWMIService.ExecQuery(query,,48) 
    For Each objItem in colItems 
      retval = objItem.Description
    Next
    If IsNull(retval) or Trim(retval) = "" Then
      retval = ""
    End If

  Else

    wscript.echo "error: " & strName & " is offline or inaccessible"

  End If
  GetLocalDescription = retval
End Function

'----------------------------------------------------------------
' function: get AD computer description
'----------------------------------------------------------------

Function ADComputerDescription(strLDAP)
  Dim objComputer, retval, try, ldapstring
  ldapstring = strLDAP
  On Error Resume Next
  Set objComputer = GetObject(ldapstring)
  try = objComputer.Get("description")
  If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
    retval = ""
    Err.Clear
  Else
    retval = try
  End If
  ADComputerDescription = retval
End Function

'----------------------------------------------------------------
' function: set AD computer description (limit 48 chars)
' refer to: http://msdn.microsoft.com/en-us/library/windows/desktop/aa394239(v=vs.85).aspx
'----------------------------------------------------------------

Function ChangeADDescription(strLdapName, strDesc)
  Dim objPC, retval
  wscript.echo "info: modifying domain description..."
  On Error Resume Next
  Set objPC = GetObject(strLdapName)
  objPC.Description = strDesc
  objPC.SetInfo
  retval = err.Number
  If retval <> 0 Then
    retval = retval & " / " & err.Description
  Else
    retval = "SUCCESS"
  End If
  Set objPC = Nothing
  ChangeADDescription = retval
End Function

Warning

This script example includes MINIMAL error handling.  Always TEST, TEST, TEST, and when you think it works properly, TEST it some more.

Disclaimer

Use this script code AT YOUR OWN RISK.  Always test thoroughly in an isolated "test" or "development" environment to avoid negatively impacting production computers.  The author assumes/accepts NO LIABILITY for any direct or derivative use or consequential damages, however, the author wouldn't mind a little constructive feedback if it helps you in any way.