Rules And Scripts

paultilley100 · Post by **paultilley100** » 2018-11-23 00:25

Firstly, Im sorry this is quite vague..... I can supply whatever info is needed once I have been advised/pointed in the right direction.

I have a rule setup which if the subject contains a string, it should run a function. This rule is at position 4.
Turning on the logging shows that this particular rule does indeed run.

I dont know if the function itself is running - how could I tell this?
It should alter the subject of the message - I dont think that the function itself is a problem, but I am including it here for reference.

Code: Select all

Sub SubjectAlterAddSpam(oMessage)
	oMessage.Subject = "[SPAMRULES] " & oMessage.Subject
	oMessage.Save
End Sub

Any Ideas?

Many Thanks

jimimaseye · Post by **jimimaseye** » 2018-11-23 00:38

Heres an idea:

Sub SubjectAlterAddSpam(oMessage)
eventlog.write(now() & " AlterSubject sub called" )
oMessage.Subject = "[SPAMRULES] " & oMessage.Subject
oMessage.Save
End Sub

Also, enable DEBUG and you will see RULES being "applied".

Ensure the rule is

ACTION:
"Run Function" - "SubjectAlterAddSpam"

paultilley100 · Post by **paultilley100** » 2018-11-23 00:40

I will add the eventlog.write(now() & " AlterSubject sub called" ) now.

The debug log does show that this rule is being applied.

Thanks for your input.

paultilley100 · Post by **paultilley100** » 2018-11-23 01:01

Ok, confused....Where should the eventlog.write be - is it the standard Windows Event Viewer.... If so, where?

The rule 'Spam Detection' does appear to be running though.

"APPLICATION" 1824 "2018-11-22 22:44:59.375" "SMTPDeliverer - Message 4129537: Delivering message from peter@wigvillage.com to emailaddress@removeddomain.co.uk. File: R:\hMail\Data\{565F9EFF-E0C9-47A5-86C9-57D0CA4F4336}.eml"
"DEBUG" 1824 "2018-11-22 22:44:59.375" "Running custom virus scanner..."
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Scanner: "C:\Program Files\ESET\ESET File Security\ecls.exe" /log-file=R:\hMail\EsetLogs\esetlog.txt /aind R:\hMail\Data\{565F9EFF-E0C9-47A5-86C9-57D0CA4F4336}.eml. Return code: 0"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rules"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rule Spam Report Route"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rule Immediate Delete"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rule Divert To Postfix Bulk"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rule Spam Detection"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rule Spectrum Back Scatter"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Performing local delivery"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Applying rules"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Forwarding message"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Copying mail contents"
"DEBUG" 1824 "2018-11-22 22:45:04.143" "Saving message: {D4BD6E10-53D0-4658-B782-06B4477D5F50}.eml"
"DEBUG" 1824 "2018-11-22 22:45:04.159" "Local delivery completed"
"DEBUG" 1824 "2018-11-22 22:45:04.159" "Deleting message"
"DEBUG" 1824 "2018-11-22 22:45:04.159" "Deleting message file."
"APPLICATION" 1824 "2018-11-22 22:45:04.159" "SMTPDeliverer - Message 4129537: Message delivery thread completed."

mattg · Post by **mattg** » 2018-11-23 01:04

If the rule triggers, is the subject not being changed?

Is this an account level rule, or a global rule?
What rules happen after this rule is triggered

mattg · Post by **mattg** » 2018-11-23 01:06

paultilley100 wrote: ↑
2018-11-23 01:01
Ok, confused....Where should the eventlog.write be

In the hmailserver logs folder

paultilley100 wrote: ↑
2018-11-23 01:01
The rule 'Spam Detection' does appear to be running though.

agreed

can you show the rule please

paultilley100 · Post by **paultilley100** » 2018-11-23 01:07

Nope - subject remains unaltered.

Its a global rule.

The only other rule is a delete rule to remove some backscatter.

paultilley100 · Post by **paultilley100** » 2018-11-23 01:09

paultilley100 · Post by **paultilley100** » 2018-11-23 01:22

Think I may have a possibility....
My rule checks the subject line for a string 'You are my victim'
Looking at the raw email its utf8 encoded.

Does that mean that hMail wont see the string in clear text, and therefore the rule fails?

X-LCID: 4254148
Received: from [(194.58.58.14)] by xeams.mspportal with Spam Filtering System SMTP; Thu, 22 Nov 2018 21:56:18 +0000 (GMT)
X-SM_EnvelopeFrom: peter@wigvillage.com
X-SMRecipient: MY EMAIL ADDRESS IS REMOVED
X-SMDestinationServer: 192.168.1.25
X-SM_Proxy: true
X-SM_RECEIVED_ON: Thu, 22 Nov 2018 21:56:18 +0000 (GMT)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; s=mail; d=wigvillage.com;
h=Message-ID:From:To:Subject:Date:MIME-Version:Content-Type; i=Peter@wigvillage.com;
bh=CfkTvjDC6RcAD5k3MDec0nK0BBS7hSRBAcBXYUW/JFw=;
b=H4qL97AimE1WpqP9JJuwcGNfhO3j/Wkm2XGEUT9R8C+3tFzxL8b1lGAbQBHJtztvizXQfhAmNkW0
mNR5pZe1o578z0bhXe8BjGoPDv0dxDm8agrApyPDuALsj7uZE8S/calYJLlNB0YjcgpwOZVumR7i
0TTu8noMIUYf1/DK9N8=
Message-ID: <800148e32a9eb4bc5055e34fa94d6769a9460a@wigvillage.com>
From: "Ws" <Peter@wigvillage.com>
To: <MY EMAIL ADDRESS IS REMOVED>
Subject: =?utf-8?B?WW91IGFyZSBteSAgdmnRgXRpbS4=?=
Date: Fri, 23 Nov 2018 00:46:10 +0300
MIME-Version: 1.0
Content-Type: multipart/alternative; boundary="201950fb3286aca4484dfb57b1557f71b4a583"

