Solved

Find duplicate smtp address in domain

Posted on 2013-01-30
5
2,567 Views
Last Modified: 2013-02-19
Hi Experts,

I am looking for a VB Script to find the duplicate smtp address exist in network.
Please help me to obtain this task... also am fine if some other script if you have.

Script Source:
https://support.quest.com/SolutionDetail.aspx?id=SOL48668

i found a script on a website, but it throughs an error below.

ERROR:
*************************************************************
................................................................................
................................................................................
....

AD domains processed:
        DC=Temple,DC=qc Objects: 147235

C:\Temp\SOL48668_DupSMTP-s\DupSMTP.vbs(234, 5) Microsoft VBScript runtime error:
 Invalid procedure call or argument
**************************************************************

Script:

'	Version:	20020210.02
'
'	DUPSMTP	locate duplicate SMTP addresses across all AD domains
'			Produces a tab-separated values file of all SMTP proxy
'			addresses that are used by more than one Active Directory
'			object.
'
'			The script must be run from CSCRIPT. The suggested command line is:
'				cscript dupsmtp.vbs >output.txt //Nologo
'
'			The outout file contains these fields:
'				ProxyAddress		- the SMTP address
'				DistinguishedName	- the DN of the object that uses the ProxyAddress
'				FolderPath			- the folderPathname if the DN is a Public Folder
'									  otherwise it's empty (making it convenient to find
'									  conflicts between public folders and users or groups
'			
'		
'	Author:	Rich Matheisen
' --------------------------------------------------------------------------
'	Copyright (C) 2002 Richard Matheisen
' --------------------------------------------------------------------------
'
'	Changes:
'		20020209.01	-	initial release
'		20020210.02 -
' 			added count of items processed in each domain to domain dictionary
' 			added folderPathname to compliment DN (probably needs work on the display format)
' 			added error checking on binding to GC
' 			write errors to SDTERR
' 			write duplicates dictionary to STDOUT
'				changed format to tab-separated w/header, 
'				each set of duplicates separated by one blank line
' 			write domains dictionary to STDERR
'			write version info to STDERR
'			sort the data in Domain and Proxy dictionaries before output
'			added progress "crawl" to STDERR
'			adjusted LDAP page size (100, was 1000)
'			adjusted LDAP query timeout (900 seconds, was 120 seconds)
' ==========================================================================================

option explicit

Dim oGC				' IADs
DIM strGCADsPath	' String
DIM var				' Variant
Dim adoConn			' ADODB.Connection
Dim adoCmd			' ADODB.Command
Dim adoRecSet		' ADODB.Recordset
DIM strADOQuery 	' String
Dim strADOFields	' String
Dim Base			' String

' values used to open connection
Dim userID, Password, Options
UserID		= vbNullString
Password	= vbNullString
Options		= -1

' **  LDAP query parameters  **
' keep the pages size small (100 may even be too big)
' keep the timeout long - 900 seconds (15 min)
'  (busy GCs may take quite a long time to return a page full of results, 
'   and timing out after running for 10 minutes on a large dataset is discouraging)
Dim pgsize			' LDAP query page size
pgsize		= 100
Dim tmout			' LDAP query timeout
tmout		= 900

Dim bIsOK	' just a boolean used to return results

' variables used to work with the data
Dim pxy				' the array of proxyAddresses
Dim dn				' the Distinguished Name
Dim	fldr			' the Public Folder path name
DIM dictSmtpaddr	' dictionary of SMTP addresses
DIM dictDomains		' dictionary of AD Domains processed


	Wscript.StdErr.WriteBlanklines(1)
	Wscript.StdErr.Writeline "#"
	Wscript.StdErr.Writeline "# DUPSMTP - Version 20020210.02"
	Wscript.StdErr.Writeline "#"

'	---------------------------------------
'	Bind to the Global catalog.  
'	---------------------------------------
	Dim NS

	On Error resume Next
	Set NS = GetObject("GC:")
	If Err.Number <> 0 Then
		WScript.StdErr.Writeline "Cannot bind to GC: " & _
					 vbLF & "Error code: " & Err.Number & _
					 vbLF & "Error desc: " & Err.Description
		Wscript.Exit
	End If
	On Error Goto 0

'	---------------------------------------
'	Once we have the container we enumerate 
'	one time to get the GC object
'	---------------------------------------
	For Each var in NS
		Set oGC = var
	Next
	strGCADsPath = oGC.ADsPath    ' cache the ADsPath for the query
	Base = strGCADsPath
'	---------------------------------------
'	Set up the connection
'	---------------------------------------
	bIsOK = OpenAdoConnection(adoConn, UserId, Password, Options)
	If (Not bIsOK) Then
		Wscript.StdErr.WriteLine "Couldn't open connection. Exiting."
		Wscript.Quit
	End If

'   -----------------------------------------
'	Build the query string using LDAP dialect
'	Build the results string using LDAP dialect
'   -----------------------------------------
	strADOQuery = "(|(&(objectCategory=person)(objectClass=user))" & _
				  "(objectClass=publicFolder)" & _
				  "(&(objectCategory=person)(objectClass=contact))" & _
				  "(&(objectCategory=Group)(objectClass=group)))"
	strADOFields =  "cn,distinguishedName,proxyAddresses,folderPathname,objectClass,objectCategory"

'   -----------------------------------------
'   Set up the command
'   --------------------------------------
	bIsOK = OpenAdoCommand(	Base, _
							strADOQuery, _
							strADOFields, _
							"Subtree",pgsize,tmout,adoConn,adoCmd)
	If (Not bIsOK) Then
		Wscript.StdErr.Writeline "Couldn't create command. Exiting."
		Wscript.Quit
	End If

'   ----------------------------------------------------
'	Execute the query for the objects in the directory
'   ----------------------------------------------------
	bIsOK = OpenAdoRecordSet(adoCmd, adoRecSet)
	If (Not bIsOK) Then
		Wscript.StdErr.Writeline "Failed to create record set. Exiting."
		Wscript.Quit
	End If

	' Create the Dictionaries to hold the results
	Set dictDomains = CreateObject("Scripting.Dictionary")
	dictDomains.CompareMode = 1									' case-insensitive keys
	Set dictSmtpAddr = CreateObject("Scripting.Dictionary")
	dictSmtpAddr.CompareMode = 1								' case-insensitive keys

'	--------------------------------------------------
'	Process each item in the recordset
'	--------------------------------------------------
	Dim ctr									' just a progress indicator
	while (not adoRecSet.EOF)
		Dim n, i, a							' scratch areas
		
		ctr = ctr + 1
		If (ctr MOD 200) Then				' write a "crawl" on the console to indicate progress
			Wscript.StdErr.Write "."
		End If
		pxy = adoRecSet.Fields("proxyAddresses")
		dn = adoRecSet.Fields("distinguishedName")
		fldr = adoRecSet.Fields("folderPathname")

		' extract just the AD domain from the Distinguished Name
		i = InStr(1, dn, ",DC=",vbTextCompare)	' find the first DC in the DN (case-insensitive search)
		n = Right(dn,Len(dn) - i)				' use the DC's as the key
		If (not dictDomains.Exists(n)) Then
			dictDomains.Add n, 1
		Else
			dictDomains.Item(n) = (dictDomains.Item(n)) + 1
		End If


		' store the DN and folder path with all other DN's having the same SMTP address	
		'  the proxy addresses may not exist, so test to avoid any runtime errors
		'  *   the VarType should be 8204 [8192 (vbArray) + 12 (vbVariant)]
		If (VarType(pxy) AND vbArray) Then
			Dim j
			For j = LBound(pxy) To UBound(pxy)
				n = pxy(j)
				If (UCase(Left(n,5)) = "SMTP:") then
					dn = dn & vbTab & fldr				' add folderPathname to DN so Public Folders are easier to find
					i = Right(n,Len(n)-5)				' omit the address type prefix
					If (dictSmtpaddr.Exists(i)) Then	' use SMTP address as key
						a = dictSmtpaddr.Item(i)		' get the array of DN using this address
						Redim Preserve a(Ubound(a) + 1)	' increase size of array, preserving contents
						a(Ubound(a)) = dn				' add new DN
						dictSmtpAddr.Item(i) = a		' save the list
					Else
						Redim a(0)						' create new list
						a(0) = dn						' add DN to it
						dictSmtpaddr.Add i, a			' save list in dictionary
					End If
				End If
			Next	' next proxy address
		End If		' end of proxy addresses array test
		' Advance the recordset
		adoRecSet.MoveNext
	Wend

'	-----------------------------------------------------
'	All information has been processed, begin reporting
'	-----------------------------------------------------
	Dim k, keys, ln

	' report on the domains that were encountered and the number
	' of objects in each domain (this doesn't add anything to the 
	' value of the data but it does "validate" that all domains
	' have been looked at.
	WScript.StdErr.WriteBlankLines(2)
	WScript.StdErr.Writeline "AD domains processed:"
	keys = dictDomains.keys
	Call Quicksort (keys, LBound(keys), UBound(keys))
	For Each k In keys
		Wscript.StdErr.WriteLine vbTab & k & vbTab & "Objects: " & dictDomains.Item(k)
	Next
	WScript.StdErr.WriteBlankLines(1)

	' report on the duplicate SMTP addresses encountered
	keys = dictSmtpAddr.Keys
	Call Quicksort (keys, LBound(keys), UBound(keys))
	Wscript.StdOut.Writeline "ProxyAddress" & vbTab & "DistinguishedName" & vbTab & "FolderPath"
	For Each k In keys
		a = dictSmtpaddr.Item(k)
		If (Ubound(a) > 0) Then		' only report the exceptions (>1 DN uses the same proxy address)
			For Each i In a
				ln = k & vbTab & i	' each "i" contains a vbTab to separate DN and folder path
				Wscript.StdOut.Writeline ln
			Next
			Wscript.Stdout.Writeline vbTab & vbTab	' keep same number of columns in each row
		End If
	Next

	adoRecSet.Close
	adoConn.Close

	Set adoRecSet = Nothing
	Set adoCmd = Nothing
	Set adoConn = Nothing

	Set oGC = Nothing

'================================================================

' Use:
'	Dim bIsOK
'	Dim adoConn
'	Dim UserId, Password, Options
'	UserId = vbNullString
'	Password = vbNullString
'	Options = -1
' 	bIsOK = OpenAdoCommand(adoConn, UserId, Password, Options)
'   if Not bIsOK Then
'		... no connection was returned
'	Else
'		... connection is open and ready to use
'	End If
'

Function OpenAdoConnection (ByRef adoConnection, ByVal UserId, ByVal Password, ByVal Options)

	Dim adoCommand

	On Error Resume Next

	Set adoConnection 	= Wscript.CreateObject("ADODB.Connection")

	' Open the connection
	adoConnection.Provider	= "ADsDSOObject"

	' connection string, userid, password, options
	Err.Clear
	adoConnection.Open  "Active Directory Provider", UserId, Password, Options

	' Return "false" and exit if connection failed
	If Err.Number <> 0 Then
		OpenAdoConnection = False
		Exit Function
	End If
	OpenAdoConnection = True
End Function

'=================================================================================
' Close an existing connection
Function CloseAdoConnection(ByRef adoConnection)
	adoConnection.Close
	Set adoConnection = Nothing
End Function


'=================================================================================
' Use:
' Dim bIsOK
' Dim adoConn		' a Connection object
' Dim adoCmd
'
' bIsOK = OpenAdoCommand("LDAP://dc3.rmcons.com:3268/dc=rmcons,dc=com"
'			"(&(objectCategory=person)(objectClass=user))", _
'			"cn,distinguishedName","Subtree",100,120,adoConn,adoCmd)
'
Function OpenAdoCommand( _
	ByVal strLDAPBase, ByVal strCriteria, ByVal strAttributeList, _
	ByVal strDepth, ByVal PageSize, ByVal TimeOut, _
	ByVal adoConnection, ByRef adoCommand _
)

	Const ADS_SCOPE_BASE		= 0	' see ADS_SCOPE in ADSI docs
	Const ADS_SCOPE_ONELEVEL	= 1	' see ADS_SCOPE in ADSI docs
	Const ADS_SCOPE_SUBTREE		= 2	' see ADS_SCOPE in ADSI docs
	Const ADS_CHASE_REFERRALS_EXTERNAL = 64

	Set adoCommand		= Wscript.CreateObject("ADODB.Command")
	Set adoCommand.ActiveConnection = adoConnection

	' Set the command to execute the query
	adoCommand.CommandText = "<" & strLDAPBase & ">;" & _
		strCriteria & ";" & strAttributeList & ";" & _
		strDepth

'	adoCommand.CommandText = 	"SELECT '" & _
'								strAttributeList & "' " & _
'								"FROM '" & _
'								strLDAPBase & "' " & _
'								"WHERE '" & _
'								strCriteria & "'"

	adoCommand.Properties("Page Size") 	= PageSize
	adoCommand.Properties("Timeout")	= Timeout
	adoCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_EXTERNAL
	Select Case Lcase(strDepth)
		Case "base"
			adoCommand.Properties("searchscope")	= ADS_SCOPE_BASE
		Case "onelevel"
			adoCommand.Properties("searchscope")	= ADS_SCOPE_ONELEVEL
		Case "subtree"
			adoCommand.Properties("searchscope")	= ADS_SCOPE_SUBTREE
		Case Else
			adoCommand.Properties("searchscope")	= ADS_SCOPE_SUBTREE
	End Select
	adoCommand.Properties("Cache Results")	= False

' uncomment the next line to display the command used to run the query
'Wscript.Echo adoCommand.CommandText

	OpenAdoCommand = True
End Function

'=================================================================================
' -- execute the connection's command and return the resulting record set
Function OpenAdoRecordSet(ByVal adoCommand, ByRef adoRecordSet)
	' Execute the command
	Err.Clear
	Set adoRecordset = adoCommand.Execute
	If Err.Number <> 0 Then
		Set adoRecordset = Nothing
		OpenAdoRecordSet = False
		Exit Function
	End If

	OpenAdoRecordSet = True
End Function

'=================================================================================
' -- Close and release an open record set
Function CloseAdoRecordSet(ByRef adoRecSet)
	adoRecSet.Close
	Set adoRecSet = Nothing
	CloseAdoRecordSet = True
End Function

' ================================================================================
'
Sub Quicksort(strValues(), ByVal min, ByVal max)

	Dim strMediumValue, high, low, i
	
	If (min >= max) Then Exit Sub	' if there's only one item

	i = min + Int(Rnd(max - min + 1))	' pick a dividing item, randomly
	strMediumValue = strValues(i)

	strValues(i) = strValues(min)		' swap the dividing item to the front of the list

	low = min
	high = max
	Do
		' look down from high for a value < strMediumValue
		Do While strValues(high) >= strMediumValue
			high = high - 1
			If (high <= low) Then Exit Do
		Loop

		If (high <= low) Then			' the list is separated
			strValues(low) = strmediumValue
			Exit Do
		End If

		strValues(low) = strValues(high)	' swap the low and high strValues

		' look up from low for a value > strMediumValue
		low = low + 1
		Do While strValues(low) < strMediumValue
			low = low + 1
			If (low >= high) Then Exit Do
		Loop

		If (low >= high) Then			' the list is separated
			low = high
			strValues(high) = strMediumValue
			Exit Do
		End If

		' swap the low and high values
		strValues(high) = strValues(low)
	Loop	' Loop until the list is separated

	' Recursively sort the sublists
	Quicksort strValues, min, low - 1
	Quicksort strvalues, low + 1, max

End Sub

Open in new window


Thanks,
Prem
0
Comment
Question by:Premkumar Yogeswaran
  • 3
  • 2
5 Comments
 
LVL 52

Expert Comment

by:Manpreet SIngh Khatra
ID: 38838355
There are few thing i know but not Scripts

Csvde -f C:\User.csv

ADUC -> Custom Search -> Advance ->  ProxyAddresses:SMTP=Emailaddress you want to find
http://www.msexchange.org/articles-tutorials/exchange-server-2003/management-administration/Finding-Duplicate-SMTP-Addresses.html

- Rancy
0
 
LVL 52

Expert Comment

by:Manpreet SIngh Khatra
ID: 38838357
You can also check this
http://support.microsoft.com/kb/318774

- Rancy
0
 
LVL 17

Author Comment

by:Premkumar Yogeswaran
ID: 38840292
Hi Rancy,

i already refered this links.. currently i am looking for the script which could provide me the list of duplicate smtp address in domain..

Thanks,
Prem
0
 
LVL 52

Accepted Solution

by:
Manpreet SIngh Khatra earned 500 total points
ID: 38840918
Removing duplicate and unwanted proxy addresses in Exchange
http://support.microsoft.com/kb/318774

Not sure if you have tired those as there arent many duplicate addresses as Exchange\AD doesnt allow until someone plays around using other tools

- Rancy
0
 
LVL 17

Author Closing Comment

by:Premkumar Yogeswaran
ID: 38904856
Thanks for your post, but i used the script i posted above.
it worked for me with an error.

Regards,
Prem
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Exchange server is not supported in any cloud-hosted platform (other than Azure with Azure Premium Storage).
Learn to move / copy / export exchange contacts to iPhone without using any software. Also see the issues in configuration of exchange with iPhone to migrate contacts.
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …
The video tutorial explains the basics of the Exchange server Database Availability groups. The components of this video include: 1. Automatic Failover 2. Failover Clustering 3. Active Manager

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now