First provided by LesD ( topic: http://www.hmailserver.com/forum/viewto ... dd#p154541 )
This one will reject the whole email back to sender. It allows local users to send without blocking
Code: Select all
Sub OnAcceptMessage(oClient, oMessage) ' Ignore messages from local users if oClient.Username = "" then Dim oAttachment Dim oRegExp Set oRegExp = new RegExp For oAttachment = 0 to oMessage.Attachments.Count-1 ' Test for undesirable attachments with oRegExp .Pattern = "^.*\.(bat|cmd|com|cpl|csh|docm|exe|hta|htb|inf|js|jse|lnk|msi|msp|pif|reg|scf|scr|shs|shb|vbe|vbs|wsf|wsh|zip)$" .IgnoreCase = True .Global = False end with if (oRegExp.test(oMessage.Attachments(oAttachment).Filename)) Then ' Log in event log EventLog.Write ("Email Rejected: Attachment unacceptable: " _ & oMessage.Attachments(oAttachment).Filename & " Size : " _ & oMessage.Attachments(oAttachment).Size) ' Text to include with 550 rejection message Result.Message = "Email Rejected : Attachment <" _ & oMessage.Attachments(oAttachment).Filename & "> is not acceptable" Result.Value = 2 ' Reject' End If Next Set oRegExp = nothing End if End Sub
This one gives you two options, Firstly you can quarantine the attachment and let the email through and secondly you can just delete the attachment and let the email through. Quarantine = False provides same functionality as antivirus attachment blocking is supposed to do.
To implement add a global rules which says
message size > 0
run function DeleteAttachments
Add following code to end of your eventhandlers.vbs file.
and note the variables below that you need to set.
Code: Select all
Sub DeleteAttachments(oMessage) ' this routine deletes or quarantines file attachments that have the specified ' FileExtensions. It replaces the functionality of antivirus blocked attachments panel in hmailadmin ' with optional quarantine ' un-comment following line and last End If at end of sub to only apply for external accounts ' if oClient.Username = "" then Dim Quarantine ' set to True to Quarantine or False to Delete attachments Quarantine = False Dim QuarantineFolder 'where to store quarantined attachments. Must be pre created QuarantineFolder = "c:\path to\hmailserver\Attachment-Quarantine\" ' trailing slash is required Dim QuarantineFile Dim FileExtensions ' set to the file attachment extensions you want to delete or quarantine FileExtensions = "(bat|cmd|com|cpl|csh|docm|exe|hta|htb|inf|js|jse|lnk|msi|msp|pif|reg|scf|scr|shs|shb|vbe|vbs|wsf|wsh|zip)" ' change anything below here at your own risk. Dim AttachmentDeleteNotify AttachmentDeleteNotify = Empty Dim oAttachment Dim oRegExp Set oRegExp = new RegExp For oAttachment = 0 to oMessage.Attachments.Count-1 ' Test for undesirable attachments with oRegExp .Pattern = "^.*\."& FileExtensions & "$" .IgnoreCase = True .Global = False end with if (oRegExp.test(oMessage.Attachments(oAttachment).Filename)) Then ' Delete Attachment AttachmentDeleteNotify = AttachmentDeleteNotify & oMessage.Attachments(oAttachment).Filename & "~" If (Quarantine) Then QuarantineFile = QuarantineFolder & oMessage.Attachments(oAttachment).Filename & "." _ & Left(Right(oMessage.Filename,42),38) & ".Quarantined" oMessage.Attachments(oAttachment).SaveAs(QuarantineFile) oMessage.Attachments(oAttachment).Delete Else oMessage.Attachments(oAttachment).Delete End If End If Next Set oRegExp = nothing If Not IsEmpty(AttachmentDeleteNotify) then AttachmentDeleteNotify = "The following attachment/s were blocked for delivery by the e-mail server." & "~" _ & "Please contact your system administrator if you have any questions regarding this." & "~" & "~" _ & AttachmentDeleteNotify _ & "~" & "hmailserver" & "~" & "~" Dim htmlNotify htmlNotify = AttachmentDeleteNotify If ( Len(oMessage.Body) <> 0 ) Then AttachmentDeleteNotify = Replace(AttachmentDeleteNotify, "~", VbCrLf) oMessage.Body = oMessage.Body & VbCrLf & VbCrLf & AttachmentDeleteNotify End If If ( Len(oMessage.HTMLBody) <> 0 ) Then htmlNotify = Replace(htmlNotify, "~", ("<br>" & VbCrLf)) oMessage.HTMLBody = Replace(oMessage.HTMLBody, "</body", ("<br><br>" & htmlNotify & "</BODY"), 1, 1, vbTextCompare) End If oMessage.Save End If ' End if End Sub