Const ADS_SCOPE_SUBTREE = 2

' Trust Type
' http://msdn.microsoft.com/en-us/library/cc223771(PROT.10).aspx
Dim objTrustTypes
Set objTrustTypes = CreateObject("Scripting.Dictionary")
objTrustTypes.Add 4, "DCE"
objTrustTypes.Add 3, "MIT"
objTrustTypes.Add 2, "UpLevel"
objTrustTypes.Add 1, "DownLevel"

' Trust Attributes
' http://msdn.microsoft.com/en-us/library/cc223779(PROT.10).aspx
Dim objTrustAttributes
Set objTrustAttributes = CreateObject("Scripting.Dictionary")
objTrustAttributes.Add 128, "UsesRC4Encryption"
objTrustAttributes.Add 64, "TreatAsExternal"
objTrustAttributes.Add 32, "WithinForest"
objTrustAttributes.Add 16, "CrossOrganisation"
objTrustAttributes.Add 8, "ForestTransitive"
objTrustAttributes.Add 4, "QuarantinedDomain"
objTrustAttributes.Add 2, "UpLevelOnly"
objTrustAttributes.Add 1, "NonTransitive"

' Trust Direction
' http://msdn.microsoft.com/en-us/library/cc223768(PROT.10).aspx
Dim objTrustDirection
Set objTrustDirection = CreateObject("Scripting.Dictionary")
objTrustDirection.Add 3, "BiDirectional"
objTrustDirection.Add 2, "Outbound"
objTrustDirection.Add 1, "Inbound"
objTrustDirection.Add 0, "Disabled"

Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Dim objCommand : Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT distinguishedName, name, trustType, " & _
  "trustAttributes, trustDirection, trustPartner, whenCreated " & _
  "FROM 'GC://" & objRootDSE.Get("rootDomainNamingContext") & _
  "' WHERE objectClass='trustedDomain'"

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Dim objRecordSet : Set objRecordSet = objCommand.Execute

While Not objRecordSet.EOF
  WScript.Echo "Trusted Domain: " & objRecordSet.Fields("name").Value
  WScript.Echo "Trust Type: " & _
    objTrustTypes(objRecordSet.Fields("trustType").Value)

  Dim dblFlag
  Dim strFlags : strFlags = ""
  For Each dblFlag in objTrustAttributes
    If objRecordSet.Fields("trustAttributes").Value And dblFlag Then
      strFlags = strFlags & objTrustAttributes(dblFlag) & " "
    End If
  Next
  WScript.Echo "Trust Attributes: " & strFlags

  WScript.Echo "Trust Direction: " & _
    objTrustDirection(objRecordSet.Fields("trustDirection").Value)
  WScript.Echo "Trust Partner: " & objRecordSet.Fields("trustPartner").Value
  WScript.Echo "Distinguished Name: " & _
    objRecordSet.Fields("distinguishedName").Value
  WScript.Echo "Created: " & objRecordSet.Fields("whenCreated").Value

  objRecordSet.MoveNext
Wend

objConnection.Close

Usage example

In the past I have used the script above to monitor trust settings across a forest. The following script uses the trust information to build a text file storing trust configuration sends an e-mail if that configuration changes.

Option Explicit

' Script to get trusts, compare with stored configuration and notify if changed

Sub ShowUsage
  Dim strUsage
  strUsage = "Usage:" & vbCrLf & vbCrLf & _
    WScript.ScriptName & _
    " /Command:[Update | Notify] [/MailServer:<serverName>] " & _
    "[/Recipient:<address>]" & vbCrLf & vbCrLf & _
    "Arguments:" & vbCrLf & vbCrLf & _
    "    Command      Update - Updates the contents of the text " & _
    "file with data from the global catalog" & vbCrLf & _
    "                 Notify - Notifies the recipient using mailserver " & _
    "if the trust data changes" & vbCrLf & _
    "    MailServer   Server used to send mail. Default: localhost" & vbCrLf & _
    "    Recipient    Email address of person or group to notify" & vbCrLf

  WScript.Echo strUsage
  WScript.Quit
End Sub

