quote:

cscript //nologo smtpreg.vbs /add 1 onarrival SMTPScriptingCatchAll CDO.SS_SMTPOnArrivalSink "mail from=myspammer@somewhere.com"
cscript //nologo smtpreg.vbs /setprop 1 onarrival SMTPScriptingCatchAll Sink ScriptName c:\ExchangeScripts\CatchEmail.vbs

quote:

<SCRIPT LANGUAGE="VBSCRIPT">
'
' Based on MSKB 324021
'
Option Explicit
'
' For information about this namespace, see 
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdosys/html/_cdosys_schema_smtpenvelope.asp
'
Const RECIP_LIST = "http://schemas.microsoft.com/cdo/smtpenvelope/recipientlist"
'
' For information about the CdoEventStatus enumeration, see 
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdosys/html/_cdosys_cdoeventstatus_enum.asp
'
Const CDO_RUN_NEXT_SINK = 0
'
' Domain names of interest
' -- these can be pulled from AD (Recipient Policies and Internet Message Formats) - but it's slow
'
Const strEmailDomainName1 = "@mydomain.com"		'' make sure these are in lower case
Const strEmailDomainName2 = "@mydomain.com"
'
' Email address to forward received email to if destination address isn't valid for the destination domain
'
Const strDestinationEmail = "smtp:me@mydomain.com;"   '' make sure this is in lower-case, starts with "smtp:" and ends with ";"
'
' For Application Event Log entries
'
Const EVENT_SUCCESS = 0
Const EVENT_ERROR   = 1
'
' 
Const bDebug = False
'
Dim oRootDSE		' (ActiveDs.IADs) directory services root object
Dim varDomainNC		' (String) the domain naming context, will be a string of the form "DC=brnets,DC=int"
Dim StartTime		' (Float) Time the program started
Dim EndTime		' (Float) Time the real work in the program ended
Dim objShell		' (WScript.Shell) Used for logging
Dim Conn		' (ADODB.Connection) Connection to Active Directory
Dim Com			' (ADODB.Command) Active Directory LDAP command
Dim Rs			' (ADODB.Recordset) Result-set from AD LDAP command

Sub IEventIsCacheable_IsCacheable()
	' just returns S_OK
End Sub
'
' OnArrival sink entry point
'
Sub ISMTPOnArrival_OnArrival (ByVal Msg, EventStatus)
	Dim objFields
	Dim strInput
	Dim strOutput

	On Error Resume Next

	If DoSetup () Then
		Set objFields = Msg.EnvelopeFields
		strInput = objFields (RECIP_LIST).Value

		If bDebug Then
			objShell.LogEvent EVENT_SUCCESS, "Event sink input: '" & strInput & "'"
		End If

		If Len (strInput) > 0 Then
			strOutput = FixupRecipientList (strInput)

			objFields (RECIP_LIST).Value = strOutput
			objFields.Update
  
			Msg.DataSource.Save ' Commit changes
		End If

		If bDebug Then
			objShell.LogEvent EVENT_SUCCESS, "Event sink output: '" & strOutput & "' time = " & (Timer - StartTime)
		End If

		Call DoCleanup ()
	End If

	EventStatus = CDO_RUN_NEXT_SINK

End Sub

Function SearchForAddress (ByVal strAddress)
'
' Make an LDAP query for the address. It should have the "SMTP:" in front, but the terminal ';' stripped
'
	Dim strQuery	' As String
	Dim Address	' As String

	SearchForAddress = True ' everything is fine so far

	On Error Resume Next

	strQuery = "<LDAP://" & varDomainNC & ">;(proxyAddresses=" & strAddress & ");userprincipalname"
	If bDebug Then
		objShell.LogEvent EVENT_SUCCESS, "LDAP Query String: '" & strQuery & "'"
	End If

	Com.ActiveConnection = Conn
	Com.CommandText = strQuery

	Err.Clear
	Set Rs = Com.Execute
	If Err.Number <> 0 Then
		objShell.LogEvent EVENT_ERROR, "Com.Execute " & Err.Number & " " & Err.Description
		SearchForAddress = False ' arguably, this should be true
		Exit Function
	End If

	' Iterate through the results.
	While Not Rs.EOF
		' If we get here, the address was found in AD. That's all we care about.
		Rs.Close
		Exit Function
	Wend

	' Done with this LDAP query
	Rs.Close

	' Address of interest was not found in AD
	SearchForAddress = False
End Function

