A script to enumerate trust information from an Active Directory forest.
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").Value, 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