Function GetTrusts
  ' Returns a Scripting.Dictionary object containing details of the Trust
  ' Format:
  ' Key: DistinguishedName
  ' Data: Array(
  '           Trusted Domain,
  '           Type,
  '           Attributes,
  '           Direction,
  '           Partner,
  '           Created,
  '           Changed )

  Const ADS_SCOPE_SUBTREE = 2

  ' Trust Type
  ' http://msdn.microsoft.com/en-us/library/cc223771(PROT.10).aspx
  Dim objTrustTypes
  Set objTrustTypes = CreateObject("Scripting.Dictionary")
  objTrustTypes.Add 4, "DCE"
  objTrustTypes.Add 3, "MIT"
  objTrustTypes.Add 2, "UpLevel"
  objTrustTypes.Add 1, "DownLevel"

  ' Trust Attributes
  ' http://msdn.microsoft.com/en-us/library/cc223779(PROT.10).aspx
  Dim objTrustAttributes
  Set objTrustAttributes = CreateObject("Scripting.Dictionary")
  objTrustAttributes.Add 128, "UsesRC4Encryption"
  objTrustAttributes.Add 64, "TreatAsExternal"
  objTrustAttributes.Add 32, "WithinForest"
  objTrustAttributes.Add 16, "CrossOrganisation"
  objTrustAttributes.Add 8, "ForestTransitive"
  objTrustAttributes.Add 4, "QuarantinedDomain"
  objTrustAttributes.Add 2, "UpLevelOnly"
  objTrustAttributes.Add 1, "NonTransitive"

  ' Trust Direction
  ' http://msdn.microsoft.com/en-us/library/cc223768(PROT.10).aspx
  Dim objTrustDirection
  Set objTrustDirection = CreateObject("Scripting.Dictionary")
  objTrustDirection.Add 3, "BiDirectional"
  objTrustDirection.Add 2, "Outbound"
  objTrustDirection.Add 1, "Inbound"
  objTrustDirection.Add 0, "Disabled"

  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"

  Dim objCommand : Set objCommand = CreateObject("ADODB.Command")
  objCommand.ActiveConnection = objConnection

  Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")
  objCommand.CommandText = "SELECT distinguishedName, name, " & _
    "trustType, trustAttributes, trustDirection, trustPartner, " & _
    "whenCreated, whenChanged " & _
    "FROM 'GC://" & objRootDSE.Get("rootDomainNamingContext") & _
    "' WHERE objectClass='trustedDomain'"

  objCommand.Properties("Page Size") = 1000
  objCommand.Properties("Timeout") = 600
  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
  objCommand.Properties("Cache Results") = False

  Dim objRecordSet : Set objRecordSet = objCommand.Execute

  Dim objTrusts : Set objTrusts = CreateObject("Scripting.Dictionary")

  While Not objRecordSet.EOF
    Dim dblFlag
    Dim strAttributes : strAttributes = ""
    For Each dblFlag in objTrustAttributes
      If objRecordSet.Fields("trustAttributes").Value And dblFlag Then
        strAttributes = strAttributes & objTrustAttributes(dblFlag) & " "
      End If
    Next

    objTrusts.Add objRecordSet.Fields("distinguishedName").Valuem, Array( _
      objRecordSet.Fields("name").Value, _
      objTrustTypes(objRecordSet.Fields("trustType").Value), _
      strAttributes, _
      objTrustDirection(objRecordSet.Fields("trustDirection").Value), _
      objRecordSet.Fields("trustPartner").Value, _
      objRecordSet.Fields("whenCreated").Value, _
      objRecordSet.Fields("whenChanged").Value)

    objRecordSet.MoveNext
  Wend

  objConnection.Close

  Set objRecordSet = Nothing
  Set objCommand = Nothing
  Set objConnection = Nothing

  Set GetTrusts = objTrusts
End Function

Sub SendMail(strRecipient, strBody, strMailServer)

  Set objMail = CreateObject("CDO.Message")
  objMail.Subject = "Trust monitor"

  objMail.From = strRecipient
  objMail.To = strRecipient

  objMail.TextBody = strBody

  objMail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  objMail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
    strMailServer
  objMail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

  objMail.Configuration.Fields.Update
  objMail.Send
End Sub

'
' Main Code
'

Dim objFileSystem
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim objFile

Dim objTrusts : Set objTrusts = GetTrusts

If LCase(WScript.Arguments.Named("command")) = "update" Then
  Set objFile = objFileSystem.OpenTextFile("Trusts.txt", 2, True, 0)

  Dim strDN
  For Each strDN in objTrusts
    objFile.WriteLine strDN & vbTab & Join(objTrusts(strDN), vbTab)
  Next

