'__________________________________________________________________ [Header] __
' Cerro Scripts:   MbxReroute.vbs
'
' Copyright (c) 2005 Philipp Föckeler (www.cerrotorre.de)
'
' Dieses Skript erstellt für alle Mail-Enabled User einer Domäne entsprechende 
' Kontakt-Objekte. Diese Kontaktelemente haben die gleiche SMTP-Adresse wie die 
' des User-Objektes, nur mit der Domänen-Adresse "@target.dom" (Variable 
' "target").
' 
' Für die gefundenen Benutzer werden dann Mail-Weiterleitungen (als Kopie) an das
' entsoprechend erzeugte Kontakt-Element konfiguriert. So werden alle Mails einer
' Domäne an die entsprechende Target-Domäne weitergeleitet für alle Benutzer. Die
' Postfächer müssen dafür natürlich in der Target-Maildomäne existieren, ansonsten
' kommt es zu einer Flut von NDR´s.
'
' Usage:  cscript MbxReroute.vbs
'
'	Auf einem Domänen-Controller der betreffenden Domäne ausführen.
'	Vorher die Variablen "target", "user", "passwort" anpassen !!!!
'
'______________________________________________________________________________

WScript.Echo "ReRoute MBX     (c) 2005 CerroTorr Networking (www.cerrotorre.de)" & VbCrLf

user = "administrator"						' Variablen zum Anpassen
passwort = "geheim"
target = "target.dom"
								' Ermitteln des eigenen Domain-Namens
Set rootDSE = GetObject("LDAP://rootDSE")
domainDN = rootDSE.Get("defaultNamingContext")
WScript.Echo "Reroute for Domain " & domainDN 
WScript.Echo "Target Domain is " & target & VbCrLf
								' Vorbereiten der ADO-Suche
Set ado = CreateObject("ADODB.Connection") 
ado.Provider = "ADSDSOObject"
ado.Properties("User ID") = user
ado.Properties("Password") = passwort
ado.Properties("Encrypt Password") = TRUE
ado.Open "ADS-Search"
								' Suche nach Usern mit Postfach
filterStr = "(&(objectclass=user)(mailNickName=*))"
								' ADO-Suche ausführen
Set objectList = ado.Execute("<LDAP://" & domainDN & ">;" & _
                              filterStr & ";ADsPath;SubTree")
								' Für jeden gefundene User
While Not objectList.EOF
	userDN = objectList.Fields(0).Value			' Hole LDAP-Pfad des Objekts
	Set user = GetObject(userDN)				' Bind an Objekt
	If Not (Left(user.displayName,13) = "SystemMailbox") Then 
								' Bilde Parent-Container String
		userContainer = Mid(userDN, Len(user.name)+9)				
								' Neue Target-Adresse bilden
		userTarget = Left(user.mail, Instr(user.mail, "@")) & target

		WScript.Echo "--> " & user.displayName
								' Hidden Contact erzeugen						
		On Error Resume Next
		Set ouParent = GetObject("LDAP://" & userContainer)
		Set contact = ouParent.Create("contact", user.Name & "-ReRoute")
		
		contact.mailNickName = user.mailNickName & "-ReRoute"
		contact.displayName = user.displayName & "-ReRoute"
		contact.msExchHideFromAddressLists = TRUE
		contact.targetAddress = userTarget
		contact.SetInfo					' Kein Error, falls schon vorhanden
		If Not ((Err.Number=0) or (Err.Number = -2147019886)) then
			WScript.Echo "        Error: Could not create contact attributes."
		End If
								' Contact-Weiterleitung
		user.altRecipient = contact.DistinguishedName
		user.deliverAndRedirect = TRUE
		user.Setinfo
		If (Err.Number=0) then
			WScript.Echo "       " & user.mail & " is rerouted to"
			WScript.Echo "       " & userTarget
		Else
			WScript.Echo "        Error: Could not create rerouting."
		End If
	End If
	objectList.MoveNext
WEnd