--201950fb3286aca4484dfb57b1557f71b4a583
Content-Type: text/plain; charset="utf-8"
Content-Transfer-Encoding: quoted-printable

Hi, my prey.

THIS IS MY L=D0=90ST W=D0=90RNING!
I writ=D0=B5 y=D0=BEu be=D1=81aus=D0=B5 I att=D0=B0ch=D0=B5d a virus =D0=BE=
n th=D0=B5 web site with porno whi=D1=81h y=D0=BEu h=D0=B0ve visit=D0=B5d=
.
My tr=D0=BEjan =D1=81a=D1=80tured =D0=B0ll y=D0=BEur priv=D0=B0te d=D0=B0=
ta =D0=B0nd switched =D0=BEn y=D0=BEur c=D0=B0mer=D0=B0 whi=D1=81h r=D0=B5=
c=D0=BErded th=D0=B5 act of your s=D0=BElit=D0=B0ry s=D0=B5x. Just =D0=B0=
fter th=D0=B0t the troj=D0=B0n saved your =D1=81=D0=BEnt=D0=B0=D1=81t lis=
t.
I will er=D0=B0se th=D0=B5 com=D1=80r=D0=BEmising video r=D0=B5=D1=81ords=
=D0=B0nd inf=D0=BErmati=D0=BEn if you s=D0=B5nd m=D0=B5 500 EURO in bitc=
oin.
This is address f=D0=BEr =D1=80=D0=B0yment :=C2=A0 1E4Jnnodm52gCJJjS7YJ5m=
63eyjGWFqzF

I give you 30 hours =D0=B0fter y=D0=BEu =D0=BEpen my m=D0=B5ssag=D0=B5 f=D0=
=BEr m=D0=B0king the =D1=80ayment.
=D0=90s s=D0=BEon as you re=D0=B0d the mess=D0=B0ge I'll see it right awa=
y.
It is n=D0=BEt n=D0=B5=D1=81=D0=B5ssary t=D0=BE t=D0=B5ll m=D0=B5 th=D0=B0=
t y=D0=BEu have s=D0=B5nt m=D0=BEney to me. This =D0=B0ddress is c=D0=BEn=
nect=D0=B5d to y=D0=BEu, my system will eras=D0=B5d =D0=B0utom=D0=B0tic=D0=
=B0lly aft=D0=B5r tr=D0=B0nsf=D0=B5r confirm=D0=B0tion.
If y=D0=BEu n=D0=B5ed 48h just Open the c=D0=B0lculat=D0=BEr on your d=D0=
=B5sktop and =D1=80r=D0=B5ss +++
If you don't =D1=80=D0=B0y, I'll send dirt t=D0=BE all your =D1=81=D0=BEn=
ta=D1=81ts.=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0
Let m=D0=B5 r=D0=B5mind y=D0=BEu-I s=D0=B5e what you're doing!
Y=D0=BEu =D1=81an visit the poli=D1=81e =D0=BEffi=D1=81e but =D0=B0nyb=D0=
=BEdy =D1=81an't help you.
If you try to dec=D0=B5ive me , I'll kn=D0=BEw it imm=D0=B5diately!
I don't live in your =D1=81ountry. So any=D0=BEn=D0=B5 =D1=81=D0=B0n n=D0=
=BEt tr=D0=B0ck my l=D0=BE=D1=81=D0=B0tion even for 9 m=D0=BEnths.
bye. D=D0=BEn't f=D0=BErg=D0=B5t ab=D0=BEut the shame =D0=B0nd t=D0=BE ig=
n=D0=BEr=D0=B5, Y=D0=BEur life can be ruin=D0=B5d.

_________________________________________________________________________=
___________________

--201950fb3286aca4484dfb57b1557f71b4a583
Content-Type: text/html; charset="utf-8"
Content-Transfer-Encoding: quoted-printable