ElseIf LCase(WScript.Arguments.Named("command")) = "notify" Then

  strRecipient = WScript.Arguments.Named("recipient")

  If strRecipient = "" Then
    WScript.Echo "ERROR: No recipient defined"
    ShowUsage
  End If

  strMailServer = WScript.Arguments.Named("mailserver")

  If strMailServer = "" Then
    strMailServer = "localhost"
  End If

  If objFileSystem.FileExists("Trusts.txt") Then
    Set objFile = objFileSystem.OpenTextFile("Trusts.txt", 1, False, 0)

    Dim objTrustsInFile
    Set objTrustsInFile = CreateObject("Scripting.Dictionary")

    Dim arrTrustData()
    Do While Not objFile.AtEndOfStream
      Dim arrTrustInFile : arrTrustInFile = Split(objFile.ReadLine, vbTab)

      ReDim arrTrustData(0)
      Dim i
      For i = 1 to UBound(arrTrustInFile)
        ReDim Preserve arrTrustData(i - 1)
        arrTrustData(i - 1) = arrTrustInFile(i)
      Next

      objTrustsInFile.Add arrTrustInFile(0), arrTrustData
    Loop
  End If

  Dim strTrust

  ' Comparison - Check for new Trusts

  Dim objNewTrusts : Set objNewTrusts = CreateObject("Scripting.Dictionary")

  For Each strTrust in objTrusts
    If Not objTrustsInFile.Exists(strTrust) Then
      objNewTrusts.Add strTrust, objTrusts(strTrust)
    End If
  Next

  ' Comparison - Check for removed Trusts

  Dim objRemovedTrusts
  Set objRemovedTrusts = CreateObject("Scripting.Dictionary")

  For Each strTrust in objTrustsInFile
    If Not objTrusts.Exists(strTrust) Then
      objRemovedTrusts.Add strTrust, objTrustsInFile(strTrust)
    End If
  Next

  ' Data: Array(
  '           Trusted Domain,
  '           Type,
  '           Attributes,
  '           Direction,
  '           Partner,
  '           Created,
  '           Changed )

  Dim strMessageBody
  Dim booNotify : booNotify = False
  If objNewTrusts.Count > 0 Then
    booNotify = True
    strMessageBody = "New Trusts:" & vbCrLf & vbCrLf
    For Each strTrust in objNewTrusts
      strMessageBody = strMessageBody & "DN: " & strTrust & vbCrLf & _
        "Trusted Domain: " & objNewTrusts(strTrust)(0) & vbCrLf & _
        "Type: " & objNewTrusts(strTrust)(1) & vbCrLf & _
        "Attributes: " & objNewTrusts(strTrust)(2) & vbCrLf & _
        "Direction: " & objNewTrusts(strTrust)(3) & vbCrLf & _
        "Partner: " & objNewTrusts(strTrust)(4) & vbCrLf & _
        "Created: " & objNewTrusts(strTrust)(5) & vbCrLf & _
        "Changed: " & objNewTrusts(strTrust)(6) & vbCrLf & vbCrLf
    Next
  End If
  If objRemovedTrusts.Count > 0 Then
    booNotify = True
    For Each strTrust in objRemovedTrusts
      strMessageBody = strMessageBody & "DN: " & strTrust & vbCrLf & _
        "Trusted Domain: " & objRemovedTrusts(strTrust)(0) & vbCrLf & _
        "Type: " & objRemovedTrusts(strTrust)(1) & vbCrLf & _
        "Attributes: " & objRemovedTrusts(strTrust)(2) & vbCrLf & _
        "Direction: " & objRemovedTrusts(strTrust)(3) & vbCrLf & _
        "Partner: " & objRemovedTrusts(strTrust)(4) & vbCrLf & _
        "Created: " & objRemovedTrusts(strTrust)(5) & vbCrLf & _
        "Changed: " & objRemovedTrusts(strTrust)(6) & vbCrLf & vbCrLf
    Next
  End If
  If booNotify = True Then
    strMessageBody = strMessageBody & _
      "If these trusts are correct please run " & _
      WScript.ScriptName & " /Command:Update"

    SendMail strRecipient, strMessageBody, strMailServer
  End If
Else

  ShowUsage

End If

No related posts.

Related posts brought to you by Yet Another Related Posts Plugin.