This code allows a company with Lotus Notes also running an open-source anti-spam appliance w/ Mailscanner (eg. ESVA) to mark documents as spam using the Mailscanner header fields. It removes the need to have the "Report this message as spam" link at the bottom of e-mails. (Bad problem as that link is often in the e-mail replies.)
Customize the code for your environment:
Option Public
Option Declare
Sub Initialize
Dim w As New NotesUIWorkspace
Dim s As New NotesSession
Dim db As NotesDatabase ' current db
Dim mUI As NotesUIDocument ' memo front-end
Dim vUI As NotesUIView ' current view
Dim dc As NotesDocumentCollection ' documents selected in view
Dim mDoc As NotesDocument ' memo back-end
Dim svrLst() As String ' array for list of mail gateways to match for submitting
Dim spamcount As Long ' number of spam reported
' setup environment
' ********** modify next lines for environment *************
ReDim svrLst(1)
svrLst(0) = "mail1.mindwatering.com"
svrLst(1) = "mail2.mindwatering.com"
' **********************************************************
Set db = s.Currentdatabase
Set mUI = w.CurrentDocument
Set vUI = w.CurrentView
If Not (mUI Is Nothing) Then
' a doc is currently open, verify doc is not new
If (mUI.IsNewDoc) Then
' check for selected document in view instead
Print "Cancelled. New memo - invalid action."
Exit Sub
End If
' get back-end doc
Set mDoc = mUI.Document
End If
' check for document, if doesn't exist, assume in view rather than memo and get any selected docs
If Not (mDoc Is Nothing) Then
' act on open memo
spamcount = spamcount + DoSpamKill(w, mDoc, svrLst())
Else
' act on selected doc(s)
Set dc = vUI.Documents
Set mDoc = dc.GetFirstDocument()
If Not (mDoc Is Nothing) Then
' multiple docs selected/checked, process them
While Not (mDoc Is Nothing)
spamcount = spamcount + DoSpamKill(w, mDoc, svrLst())
Set mDoc = dc.GetNextDocument (mDoc)
Wend
Else
' no document selected, however one is probably highlighted, get it
Set mDoc = db.GetDocumentByID(vUI.CaretNoteID)
If Not (mDoc Is Nothing) Then
' process the highlighted memo
spamcount = spamcount + DoSpamKill(w, mDoc, svrLst())
Else
' tried all and no doc was selected
Print "No e-mails/memos to submit. Done."
Exit Sub
End If
End If
End If
' done
Print "Submitted " & CStr(spamcount) & " e-mails as spam. Done."
Exit Sub
ErrorHandler:
Print "(Initialize) Unexpected Error: " & CStr(Err) & ", " & Error$ & ", on line: " & CStr(Erl) & "."
Exit Sub
End Sub
%REM
Function DoSpamKill
Description: checks for the id and server, builds url and submits call to delete spam
%END REM
Function DoSpamKill(w As NotesUIWorkspace, mDoc As NotesDocument, svrLst() As String) As Integer
' mDoc - current memo being submitted
' svrLst - array of servers to match in the Received field
Dim msgItem As NotesItem ' message id field in header
Dim svrItem As NotesItem ' received field(s), one (first) contains mail gateway
Dim msgid As String ' message id
Dim svrstr As String ' whole server line in received field to parse server name
Dim svrnm As String ' the fqdn of the server parsed from svrstr
Dim urlstr As String ' full url to submit current memo as spam.
' verify doc passed exists
If (mDoc Is Nothing) Then
Print "No document passed. Cancelled."
DoSpamKill=0
Exit Function
End If
' check for spam field of incoming doc (can also be in a reply w/history)
'X_Mindwatering_MailScanner_ESVA_ID
Set msgItem = mDoc.GetFirstItem("X_MYDOMAIN_MailScanner_ESVA_ID")
If (msgItem Is Nothing) Then
Print "No e-mail ID field from mail gateway in memo with subject: " & mDoc.Subject(0) & ". Internal mail. Skipped."
DoSpamKill=0
Else
msgid = msgItem.Text
End If
' verify id exists in field
If (msgid="") Then
' no id, give up (should never happen if exists, but check anyway)
Print "No e-mail ID in ID field for mail gateway in memo with subject: " & mDoc.Subject(0) & ". Error. Skipped."
DoSpamKill=0
Exit Function
End If
' get server
Set svrItem = mDoc.Getfirstitem("Received")
If (svrItem Is Nothing) Then
' cannot continue
Print "Missing server field that sent memo with subject: " & mDoc.Subject(0) & ". Error. Skipped."
DoSpamKill=0
Exit Function
End If
' get just the server name
' example line: "from mail1.mindwatering.com ([192.168.2.216]) ...
svrstr = svrItem.Text
svrnm = FullTrim(StrLeft(StrRight(svrstr, "from", 5), "([", 5))
' build url, format:
' http://mail1.mindwatering.com/cgi-bin/learn-msg.cgi?id=B142B27EFA.53943
urlstr = "http://" & svrnm & "/cgi-bin/learn-msg.cgi?id=" & msgid
Call w.URLOpen( urlstr)
FExit:
Exit Function
FErrorHandler:
Print "(DoSpamKill) Unexpected Error: " & CStr(Err) & ", " & Error$ & ", on line: " & CStr(Erl) & "."
Resume FExit
End Function
previous page
|