<HTML><HEAD>
<META http-equiv=3D"Content-Type" content=3D"text/html; charset=3Dutf-8">
</HEAD>
<BODY bgColor=3D#ffffff>
<DIV>Hi, my prey.</DIV>
<DIV> </DIV>
<DIV>THIS IS MY L=D0=90ST W=D0=90RNING!<BR> <BR>I writ=D0=B5=20
y=D0=BEu be=D1=81aus=D0=B5 I=20
att=D0=B0ch=D0=B5d a virus =D0=BEn th=D0=B5=20
web site with porno whi=D1=81h=20
y=D0=BEu h=D0=B0ve visit=D0=B5d.<BR>My tr=D0=BEjan=20
=D1=81a=D1=80tured =D0=B0ll y=D0=BEur=20
priv=D0=B0te d=D0=B0ta =D0=B0nd=20
switched =D0=BEn y=D0=BEur=20
c=D0=B0mer=D0=B0 whi=D1=81h=20
r=D0=B5c=D0=BErded th=D0=B5 act=20
of your s=D0=BElit=D0=B0ry s=D0=B5x. Just=20
=D0=B0fter th=D0=B0t the troj=D0=B0n=20
saved your =D1=81=D0=BEnt=D0=B0=D1=81t=20
list.<BR>I will er=D0=B0se th=D0=B5=20
com=D1=80r=D0=BEmising video=20
r=D0=B5=D1=81ords =D0=B0nd inf=D0=BErmati=D0=BEn=20
if you s=D0=B5nd m=D0=B5=20
500=20
EURO in bitcoin.<BR> <BR>This is address=20
f=D0=BEr =D1=80=D0=B0yment : =20
1E4Jnnodm52gCJJjS7YJ5m63eyjGWFqzF</DIV>
<DIV> </DIV>
<DIV>I give you 30 hours =D0=B0fter=20
y=D0=BEu =D0=BEpen my m=D0=B5ssag=D0=B5=20
f=D0=BEr m=D0=B0king the=20
=D1=80ayment.<BR>=D0=90s s=D0=BEon as=20
you re=D0=B0d the mess=D0=B0ge=20
I'll see it right away.<BR>It is n=D0=BEt=20
n=D0=B5=D1=81=D0=B5ssary t=D0=BE t=D0=B5ll m=D0=B5=20
th=D0=B0t y=D0=BEu have s=D0=B5nt m=D0=BEney=20
to me. This =D0=B0ddress is=20
c=D0=BEnnect=D0=B5d to y=D0=BEu, my=20
system will eras=D0=B5d=20
=D0=B0utom=D0=B0tic=D0=B0lly aft=D0=B5r=20
tr=D0=B0nsf=D0=B5r confirm=D0=B0tion.<BR>If=20
y=D0=BEu n=D0=B5ed 48h just Open=20
the c=D0=B0lculat=D0=BEr on=20
your d=D0=B5sktop and =D1=80r=D0=B5ss=20
+++<BR>If you don't =D1=80=D0=B0y, I'll send dirt=20
t=D0=BE all your=20
=D1=81=D0=BEnta=D1=81ts.     =20
<BR>Let m=D0=B5 r=D0=B5mind y=D0=BEu-I s=D0=B5e=20
what you're doing!<BR>Y=D0=BEu=20
=D1=81an visit the poli=D1=81e=20
=D0=BEffi=D1=81e but =D0=B0nyb=D0=BEdy =D1=81an't=20
help you. <BR>If you try to=20
dec=D0=B5ive me , I'll kn=D0=BEw it=20
imm=D0=B5diately! <BR>I don't live in=20
your =D1=81ountry. So any=D0=BEn=D0=B5=20
=D1=81=D0=B0n n=D0=BEt tr=D0=B0ck my=20
l=D0=BE=D1=81=D0=B0tion even for 9=20
m=D0=BEnths.<BR>bye. D=D0=BEn't f=D0=BErg=D0=B5t=20
ab=D0=BEut the shame =D0=B0nd t=D0=BE=20
ign=D0=BEr=D0=B5, Y=D0=BEur life can be=20
ruin=D0=B5d.<BR> <BR> <BR> </DIV>
<DIV> </DIV>
<DIV>____________________________________________________________________=
________________________<BR></DIV></BODY></HTML>

--201950fb3286aca4484dfb57b1557f71b4a583--

mattg · Post by **mattg** » 2018-11-23 01:29

paultilley100 wrote: ↑
2018-11-23 01:22
Does that mean that hMail wont see the string in clear text, and therefore the rule fails?

That may well be correct

perhaps try with the UTF8 encoded subject line as another option

paultilley100 · Post by **paultilley100** » 2018-11-23 01:45

Ok so this gets slightly weirder.....

The raw subject is:
=?utf-8?B?WW91IGFyZSBteSAgdmnRgXRpbS4=?=

Stripping off the encoding leaves:
WW91IGFyZSBteSAgdmnRgXRpbS4=

Which can be Base64 decoded to be:
You are my victim.

I have put the string without the encoding ( WW91IGFyZSBteSAgdmnRgXRpbS4= ) into my rule, and used a 'Contains' in case it sees the bits ive stripped off.
Still it doesnt alter the subject.

I have sent an email from my yahoo account with the clear text subject 'You are my victim.' and everything works as expected....the subject IS altered.

So can the current hMail Rules not handle this situation in any way???

If that is the case, would passing every single email through a function that checks the subject at script level, bypass any limitations of hMail itself?
Or would I still get the same result?

I dont like this idea much, as my list of subjects to look for is constantly changing, and its easier to do it at hMail Administrator level in the GUI, rather than constantly changing the script.

Also, passing every email through the function regardless seems to be a cpu intensive way of dealing with things.

I have also checked my text above as much as I can.... but I apologise for any typos.
My letter o on my keyboard seems to be giving up.... when I typed account just now..... well lets just say Im glad I re-read it!!!!!

SorenR · Post by **SorenR** » 2018-11-23 02:03

hMailServer will automatically translate headers to cleartext ... UNLESS ... you use "oMessage.EncodeFields = False" in a script ! Then you get the RAW text.

paultilley100 · Post by **paultilley100** » 2018-11-23 02:06

Soren.... Thats NOT what Im seeing though....its the reverse.

The email is encoded... my rule looks for clear text in the global rule field 'Contains', and I DONT get a match.

