Quota Notify script doesn't work, what am I doing wrong?

Use this forum if you have problems with a hMailServer script, such as hMailServer WebAdmin or code in an event handler.
Post Reply
timjbart
New user
New user
Posts: 27
Joined: 2007-04-27 13:41

Quota Notify script doesn't work, what am I doing wrong?

Post by timjbart » 2007-05-30 16:24

I have never used a script before so just wanted clarification.

I copied the quota notify script at the bottom of my Eventhandlers.vbs

Then I went to hmailserver admin and ticked the Active box in the Scripts menu.

Then press the 'reload scripts' button.

I even saved rebooted just to make sure.

However, after doing all this the script doesn't seem to do anything. Is there a step I am missing?

Here is my eventhandlers file, does it look ok?

Thanks

Code: Select all

'   Sub OnClientConnect(oClient)
'   End Sub

'   Sub OnAcceptMessage(oClient, oMessage)
'   End Sub

'   Sub OnDeliveryStart(oMessage)
'   End Sub

'   Sub OnDeliverMessage(oMessage)
'   End Sub

'   Sub OnBackupFailed(sReason)
'   End Sub

'   Sub OnBackupCompleted()
'   End Sub

Dim DebugLog

'**************User Defined Constants***************************
'Log Directory Where Debug log is stored
Const conLogDir = "C:\Program Files\hMailServer\Logs\"
'Percentage of space remaining when warning messages get sent
Const conSpaceRemainingWarningAt = 0.10
'Email Address that warning emails appear to be from
Const conSpaceWarningFrom = "admin@*******.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 

User avatar
martin
Developer
Developer
Posts: 6834
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by martin » 2007-05-30 18:39

The purpose of the script is to send a e-mail warning when a users quota is closed to be reached. The script is triggered when someone delivers a message to the user. The script doesn't do anything unless you send a message to an account which has a quota which is almost reached..

timjbart
New user
New user
Posts: 27
Joined: 2007-04-27 13:41

Post by timjbart » 2007-05-30 18:43

Yes I am doing extensive testing sending many many emails to the user and waiting for the script to trigger and send the warning but it never occurs.

The quota just fills and the user stops receiving emails, and there is still no warning.

User avatar
martin
Developer
Developer
Posts: 6834
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by martin » 2007-05-30 19:17

What error is reported to the hMailServer error log in \hMailServer\Logs?

Guessing it's an authentication problem. Script doesn't seem to be compatible with hMailServer 4.3 and later.

timjbart
New user
New user
Posts: 27
Joined: 2007-04-27 13:41

Post by timjbart » 2007-05-31 10:36

Looks like you are right about authentication. Log contains:

Code: Select all

"ERROR"	1400	"2007-06-02 13:36:10.463"	"Script Error: Source: hMailServer COM library - Error: 800403E9 - Description: You do not have access to this property / method. Ensure that hMailServer.Application.Authenticate() is called with proper login credentials. - Line: 170 Column: 6 - Code: (null)"
This script has also prevented my autoreply from working. Instead of replying, it puts the messages in the undelivered queue.

timjbart
New user
New user
Posts: 27
Joined: 2007-04-27 13:41

Post by timjbart » 2007-06-25 16:37

anyone fixed this script for hmailserver 4.4?

Thanks

gogosb
New user
New user
Posts: 9
Joined: 2007-04-12 15:46

quota script problem

Post by gogosb » 2007-07-06 19:29

It would be simple solution of the quota problem, if hmail server allowed to get a mail when the quota limit is reached, but denied the sending. In this case users were warned automatically.

Post Reply