SCL auswerten und verarbeiten

Alle Skripte sind Muster ohne jede Gewährleistung oder Funktionsgarantie. für Schäden bin ich nicht verantwortlich. Achten Sie auf Zeilenumbrüche bei der Übernahme.

Quelle: Exchange BLOG (http://blogs.msdn.com/exchange/archive/2004/05/26/142607.aspx), Autor: Peter Suba

Mit dem Einsatz des Intelligent Message Filter werden Nachrichten mit einem SCL-Wert versehen. Dieser kann in Outlook oder OWA angezeigt werden oder für eigene weitere Verarbeitungen genutzt werden.

Um diese Script zu aktivieren müssen Sie auf dem Exchange Server den "EventService" aktiviert haben und das Script auf dem jeweiligen Ordner einrichten. Siehe Exchange Skripting.

<SCRIPT RunAt=Server Language=VBScript>

'------------------------------------------------------------------------------
'
' NAME: Move spam messages
'
' FILE DESCRIPTION: Automatically move and tag incomming messages
' according to the settings below
'
' Copyright (c) Peter Suba 2004. subap@eol.hu All rights reserved.
'
' Portions:
' Copyright (c) CdoLive 1999. All rights reserved.
' Http://www.cdolive.com
' samples@cdolive.com
'
' Copyright (c) Microsoft Corporation 1993-1997. All rights reserved.
'
'------------------------------------------------------------------------------

Option Explicit

'------------------------------------------------------------------------------
' Global Variables
'------------------------------------------------------------------------------

Dim g_bstrDebug ' Debug String

'------------------------------------------------------------------------------
' CONSTANTS
'------------------------------------------------------------------------------



' Configuration constants

Const EOL_MoveAboveSCL = 5 ' Move messages that are above this SCL
Const EOL_TagAboveSCL = 3 ' Tag messages that are above this SCL (will only work if set to lower than above set parameter!)
Const EOL_TagMoved = TRUE ' Set to true if you want to tag also message that are moved
Const EOL_TagPrefix = "**** Spam LIKELIHOOD: %SCL%/10 **** " 'Set für tag prefix: %SCL% will be replaced by SCL value assigned to message
Const EOL_MoveToSubfolder = "Junk mail" ' Moved messages will be transfered to this folder


' MAPI property tags used in this script

Const CdoPR_SCL = &H40760003 'PT_I4 (PT_MV_I4) - reméljük stimmel


'------------------------------------------------------------------------------
' EVENT HANDLERS
'------------------------------------------------------------------------------

' DESCRIPTION: This event is fired when a new message is added to the folder
Public Sub Folder_OnMessageCreated

' Declare variables
Dim objSession ' Session
Dim objFolder ' Current folder
Dim objJunkFolder ' Junk mail folder
Dim objCurrentMsg ' Current message
Dim mSCL
Dim strPrefix
Dim objMovedMsg ' Moved message
Dim strFolderID
Dim strStoreID

' Initialize variables
Set objSession = Nothing
Set objFolder = Nothing
Set objCurrentMsg = Nothing
Set objJunkFolder = Nothing


' Clear error buffer
Err.Clear

' Get session informationen
On Error Resume Next
Set objSession = EventDetails.Session

' No errors detected ?
If Err.Number = 0 Then

' Get current message
Err.Clear
On Error Resume Next
Set objCurrentMsg = objSession.GetMessage(EventDetails.MessageID,Null)

' Error detected ?
If Err.Number <> 0 Then

' Error reading current message
Call DebugAppend("Error - Could not read message", True)
Else
mSCL = objCurrentMsg.Fields(CdoPR_SCL)
If mSCL>EOL_MoveAboveSCL Then ' Move message to subfolder
If EOL_TagMoved Then
strPrefix=Replace(EOL_TagPrefix,"%SCL%",CStr(mSCL))
objCurrentMsg.Subject = strPrefix & objCurrentMsg.Subject
objCurrentMsg.Update
End If
Set objFolder = objSession.GetFolder(objCurrentMsg.FolderID,objCurrentMsg.StoreID)
Set objJunkFolder = objFolder.Folders(EOL_MoveToSubfolder)
If Err Then 'If the folder does not yet exist then create it
Call DebugAppend("Error - get junk mail folder - creating it", True)
Set objJunkFolder = objFolder.Folders.Add(EOL_MoveToSubfolder)
Err.clear
Else
If objJunkFolder.Name <> EOL_MoveToSubfolder Then
Call DebugAppend("Error - get junk mail folder (got:<"&objJunkFolder.Name&">) - creating it", False)
Set objJunkFolder = objFolder.Folders.Add(EOL_MoveToSubfolder)
End If
End If
If objJunkFolder.Name = EOL_MoveToSubfolder Then
strFolderID = objJunkFolder.ID
strStoreID = objJunkFolder.StoreID
objCurrentMsg.MoveTo strFolderID, strStoreID
End If
Else
If mSCL>EOL_TagAboveSCL Then 'Tag message
strPrefix=Replace(EOL_TagPrefix,"%SCL%",CStr(mSCL))
objCurrentMsg.Subject = strPrefix & objCurrentMsg.Subject
objCurrentMsg.Update
End If
End If
End If
Else

' Write some logging
Call DebugAppend("Junk - undefinied Error detected", True)
End If

' Write some logging

' Clear objects
Set objSession = Nothing
Set objFolder = Nothing
Set objCurrentMsg = Nothing
Set objJunkFolder = Nothing

' Write results to the Scripting Agent log
Script.Response = g_bstrDebug

End Sub

' DESCRIPTION: This event is fired when a message in the folder is changed
Public Sub Message_OnChange
End Sub

' DESCRIPTION: This event is fired when a message is deleted from the folder
Public Sub Folder_OnMessageDeleted
End Sub

' DESCRIPTION: This event is fired when the timer on the folder expires
Public Sub Folder_OnTimer
End Sub

'-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
' PRIVATE FUNCTIONS/SUBS
'-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

'------------------------------------------------------------------------------
' Name: DebugAppend
' Area: Debug
' Desc: Simple Debugging Function
' Parm: String Text, Bool ErrorFlag
'------------------------------------------------------------------------------

Private Sub DebugAppend(bstrParm,boolErrChkFlag)
If boolErrChkFlag = True Then
If Err.Number <> 0 Then
g_bstrDebug = g_bstrDebug & bstrParm & " - " & cstr(Err.Number) & " " & Err.Description & vbCrLf
Err.Clear
End If
Else
g_bstrDebug = g_bstrDebug & bstrParm & vbCrLf
End If
End Sub

</SCRIPT>

Dieses Script kann ihnen als Vorlage für eigene Anpassungen dienen.

Weitere Links