SorenR · Post by **SorenR** » 2018-11-23 02:30

paultilley100 wrote: ↑
2018-11-23 02:06
Soren.... Thats NOT what Im seeing though....its the reverse.

The email is encoded... my rule looks for clear text in the global rule field 'Contains', and I DONT get a match.

That's weird...

I favor scripting before rules

paultilley100 · Post by **paultilley100** » 2018-11-23 18:12

Ok, so I know this should now be in the scripting forum, but if other have suggestions on how to do it without the below possibility, then I would like to hear it.

If the preference would be to pass every message through a script which checks the raw subject in order to trap these emails, can I make the function check an external text/ini file.
Perhaps read each line from the ini file into an array and process the email against the array.

That way it would only be an txt file to alter with additional subjects.
I just dont want my colleagues to have to alter the script directly.

If this is the way to go, then I need some pointers.... Im a dated VB6 developer, so should be able to keep up

I will open a new topic in the scripting forum to continue this if this is the best method.

Many thanks

SorenR · Post by **SorenR** » 2018-11-29 15:48

paultilley100 wrote: ↑
2018-11-23 18:12
If this is the way to go, then I need some pointers.... Im a dated VB6 developer, so should be able to keep up
I will open a new topic in the scripting forum to continue this if this is the best method.

Many thanks

hMailServer have the option to run a script, either VBScript or JScript that will use the COM API to extend the functionality of hMailServer.

If you know VB6 then you are already 90% there...

Load up hMailServer Administrator, go to "Settings" -> "Advanced" -> "Scripts" and select VBScript or JScript and click enable.
Script (EventHandlers.vbs) is located in [hMailServer]\Events

I'm attaching a sample script for you to use or pick from. You'll be able to find most of it hidden somewhere in my own or other peoples posts in the forum anyways

COM API is described in [hMailServer]\Bin\hMailServer.tlb
https://www.hmailserver.com/documentati ... om_objects

NOTE 1:
"Sub On...(...)" are hMailServer triggers.

NOTE 2:
"' **********" comments describe what is happening between the triggers in terms of mail processing.

NOTE 3:
Function Wait() is a bit tricky. Depending on your OS there are different ways to "Sleep". As hMailServer only includes the script interpretor, some shell dependant functions do not work. "Sleep" is one of them.

EventHandlers.vbs :

Code: Select all

Option Explicit

'******************************************************************************************************************************
'********** Settings                                                                                                 **********
'******************************************************************************************************************************

'   COM authentication
'
Private Const ADMIN = "Administrator"
Private Const PASSWORD = "VERY SECRET PASSWORD"

'   In the folloging IP address "123.123.123.123" refers to your public IP address.
'   In the following domain "acme.inc" refers to your MX domain.
'
'******************************************************************************************************************************
'********** Classes                                                                                                  **********
'******************************************************************************************************************************

Class LogWriter
   Private m_oApp, m_LogID, m_LogFile, m_LogType, m_LogDir
   Private i, t, temp, strDay, strMonth, strTime, strLogFile, strLogDate

   Private Sub Class_Initialize()
      Set m_oApp = CreateObject("hMailServer.Application")
      Call m_oApp.Authenticate(ADMIN, PASSWORD)
      m_LogFile = "LogWriter"
      m_LogType = "M"
      m_LogDir = m_oApp.Settings.Directories.LogDirectory
      m_LogID = CStr(m_oApp.Status.ProcessedMessages)
   End Sub

   Private Sub Class_Terminate()
      '   Termination code goes here.
   End Sub

   Public Property Let LogFile(strFile)
      m_LogFile = Trim(strFile)
   End Property

   Public Property Let LogDir(strDir)
      If Right(strDir, 1) = "\" Then
         m_LogDir = Trim(Left(strDir, Len(strDir) - 1))
      Else
         m_LogDir = Trim(strDir)
      End If
   End Property

   Public Property Let LogType(strType)
      m_LogType = Trim(strType)
   End Property

   Public Function Wait(sec)
      With CreateObject("WScript.Shell")
         .Run "timeout /T " & Int(sec), 0, True
'        .Run "sleep -m " & Int(sec * 1000), 0, True
'        .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
      End With
   End Function

   Public Function OpenFile(strPath)
      Const Append = 8
      Const Unicode = -1
      With CreateObject("Scripting.FileSystemObject")
         Dim oFile
         For i = 0 To 30
            On Error Resume Next
            Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
            If Not (Err.Number = 70) Then
               Set OpenFile = oFile
               On Error Goto 0
               Exit For
            End If
            On Error Goto 0
            Wait(1)
         Next
      End With
      If (Err.Number = 70) Then
         EventLog.Write( "ERROR: VBScript Class LogWriter" )
         EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
         Err.Clear
      ElseIf (Err.Number <> 0) Then
         EventLog.Write( "ERROR: VBScript Class LogWriter : Function OpenFile" )
         EventLog.Write( "Error       : " & Err.Number )
         EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
         EventLog.Write( "Source      : " & Err.Source )
         EventLog.Write( "Description : " & Err.Description )
         Err.Clear
      End If
   End Function

   Public Function Write(strText)
      t = Timer
      temp = Int(t)
      strMonth = DatePart("yyyy",Date) & "-" & Right("0" & DatePart("m",Date), 2)
      strDay = strMonth & "-" & Right("0" & DatePart("d",Date), 2)
      strTime = Right("0"  & Hour(Now),   2) & ":" &_
                Right("0"  & Minute(Now), 2) & ":" &_
                Right("0"  & Second(Now), 2) & "." &_
                Right("00" & (Int((t-temp) * 1000)), 3)
      strLogDate = strDay & " " & strTime
      If (m_LogType = "M") Then
         strLogFile = m_LogDir & "\" & m_LogFile & "_" & strMonth & ".log"
      Else
         strLogFile = m_LogDir & "\" & m_LogFile & "_" & strDay & ".log"
      End If
      With OpenFile(strLogFile)
         .WriteLine(m_LogID & vbTab & Chr(34) & strLogDate & Chr(34) & vbTab & Chr(34) & strText & Chr(34))
         .Close
      End With
      Write = Err.Number
   End Function

