Exposing SCL (Spam Confidence Level) in Outlook

Hello,

I have written an agent script which installed to a public folder (or an inbox folder) makes it possible to create a junk mail folder aswell. It has several parameters, and also allows you to tag the message subject if you want to. Here it is:


<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
' Mailto: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 for 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>