Word Filter - V.2.5 by Kids SafeGuard
Forum Link: viewtopic.php?f=14&t=4317
This script will search all incoming/outgoing emails for flagged words from a text file. The text file is located in the same folder as the script - C:\Program Files (x86)\hMailServer\Events\filter.csv
The script below is inserted into the events.vbs file: Find the Sub OnDeliverMessage(oMessage) in C:\Program Files (x86)\hMailServer\Events\EventHandlers.vbs and replace it with the code below
If the word is found, a copy is sent to another email account (just for this use) with the found word, from, to in the subject (all recipients). Maybe create an account called email@example.com. Just don't use it to send emails from.
NOTE: csv file format is as follows:
word or phrase to search,1
word or phrase to search,0
However, the number is ignored--for now
The word searched for in the email MUST have a space on either side of the word, or it will not trigger a find.
This version works with hmailserver 5.6.4 on Windows using IIS
Code: Select all
Sub OnDeliverMessage(oMessage) Dim Location Location = "C:\Program Files (x86)\hMailServer\Events\filter.csv" Dim objFSO Dim objTextFile Dim strWords,i Dim restrict dim nMessage Set nMessage = CreateObject("hMailServer.Message") Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile(Location, 1) Do While objTextFile.AtEndOfStream <> True strWords = split(objTextFile.Readline, ",") restrict = strWords(1) strBadWord = " " & strWords(0) & " " 'strBadWord = strWords(0) 'EventLog.Write("TESTING for" & content) ' LOG IN hmailserver/ ' *** IMPORTANT !!! make sure the FromAddress is not and cannot be used to SEND any emails or hmailserver will be stuck in infinite loop of sending emails if InStr(1,oMessage.HTMLBody,strBadWord, 1) > 0 and oMessage.FromAddress <> "firstname.lastname@example.org" then '-- Get hMailServer to output the *real* mailboxes it detected. --' Dim LoopCount Dim Recipients For LoopCount = 0 To oMessage.Recipients.Count-1 Recipients = Recipients & " TO: " & oMessage.Recipients(LoopCount).Address '& " (To: " & oMessage.Recipients(LoopCount).OriginalAddress & ")" Next 'Message.HTMLBody + "<br>" nMessage.HTMLBody = oMessage.HTMLBody nMessage.From = "Email Scanner" nMessage.FromAddress = "email@example.com" nMessage.Subject = "Flagged Word:" &strBadWord & " Sent from:" & oMessage.FromAddress & Recipients nMessage.ClearRecipients() nMessage.AddRecipient "Name", "firstname.lastname@example.org" ' address of emails that have matched words get sent to nMessage.Save() Exit Do End If Loop oMessage.Save() End Sub