End Class

'******************************************************************************************************************************
'********** Functions                                                                                                **********
'******************************************************************************************************************************

Function Wait(sec)
   With CreateObject("WScript.Shell")
      .Run "timeout /T " & Int(sec), 0, True
'     .Run "sleep -m " & Int(sec * 1000), 0, True
'     .Run "powershell Start-Sleep -Milliseconds " & Int(sec * 1000), 0, True
   End With
End Function

Function LockFile(strPath)
   Const Append = 8
   Const Unicode = -1
   With CreateObject("Scripting.FileSystemObject")
      Dim oFile, i
      For i = 0 To 30
         On Error Resume Next
         Set oFile = .OpenTextFile(strPath, Append, True, Unicode)
         If Not (Err.Number = 70) Then
            Set LockFile = oFile
            On Error Goto 0
            Exit For
         End If
         On Error Goto 0
         Wait(1)
      Next
   End With
   If (Err.Number = 70) Then
      EventLog.Write( "ERROR: EventHandlers.vbs" )
      EventLog.Write( "File " & strPath & " is locked and timeout was exceeded." )
      Err.Clear
   ElseIf (Err.Number <> 0) Then
      EventLog.Write( "ERROR: EventHandlers.vbs : Function LockFile" )
      EventLog.Write( "Error       : " & Err.Number )
      EventLog.Write( "Error (hex) : 0x" & Hex(Err.Number) )
      EventLog.Write( "Source      : " & Err.Source )
      EventLog.Write( "Description : " & Err.Description )
      Err.Clear
   End If
End Function

Function Lookup(strRegEx, strMatch) : Lookup = False
   With CreateObject("VBScript.RegExp")
      .Pattern = strRegEx
      .Global = False
      .MultiLine = True
      .IgnoreCase = True
      If .Test(strMatch) Then Lookup = True
   End With
End Function

Function oLookup(strRegEx, strMatch, bGlobal)
   With CreateObject("VBScript.RegExp")
      .Pattern = strRegEx
      .Global = bGlobal
      .MultiLine = True
      .IgnoreCase = True
      Set oLookup = .Execute(strMatch)
   End With
End Function

Function LongIntegerFromIP(p_strIP)
   Dim arrTemp, i, lngTemp
   arrTemp = Split(p_strIP, ".")
   For i = 0 To UBound(arrTemp)
      lngTemp = lngTemp + CLng(arrTemp(i)) * (256 ^ (3 - i))
   Next
   LongIntegerFromIP = lngTemp
End Function

'   sType can be one of the following;
'   "yyyy" Year, "m" Month, "d" Day, "h" Hour, "n" Minute, "s" Second

Function AutoBan(sIPAddress, sReason, iDuration, sType) : AutoBan = False
   Dim oApp : Set oApp = CreateObject("hMailServer.Application")
   Call oApp.Authenticate(ADMIN, PASSWORD)
   With LockFile("c:\hmailserver\temp\autoban.lck")
      On Error Resume Next
      oApp.Settings.SecurityRanges.Refresh
      If (oApp.Settings.SecurityRanges.ItemByName("(" & sReason & ") " & sIPAddress) Is Nothing) Then
         With oApp.Settings.SecurityRanges.Add
            .Name = "(" & sReason & ") " & sIPAddress
            .LowerIP = sIPAddress
            .UpperIP = sIPAddress
            .Priority = 20
            .Expires = True
            .ExpiresTime = DateAdd(sType, iDuration, Now())
            .Save
         End With
         AutoBan = True
      End If
      oApp.Settings.SecurityRanges.Refresh
      On Error Goto 0
      .Close
   End With
End Function

'******************************************************************************************************************************
'********** Subroutines                                                                                              **********
'******************************************************************************************************************************

Sub XEnvelope(oMessage)
   Dim i, strEnvelope1, strEnvelope2
   For i = 0 To oMessage.Recipients.Count-1
      If (i = 0) Then
         strEnvelope1 = oMessage.Recipients(i).Address
         strEnvelope2 = oMessage.Recipients(i).OriginalAddress
      Else
         strEnvelope1 = strEnvelope1 & ", " & oMessage.Recipients(i).Address
         strEnvelope2 = strEnvelope2 & ", " & oMessage.Recipients(i).OriginalAddress
      End If
   Next
   oMessage.HeaderValue("X-Envelope-To") = strEnvelope1
   oMessage.HeaderValue("X-Envelope-OriginalTo") = strEnvelope2
   oMessage.HeaderValue("X-Envelope-From") = oMessage.FromAddress
   oMessage.Save
End Sub

