This scripts will send a message to a user when his mailbox size gets within a specified percentage of his max mailbox size. Originally posted in this thread.
Requirements
hMailServer 4 or greater.
Usage
Copy this code to your eventhandler.vbs. If you already have code in your OnDeliverMessage subroutine, then you will have to merge the contents of the OnDeliverMessage subroutine below with your own. Configure the variables in the user defined constant block to reflect your server environment and needs.
Code: Select all
Dim DebugLog
'**************User Defined Constants***************************
'Log Directory Where Debug log is stored
Const conLogDir = "D:\Program Files\hMailServer\Logs\"
'Percentage of space remaining when warning messages get sent
Const conSpaceRemainingWarningAt = 0.05
'Email Address that warning emails appear to be from
Const conSpaceWarningFrom = "admin@pcyoudo.com"
Const conSpaceWarningSubject = "Email storage limit almost reached"
Const conSpaceWarningBody = "[address], \n\nYour mailbox size of [size] MB is within 5% of its maximum space allotment of [maxsize] MB. In order to avoid bounced messages, please consider reducing the size of your mailbox. \n\nThanks,\n\nAdministrator"
'If True, debug log is created to help debug
Const conDebug = False
'***************************************************************
'***************************************************************
'InitializeVariables: Initialize global variables
'
'***************************************************************
Sub InitializeVariables
'Create our debug logger
Set DebugLog = new DebugLogger
'Set whether it is enabled or not
DebugLog.IsEnabled = conDebug
End Sub
' Sub OnClientConnect(oClient)
' End Sub
' Sub OnAcceptMessage(oClient, oMessage)
' End Sub
Sub OnDeliverMessage(oMessage)
'Initialize our global variables
InitializeVariables
DebugLog.LogWithTimestamp "Entering OnDeliverMessage", DebugLog.IncreaseIndent
DoMailboxSizeLimitWarning( oMessage )
DebugLog.Log "Exiting OnDeliverMessage. Result.Value = " & Result.Value, DebugLog.DecreaseIndent
'Cleanup our variables
DisposeVariables
End Sub
'***************************************************************
'***************************************************************
' Mailbox Limit Approaching Functionality
'***************************************************************
'***************************************************************
Sub DoMailboxSizeLimitWarning( oMessage )
DebugLog.Log "Entering DoMailboxSizeLimitWarning", DebugLog.IncreaseIndent
Dim oAccount
Dim messageBody
Set oAccount = new Account
'Check to make sure the message we're checking against
'isn't a warning message. Otherwise we'll get stuck in an
'endless mail sending loop
If oMessage.Subject <> conSpaceWarningSubject Then
'Loop through all the mail recipients
For i = 0 To oMessage.Recipients.Count - 1
DebugLog.Log "Recipient: " & oMessage.Recipients(i).Address, null
'Check to see if recipient is local
If Recipients(i).IsLocalUser Then
'if so, let's load their account to get their mailbox info
oAccount.LoadAccountFromAddress( oMessage.Recipients(i).Address )
'Is the mailbox approaching the threshold specified?
If oAccount.IsMailboxWithinXPercentOfLimit(conSpaceRemainingWarningAt) Then
'Customize our warning message for this user
messageBody = conSpaceWarningBody
messageBody = Replace( messageBody, "\n", vbCRLF )
messageBody = Replace( messageBody, "[address]", oAccount.Address )
messageBody = Replace( messageBody, "[maxsize]", oAccount.MaxSize )
messageBody = Replace( messageBody, "[size]", oAccount.Size )
'Send warning message
DebugLog.Log "Sending Warning Message to " & oAccount.Address, null
SendMessage conSpaceWarningFrom, Array( oAccount.Address ), conSpaceWarningSubject, messageBody
End If
End If
Next
End If
Set oAccount = Nothing
DebugLog.Log "Exiting DoMailboxSizeLimitWarning", DebugLog.DecreaseIndent
End Sub
'***************************************************************
'DisposeVariables: Clean up any variables we might have been using
'
'***************************************************************
Sub DisposeVariables
DebugLog.Dispose
Set DebugLog = Nothing
End Sub
'*****************************************************************************
'***************************** Helper Classes ********************************
'*****************************************************************************
'*****************************************************************************
Class Account
Dim oAccount
Public Property Get Address
Address = oAccount.Address
End Property
Public Property Get MaxSize
MaxSize = oAccount.MaxSize
End Property
Public Property Get Size
Size = oAccount.Size
End Property
Function IsMailboxWithinXPercentOfLimit( dblPercent )
DebugLog.Log "Entering IsMailboxWithinXPercentOfLimit dblPercent: " & dblPercent, DebugLog.IncreaseIndent
DebugLog.Log "Current MB Size: " & Size & " Max MB Size: " & MaxSize & " Warning Size: " & MaxSize * dblPercent, null
If MaxSize = 0 Then DebugLog.Log "Account has no storage limit! Returning false", null
'Perform our calc, a MaxSize of 0 means there is no max size, so
'in that case we'll always return false
If( MaxSize > 0 And MaxSize * dblPercent < Size ) Then
IsMailboxWithinXPercentOfLimit = True
Else
IsMailboxWithinXPercentOfLimit = False
End If
DebugLog.Log "Exiting IsMailboxWithinXPercentOfLimit. Return value: " & IsMailboxWithinXPercentOfLimit, DebugLog.DecreaseIndent
End Function
Sub LoadAccountFromAddress( strAddress )
Dim oDomains
Dim oDomain
Dim oAccounts
Dim strDomain
DebugLog.Log "Entering LoadAccountFromAddress, strAddress = " & strAddress, DebugLog.IncreaseIndent
DebugLog.Log "Creating Domains Object", null
Set oDomains = CreateObject("hMailServer.Domains")
DebugLog.Log "Created Domains Object", null
strDomain = Right( strAddress, Len( strAddress ) - InStr(strAddress, "@") )
DebugLog.Log "Domain from address is: " & strDomain, null
Set oDomain = oDomains.ItemByName( strDomain )
DebugLog.Log "Creating Accounts Object", null
Set oAccounts = oDomain.Accounts
DebugLog.Log "Created Accounts Object", null
DebugLog.Log "Getting Account: " & strAddress, null
' Enable error handling
On Error Resume Next
Set oAccount = oAccounts.ItemByAddress(strAddress)
DebugLog.LogError
' Reset error handling
On Error Goto 0
DebugLog.Log "Got Account: " & oAccount.Address, null
Set oAccounts = Nothing
Set oDomains = Nothing
Set oDomain = Nothing
DebugLog.Log "Exiting LoadAccountFromAddress", DebugLog.DecreaseIndent
End Sub
End Class
Function SendMessage( strFrom, arrRecipients, strSubject, strBody )
DebugLog.Log "Entering SendMessage strFrom = " & strFrom & " arrRecipients = " &_
Join(arrRecipients," : ") & " strSubject = " & strSubject & " strBody = " & strBody, DebugLog.IncreaseIndent
Dim oMessage
Set oMessage = CreateObject("hMailServer.Message")
oMessage.From = strFrom
oMessage.Subject = strSubject
Dim arrRecipientParts
For Each recipient in arrRecipients
arrRecipientParts = Split( recipient, "," )
If( UBound( arrRecipientParts ) > 1 ) Then
oMessage.AddRecipient arrRecipientParts(0), arrRecipientParts(1)
Else
oMessage.AddRecipient "", arrRecipientParts(0)
End If
Next
oMessage.Body = strBody
oMessage.Save
Set oMessage = Nothing
DebugLog.Log "Exiting SendMessage", DebugLog.DecreaseIndent
End Function
'***************************************************************
'DebugLogger: A class to log debug messages. Logging only works
' if IsEnabled = true, otherwise all logging calls are ignored
'***************************************************************
Class DebugLogger
Private m_intIndent
Private m_blnIsEnabled
Public Property Get IsEnabled
IsEnabled = m_blnIsEnabled
End Property
Public Property Let IsEnabled(ByVal blnValue)
m_blnIsEnabled = blnValue
End Property
Public Property Get DecreaseIndent
DecreaseIndent = -1
End Property
Public Property Get IncreaseIndent
IncreaseIndent = 1
End Property
Private Property Get LogDir
LogDir = conLogDir
End Property
Private Property Get Indent
If m_intIndent = "" Then
m_intIndent = 0
End If
Indent = m_intIndent
End Property
Private Property Let Indent(ByVal intValue)
m_intIndent = intValue
End Property
Sub Dispose
End Sub
Private Sub IncIndent
Indent = Indent + 1
End Sub
Private Sub DecIndent
If Indent > 0 Then
Indent = Indent - 1
End If
End Sub
Sub LogError
If Err.number <> 0 Then
' Object couldn't be created
' Log error
Log "**Error: Description: " & Err.Description & " Severity: " & apgSeverityError & " Number: " & Err.Number, null
End If
End Sub
Sub LogWithTimestamp( strString, intIndentType )
Log Date & " " & Time & " " & strString, intIndentType
End Sub
Sub Log( strString, intIndentType )
If IsEnabled Then
'We decrease indent immediately
If intIndentType = DecreaseIndent Then
DecIndent
End If
SET oFs = CreateObject("Scripting.FileSystemObject")
SET oFil = ofs.OpenTextFile( LogDir & "Debug.log", 8, True)
For i = 0 To Indent
oFil.write(" ")
Next
oFil.WriteLine( strString )
oFil.Close
SET oFil = Nothing
SET oFs = Nothing
'We increase indent after
If intIndentType = IncreaseIndent Then
IncIndent
End If
End If
End Sub
End Class
'***************************************************************
'Logger: Logging class to log whatever to a log file
' Copied/Modified from mnadig's post
' (http://www.hmailserver.com/forum/viewtopic.php?t=1798)
'***************************************************************
Class Logger
Private Property Get LogDir
LogDir = conLogDir
End Property
Sub WriteLog( strString )
SET oFs = CreateObject("Scripting.FileSystemObject")
SET oFil = ofs.OpenTextFile( LogDir & "Events.log", 8, True)
oFil.writeline( strString)
oFil.close
SET oFil = Nothing
SET oFs = Nothing
End Sub
End Class