'======================================================================================= ' ' AUTHOR: Anthony Drewery ' ' DATE: 19th October 2006 ' ' COMMENT: Removes proxy addresses for specific SMTP domains '======================================================================================= Const ForWriting = 2 Const ForReading = 1 Const ADS_PROPERTY_DELETE = 4 'Path for the output file outputfilePath = "C:\processlog.txt" 'Path for input file inputfilepath = "c:\users.txt" 'Path for address log logfilepath = "c:\addresslog.txt" 'Domain to be processes strSMTPDomain = "lykeslines.com" intSDLen = Len(strSMTPDomain) 'Setup input file Set objFSO = CreateObject("Scripting.FileSystemObject") Set objInTextFile = objFSO.OpenTextFile(inputfilepath, ForReading, True) 'Setup output file Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile(outputfilepath, ForWriting, True) 'Setup log file Set objFSO = CreateObject("Scripting.FileSystemObject") Set objAdLogTextFile = objFSO.OpenTextFile(logfilepath, ForWriting, True) 'Create Objects for LDAP Queries Set rootDSE = GetObject("LDAP://RootDSE") DomainContainer = rootDSE.Get("defaultNamingContext") Set conn = CreateObject("ADODB.Connection") conn.Provider = "ADSDSOObject" conn.Open "ADs Provider" 'Read name from input file Do Until objInTextFile.AtEndOfStream strDisplayName = objInTextFile.ReadLine 'Find the user in AD using an LDAP query strLDAP = ";(&(objectCategory=person)(objectClass=user)(displayName=" & strDisplayName & "));adspath;subtree" 'Get query results and output to file Set oComm = CreateObject("ADODB.Command") oComm.ActiveConnection = conn oComm.CommandText = strLDAP oComm.Properties("Sort on") = "DisplayName" oComm.Properties("Page size") = 1500 Set rs = oComm.Execute AddCount = 0 If rs.recordcount = 0 then QueryResult = "User not found" objTextFile.WriteLine(strDisplayName & vbtab & QueryResult) End If If rs.recordcount > 1 then QueryResult = "Resolved to more than one name" objTextFile.WriteLine(strDisplayName & vbtab & QueryResult) End If If rs.recordcount = 1 then QueryResult = "User found" While Not rs.EOF Set FoundObject = GetObject (rs.Fields(0).Value) arrProxyAddresses = FoundObject.proxyAddresses For Each Address In arrProxyAddresses 'Confirm that the address is for the SMTP somain you want to process If left(Address,5)= "smtp:" And Right(LCase(Address),intSDLen)= strSMTPDomain Then objAdLogTextFile.WriteLine(FoundObject.Displayname & vbTab & Address) 'Strip the address from the array FoundObject.PutEx ADS_PROPERTY_DELETE, "proxyAddresses", Array(Address) FoundObject.SetInfo AddCount = AddCount + 1 End if Next rs.MoveNext Wend objTextFile.WriteLine(strDisplayName & vbtab & QueryResult & vbTab & AddCount & " addresses removed") End If Loop MsgBox "Processing complete!"