Sub SPAMList(oMessage, strMatch)
   Dim i
   If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
      i = CInt(oMessage.HeaderValue("X-hMailServer-Reason-Score"))
   Else
      oMessage.HeaderValue("X-hMailServer-Spam") = "YES"
      i = 0
   End If
   oMessage.HeaderValue("X-hMailServer-Reason-0") = "SPAMlisted - (Score: 5)"
   oMessage.HeaderValue("X-hMailServer-Reason-Score") = 5 + i
   oMessage.HeaderValue("X-Blacklist-RegEx") = strMatch
   oMessage.Save
End Sub

Sub WhiteList(oMessage, strMatch)
   Dim i
   If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
      oMessage.HeaderValue("X-Whitelist-RegEx") = strMatch
      oMessage.Headers.ItemByName("X-hMailServer-Spam").Delete
      For i = 0 To 10
         If oMessage.HeaderValue("X-hMailServer-Reason-" & i) <> "" Then _
            oMessage.Headers.ItemByName("X-hMailServer-Reason-" & i).Delete
      Next
      oMessage.Headers.ItemByName("X-hMailServer-Reason-Score").Delete
      oMessage.Save
   End If
End Sub

'******************************************************************************************************************************
'********** hMailServer Triggers                                                                                     **********
'******************************************************************************************************************************

Sub OnClientConnect(oClient)
   Dim i, strRegEx, Match, Matches

   '   Filter out "impatient" servers. Alternative to GreyListing.
   If (oClient.Port = 25) Then Wait(20)

End Sub

'   NOTE: Sub OnHELO(oClient) is not in the official build (YET!)
'
'   https://www.hmailserver.com/forum/viewtopic.php?f=10&t=30193
'   User RvdH is maintaining an up-to-date version of hMailServer with amongst others the OnHELO trigger.
'
Sub OnHELO(oClient)
   Dim i, strRegEx, Match, Matches

   '   Exclude Backup-MX & local LAN from test
   '
   If (Left(oClient.IPAddress, 10) = "80.160.77.") Then Exit Sub
   If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub

   '   Filter out "impatient" servers. Alternative to GreyListing.
   If (oClient.Port = 25) Then Wait(20)

   '   FIX for known anomalities ...
   '
   strRegEx = "^(VVS-WEB)[0-9]{2}(\.localdomain)$|^(LouisesHuawei)$|^(LouisesEnvy)$"
   If Lookup(strRegEx, oClient.HELO) Then Exit Sub

   '   Deny servers with specific HELO/EHLO greetings
   '
   '   NOTE: "^(.*\.[a-z]{4,})$|" WILL FILTER OUT ANY 4+ LETTER TLD.
   '
   strRegEx = "^(\[123\.123\.123\.123\])$|" &_
              "^(acme\.inc)$|" &_
              "^(mx\.acme\.inc)$|" &_
              "^(.*\.[a-z]{4,})$|" &_
              "(0\.0\.0\.0)|" &_
              "(127(?:\.[0-9]{1,3}){3})"
   Set Matches = oLookup(strRegEx, oClient.HELO, False)
   For Each Match In Matches
      Result.Value = 2
      Result.Message = "5.7.1 CODE02 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."
      If AutoBan(oClient.IPAddress, "BLACKLIST - " & oClient.HELO, 7, "d") Then _
         EventLog.Write( "AutoBan(" & oClient.IPAddress & ", BLACKLIST - " & oClient.HELO & ", 7, d)" )
      Exit Sub
   Next

   '   Validate HELO/EHLO greeting
   '
   Const strFQDN = "^(?=^.{1,254}$)(^(?:(?!\.|-)([a-z0-9\-\*]{1,63}|([a-z0-9\-]{1,62}[a-z0-9]))\.)+(?:[a-z]{2,})$)$"
   Const strIPv4 = "^\[(?:[0-9]{1,3}\.){3}[0-9]{1,3}\]$"
   Const strIPv6 = "^\[(IPv6)((?:[0-9A-Fa-f]{0,4}:){1,7}(?:(?:(>25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)|[0-9A-Fa-f]{1,4}))\]$"
   strRegEx = strFQDN & "|" & strIPv4 & "|" & strIPv6
   If (Lookup(strRegEx, oClient.HELO) = False) Then
      Result.Value = 2
      Result.Message = "5.7.1 CODE03 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."

'     If AutoBan(oClient.IPAddress, "Bad HELO - " & oClient.HELO, 7, "d") Then _
'        EventLog.Write( "AutoBan(" & oClient.IPAddress & ", Bad HELO - " & oClient.HELO & ", 7, d)" )

      Exit Sub
   End If
End Sub

'   ********** SPAM test: DNSBlackLists, HeloHost, MXRecords, SPF

Sub OnSMTPData(oClient, oMessage)
   Dim i, strRegEx, Match, Matches

   '   Exclude Backup-MX & local LAN from test
   '
   If (Left(oClient.IPAddress, 10) = "80.160.77.") Then Exit Sub
   If (Left(oClient.IPAddress, 10) = "192.168.0.") Then Exit Sub

   '   Filter out "impatient" servers. Alternative to GreyListing.
   '
   If (oClient.Port = 25) Then Wait(20)
End Sub

'   ********** SPAM test: SURBL, DKIM, SpamAssassin