Function DoSetup ()
	On Error Resume Next

	StartTime = Timer

	DoSetup = True ' everything is OK so far

	Set oRootDSE = GetObject("LDAP://RootDSE")
	varDomainNC = oRootDSE.Get ("defaultNamingContext")
	'WScript.Echo "Domain Naming Context: " & varDomainNC

	Err.Clear
	Set objShell = CreateObject ("WScript.Shell")
	If Err.Number <> 0 Then
		' Can't log an error - don't have any way to!
		DoSetup = False
		Set oRootDSE = Nothing
		Exit Function
	End If

	Err.Clear
	set Conn = CreateObject ("ADODB.Connection")
	If Err.Number <> 0 Then
		objShell.LogEvent EVENT_ERROR, "Conn.Create " & Err.Number & " " & Err.Description
		DoSetup = False
		Set oRootDSE = Nothing
		Set objShell = Nothing
		Exit Function
	End If

	Err.Clear
	set Com  = CreateObject ("ADODB.Command")
	If Err.Number <> 0 Then
		objShell.LogEvent EVENT_ERROR, "Com.Create " & Err.Number & " " & Err.Description
		DoSetup = False
		Set oRootDSE = Nothing
		Set objShell = Nothing
		Set Conn     = Nothing
		Exit Function
	End If

	' Open the connection.
	Conn.Provider = "ADsDSOObject"

	Err.Clear
	Conn.Open "ADsDSOObject"
	If Err.Number <> 0 Then
		objShell.LogEvent EVENT_ERROR, "Conn.Open " & Err.Number & " " & Err.Description
		DoSetup = False
		Set oRootDSE = Nothing
		Set objShell = Nothing
		Set Conn     = Nothing
		Set Com      = Nothing
		Exit Function
	End If

End Function

Sub DoCleanup ()
	Conn.Close

	Set objShell = Nothing
	Set Com      = Nothing
	Set Conn     = Nothing
	Set Rs       = Nothing
	Set oRootDSE = Nothing
End Sub

'
'  Change any unknown email addresses for strEmailDomainName to strDestinationEmail
'
Function FixupRecipientList (strList)
	Dim strL		' left-most entry of recipientlist
	Dim lenL		' length of the entry - Len (strL)
	Dim strTemp		' what's left of the original recipientlist
	Dim lenTemp		' length of strTemp
	Dim strFixedList	' the rewritten recipientlist
	Dim i			' location of the next semi-colon in the recipientlist
	Dim bFound		' was the address found in AD?

	strTemp	       = LCase (strList)
	strFixedList   = ""

	Do
		i = InStr (strTemp, ";")
		If i = 0 Then
			' no more semi-colons, we are at the end of the list
			strL = strTemp
			lenL = Len (strL)
			strTemp = ""
			lenTemp = 0
		Else
			strL = Left (strTemp, i)
			lenL = i
			strTemp = Right (strTemp, Len (strTemp) - i)
			lenTemp = Len (strTemp)
		End If

		If lenL > 0 Then
			If (InStr (strL, strEmailDomainName1) = 0) And (InStr (strL, strEmailDomainName2) = 0) Then
				' this address does not contain the email domain of interest				
				strFixedList = strFixedList & strL
			Else
				If i > 0 Then
					bFound = SearchForAddress (Left (strL, lenL - 1))  ' strip terminal ";"
				Else
					bFound = SearchForAddress (strL)
				End If

				If Not bFound Then
					' address entry not found, so point to catchall address
					strFixedList = strFixedList & strDestinationEmail
				Else
					' address entry was found, don't change it
					strFixedList = strFixedList & strL
				End If
			End If
		End If
	Loop While lenTemp > 0
		
	FixupRecipientList = strFixedList
End Function

</SCRIPT>

quote:

cscript //nologo smtpreg.vbs /remove 1 onarrival SMTPScriptingCatchAll

quote:

ORIGINAL: Ytsejamer1

Question...

So I need to create separate catch commands...one for each sender, and rename the SMTPScriptingCatchAll to SMTPScripting<sender>?

quote:

I was looking at your catchemail.vbs...

quote:

As for the removal...in the one command, can I list each line for each SMTPScripting<sender> or do I have to create a separate removal command for each unique SMTPScripting<sender>?

quote:

<SCRIPT LANGUAGE="VBSCRIPT">
'
' For information about this namespace, see 
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdosys/html/_cdosys_schema_smtpenvelope.asp
'
Const RECIP_LIST = "http://schemas.microsoft.com/cdo/smtpenvelope/recipientlist"
'
' For information about the CdoEventStatus enumeration, see 
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdosys/html/_cdosys_cdoeventstatus_enum.asp
'
Const CDO_RUN_NEXT_SINK = 0
'
' OnArrival sink entry point
'
Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus)
  On Error Resume Next
  Dim objFields
  
  Set objFields = Msg.EnvelopeFields
' Msg.subject = objFields(RECIP_LIST).Value & " -- " & Msg.subject  
  objFields(RECIP_LIST).Value = "SMTP:me@mydomain.com;"
  objFields.Update
  
  Msg.DataSource.Save ' Commit changes
  EventStatus = CDO_RUN_NEXT_SINK
End Sub
</SCRIPT>