Sub OnAcceptMessage(oClient, oMessage)
   Dim a, i, strRegEx, Match, Matches

   '   Exclude authenticated users test
   '
   If (oClient.Username <> "") Then Exit Sub

   '   Reject "X-Envelope-From:"
   '
   strRegEx = "^(.*\@dcs-dz\.com)$|" &_
              "^(.*\@danzamor\.com)$|" &_
              "^(.*\@epsp-telagh\.com)$|" &_
              "^(.*\@vrshoesale\.com)$|" &_
              "(\.tw|\.bid|\.kim|\.men|\.top|\.win|\.xyz|\.zip)$"
   Set Matches = oLookup(strRegEx, oMessage.FromAddress, False)
   For Each Match In Matches
      Result.Value = 2
      Result.Message = "5.7.1 CODE04 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."
      Exit Sub
   Next

   '   Reject "From:"
   '
   strRegEx = "(Sweetme)|(Kira Johns)|(July Girl)|(Hot Mama)|(Little Miss)|" &_
              "(Baby Boobs)|(Booby Girl)|(Booby Booms)|" &_
              "(\.tw|\.bid|\.kim|\.men|\.top|\.win|\.xyz|\.zip)(|\>)$"
   Set Matches = oLookup(strRegEx, oMessage.From, False)
   For Each Match In Matches
      Result.Value = 2
      Result.Message = "5.7.1 CODE05 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."
      Exit Sub
   Next

   '   Reject "Subject:"
   '
   strRegEx = "^(yo|hi|sup|hello|greets|hey t?here)(!?)(.?)(8?-?\)?)?$"
   If (oMessage.HeaderValue("X-Blacklist-RegEx") = "") Then
      Set Matches = oLookup(strRegEx, oMessage.Subject, False)
      For Each Match In Matches
         Result.Value = 2
         Result.Message = "5.7.1 CODE06 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."
         Exit Sub
      Next
   End If

   '   Reject "Body:"
   '
   strRegEx = "(\.xyz\/)|(thisemailwillchangeyourlife)|(Please sign the contract)"
   If Lookup(strRegEx, oMessage.Body) Or Lookup(strRegEx, oMessage.HTMLBody) Then
      Result.Value = 2
      Result.Message = "5.7.1 CODE07 Your access to this mail system has been rejected due to the sending MTA's poor reputation. If you believe that this failure is in error, please contact the intended recipient via alternate means."
      Exit Sub
   End If

   '   Additional SPAM processing
   '
   Dim Done : Done = False
   If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then Done = True
   Do Until Done

      '   Blacklist "X-Envelope-From:"
      '
      '   NOTE: "^(.*\@.*\.[a-z]{4,})$" WILL FILTER OUT ANY 4+ LETTER TLD.
      '
      strRegEx = "^(.*\@.*\.[a-z]{4,})$|" &_
                 "^(return\@.*)$|" &_
                 "^(job\@.*)$|" &_
                 "^(.*\@.*bitcoin.*)$"
      Set Matches = oLookup(strRegEx, oMessage.FromAddress, False)
      For Each Match In Matches
         Call SPAMList(oMessage, "BlackList oMessage.FromAddress: Value '" & Match.Value & "'")
      Next
      Exit Do

      '   Blacklist "From:"
      '
      '   NOTE: "(\<.*\@.*\.[a-z]{4,}\>)" WILL FILTER OUT ANY 4+ LETTER TLD.
      '
      strRegEx = "(\<.*\@.*\.[a-z]{4,}\>)"
      Set Matches = oLookup(strRegEx, oMessage.From, False)
      For Each Match In Matches
         Call SPAMList(oMessage, "BlackList oMessage.From: Value '" & Match.Value & "'")
      Next
      Exit Do

      '   Blacklist "Subject:"
      '
      strRegEx = "(Fakta Gavekort)|" &_
                 "(Vi inviterer dig til at tilslutte dig)|(Dette er ikke en reklame)|" &_
                 "(Blockchain-momentum)|" &_
                 "(du vil finde rigtig meget brugbar information herinde)|" &_
                 "(ringede til dig, men du tog den ikke)|" &_
                 "(Noget helt fantastisk er ved at ske)|" &_
                 "((iPhone)(\x20(3G|4|5|6|SE|7|8|9|X))?(C|S|R)?(\x20(Plus|Max))?)"
      Set Matches = oLookup(strRegEx, oMessage.Subject, False)
      For Each Match In Matches
         Call SPAMList(oMessage, "BlackList oMessage.Subject: Value '" & Match.Value & "'")
      Next
      Exit Do

      '   Blacklist Body - iPhone SPECIAL
      '
      strRegEx = "(Du har fået denne mail tilsendt angående et jobtilbud)|" &_
                 "(Vi har registreret, at du har et overskydende)|" &_
                 "(I øjeblikket tildeler vi alle nyopstartede brugere)|" &_
                 "(Din konto er i risiko for at blive suspenderet)|" &_
                 "(Vi leder efter en ny person)|" &_
                 "(Leo Vegas er)|(velkomstbonus til din)|" &_
                 "(beskytte dit kort mod svig)|(I have a proposal)|" &_
                 "(You are receiving this email because you opted in via our website)|" &_
                 "((iPhone)(\x20(3G|4|5|6|SE|7|8|9|X))?(C|S|R)?(\x20(Plus|Max))?)"
      Set Matches = oLookup(strRegEx, oMessage.Body, False)
      If Matches.Count > 0 Then
         For Each Match In Matches
            Call SPAMList(oMessage, "BlackList oMessage.Body: Value '" & Match.Value & "'")
         Next
         Exit Do
      Else
         Dim strHTMLBody : strHTMLBody = oMessage.HTMLBody

         ' <!-- ... -->   PHP: "(<!--[^>]*-->)"      JavaScript: "(<!--[\s\S]*?-->)"
         ' /*   ...  */   PHP: "(\/\*)[^>]*(\*\/)"   JavaScript: "(\/\*)[\s\S]*?(\*\/)"
         ' <!--[\\s\\S]*?(?:-->)?<!---+>?|<!(?![dD][oO][cC][tT][yY][pP][eE]|\\[CDATA\\])[^>]*>?|<[?][^>]*>?

         With CreateObject("VBScript.RegExp")
            .Pattern = "(\/\*[\s\S]*?\*\/)|(<[\s\S]*?>)"
            .Global = True
            .MultiLine = True
            .IgnoreCase = True
            strHTMLBody = .Replace(strHTMLBody, "")
         End With
         Set Matches = oLookup(strRegEx, strHTMLBody, False)
         For Each Match In Matches
            Call SPAMList(oMessage, "BlackList oMessage.HTMLBody: Value '" & Match.Value & "'")
         Next
         Exit Do
      End If
      Done = True
   Loop

   '   Whitelist senders Eg. notification+m5kkb25r@facebookmail.com
   '
   If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then

      '   Whitelist "X-Envelope-From:"
      '
      strRegEx = "^(bounces\+3390280\-2e2e\-soren\=acme\.inc\@mail\.computerworld\.dk)$|" &_
                 "^(notification\+)[a-z,0-9,_]{8}(\@facebookmail\.com)$|" &_
                 "^(transaction\@notice\.aliexpress\.com)$|" &_
                 "^(tracking-noreply\@webshipr\.com)$|" &_
                 "^(security\@facebookmail\.com)$|" &_
                 "^(noreply\@fitnessworld\.com)$|" &_
                 "(\@(email|insideapple)\.apple\.com)$"
      Set Matches = oLookup(strRegEx, oMessage.FromAddress, False)
      For Each Match In Matches
         Call WhiteList(oMessage, "WhiteList oMessage.FromAddress: Value '" & Match.Value & "'")
      Next

      '   Whitelist "From:"
      '
      If (oMessage.HeaderValue("X-hMailServer-Spam") = "YES") Then
         strRegEx = "^(Goodreads <no-reply\@mail\.goodreads\.com>)$|" &_
                    "(account-update\@amazon\.com)|" &_
                    "(no_reply\@snapchat\.com)|" &_
                    "(help\@epicgames\.com)|" &_
                    "(\@id\.apple\.com)"
         Set Matches = oLookup(strRegEx, oMessage.From, False)
         For Each Match In Matches
            Call WhiteList(oMessage, "WhiteList oMessage.From: Value '" & Match.Value & "'")
         Next
      End If
   End If

   '   Add X-Envelope... headers
   '
   Call XEnvelope(oMessage)
End Sub

'   ********** Saving EML to DATA

Sub OnDeliveryStart(oMessage)
End Sub

'   ********** Antivirus check, Global rules

Sub OnDeliverMessage(oMessage)
End Sub

'   ********** Local rules, Message delivered to recipient(s)

Sub OnDeliveryFailed(oMessage, sRecipient, sErrorMessage)
End Sub

Sub OnExternalAccountDownload(oFetchAccount, oMessage, sRemoteUID)
End Sub

Sub OnBackupFailed(sReason)
End Sub

Sub OnBackupCompleted()
End Sub

Sub OnError(iSeverity, iCode, sSource, sDescription)
   Dim EventLogX : Set EventLogX = New LogWriter
   EventLogX.LogFile = "error"
   EventLogX.Write( "" )
   EventLogX.Write( "iSeverity: " & iSeverity )
   EventLogX.Write( "iCode: " & iCode )
   EventLogX.Write( "sSource: " & sSource )
   EventLogX.Write( "sDescription: " & sDescription )
End Sub

'******************************************************************************************************************************
'********** hMailServer Rules                                                                                        **********
'******************************************************************************************************************************

   '
   ' Rules test ...
   '
   ' True: Mon-Thu 00:00 - 06:59 & 17:00 - 23:59
   ' (?i:^.*\;.(Mon|Tue|Wed|Thu).*.(([0][0-6])|([1][7-9])|([2][0-3]))\:.*$)
   '
   ' True: Fri 00:00 - 06:59 & 16:00 - 23:59
   ' (?i:^.*\;.(Fri).*.(([0][0-6])|([1][6-9])|([2][0-3]))\:.*$)
   '
   ' True: Sat-Sun
   ' (?i:^.*\;.(Sat|Sun).*$)
   '
   ' True: Mon-Fri 00:00 - 06:59 & 17:00 - 23:59 & Sun & Sat
   ' (?i:^(.*\;.)((Sat|Sun)|((Mon|Tue|Wed|Thu|Fri)(.*\x20)(([0][0-6])|([1][7-9])|([2][0-3]))\:))(.*)$)
   '
   ' True: 25 Dec 07:00 - 16:59
   ' (?i:^.*\,.(25 Dec).*.(([0][7-9])|([1][0-6]))\:.*$)
   '

'******************************************************************************************************************************
'********** TRASH and ORPHANS                                                                                        **********
'******************************************************************************************************************************

Rules And Scripts

Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts

Re: Rules And Scripts