Send a warning email when user approaches mailbox limit

This section contains scripts that hMailServer has contributed with. hMailServer 4 is needed to use these.
cmurphy54
Senior user
Senior user
Posts: 550
Joined: 2004-09-25 22:11
Location: Atlanta, GA
Contact:

Send a warning email when user approaches mailbox limit

Postby cmurphy54 » 2005-08-12 00:17

Description
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

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

Postby martin » 2005-08-12 01:22

That looks really nice. Not that I need it myself but good work. :)

One good thing with this section of the forum is that I get a better view of what changes are needed in the COM API. I've added three small COM API feature-requests that would make this specific script shorter and faster. Probably took me longer time to enter than then to implement them but I use the "Feature requests"-section as a todolist.. :)

cmurphy54
Senior user
Senior user
Posts: 550
Joined: 2004-09-25 22:11
Location: Atlanta, GA
Contact:

Postby cmurphy54 » 2005-08-12 02:26

That looks really nice. Not that I need it myself but good work.


Thanks. I don't actually use it either as none of my users have quotas. ;) I wrote it along with a few others based on posts/feature requests in order to get a feel for what you could do with the scripting. The COM API improvements you proposed would definitely make the scripting easier.

One thing from the script I would like to see added are Initialize and Deinitialize event handlers (Load/Unload, or whatever, it doesn't really matter what they are called). You'd be assured of the initialize being called before any other event and the deinitialize being called before the script is unloaded from memory. It would be nice if it was only fired once when the script was loaded into memory (and not every time an event fired), but the other way would work too.

I haven't actually tested to see if global variable values are retained between events, but I'd like to see that too as it let you keep in-memory lists of things (like received mail perhaps or a dynamic blacklist or make a logger that does bulk disk writes as opposed to line by line writes).

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

Postby martin » 2005-08-22 23:00

> I haven't actually tested to see if global variable values are retained between events,

They aren't. But I agree that it ofcourse would be good if they were. But today, every VBA script is executed as an independent unit.

The reason for this is threading problems which makes it a bit hard to implement properly (if it's even possible..). And even if I implement it properly in the server, I'm a bit scared that it will cause confusion for people that write script and doesn't know how multithreading affect their scripts.

I have a guess that you already know about threading problems (actually I'm almost sure..), otherwise, here's a short explanation.

Say for example that you have a small script that updates the global variable gNoOfDelivMsg (number of delivered messages) in the OnDeliverMessage event. The update is done using the following code:

Code: Select all

Line 1: dim iNewCount
Line 2: iNewCount = gNoOfDelivMsg + 1
Line 3: gNoOfDelivMsg = iNewCount


Now say that the current value of gNoOfDelivMsg is 100. If two delivery threads executes line 2 the same time, they will both set iNewCount to 101. And then they will both set gNoOfDelivMsg to 101, even though there's actually two messages that has been delivered. So the value of the variable gNoOfDelivMsg will become incorrect.

Even if you rewrite the code to gNoOfDelivMsg = gNoOfDelivMsg +1 it won't work. This single line of code is expanded to several lines (when the VBA code is converted to processor instructions).

One alternative would be to have a shared "VBA environment", but that hMailServer only allows one script to run at a time. So if 5 events should be executed, they would just have to queue up. But this would give bad performance since (as example) hMailServer wouldn't be able to run OnAcceptMessage because OnDeliverMessage is running a large virus scan.

I'm simply not aware of a good workaround to this problem. It would ofcourse be better if all VBA-scripts could be executed in the same "memory area" (or whatever it's called). Perhaps you have a suggestion?

cmurphy54
Senior user
Senior user
Posts: 550
Joined: 2004-09-25 22:11
Location: Atlanta, GA
Contact:

Postby cmurphy54 » 2005-08-22 23:16

Well, any solution definitely adds complexity, but one place to look for a solution is ASP. ASP has an Application object which is essentially a dictionary/hashtable object that allows you to store data in it which is accessible from any ASP thread that is executing within the same application (web site). The Application object has a locking mechanism so you can do:

Code: Select all

Application.Lock
Application("gNoOfDelivMsg") = Application("gNoOfDelivMsg") + 1
Application.UnLock


If you wanted to get ambitious you could implement a more granular locking option, but something like above is probably a decent tradeoff between ease of coding and effectiveness.

It isn't a high priority for me, just something that would be nice to have.

nwkit
Normal user
Normal user
Posts: 133
Joined: 2004-04-19 03:57
Location: Canada

Postby nwkit » 2005-10-29 08:28

wiht the code you provided above, how many e-mails does it send out to a user?

i checked one of mine and it sent out 3 emails. I have the settings to show the warning at 0.05. I checked the emails that i have received and the size is not even close to 5% left of the quota. (for eg. 29 mb size, and 50 mb quota).

Is it possible to send out one e-mail a week or something? Instead of multiple e-mails. Thanks.

cmurphy54
Senior user
Senior user
Posts: 550
Joined: 2004-09-25 22:11
Location: Atlanta, GA
Contact:

Postby cmurphy54 » 2006-01-03 21:53

It's a bit late, but I figured a slow response is better than no response...

nwkit wrote:wiht the code you provided above, how many e-mails does it send out to a user?


The bad part about this script is that it sends out a warning email whenever a new email is received.

nwkit wrote:i checked one of mine and it sent out 3 emails. I have the settings to show the warning at 0.05. I checked the emails that i have received and the size is not even close to 5% left of the quota. (for eg. 29 mb size, and 50 mb quota).


I never had an issue with the quota % not being calculated correctly, but if you turned on the script logging (in the script, this isn't the same thing as hMailServer's logs), you could probably see what the issue was.

nwkit wrote:Is it possible to send out one e-mail a week or something? Instead of multiple e-mails. Thanks.


It would be possible to change this behavior if you stored the last time a warning was sent out in a flat file or something, but that is added complexity that I didn't feel like adding at the time. If someone else wanted to extend the scripts capabilities, that would be great.

chanas
Normal user
Normal user
Posts: 57
Joined: 2006-04-08 00:27
Location: Athens/Greece
Contact:

Postby chanas » 2006-04-27 20:14

Wouldn't it be possible to implement this as a script using cscript.exe and run it through Task Scheduler? It would avoid the repeated messages.

tranthanh
New user
New user
Posts: 1
Joined: 2005-05-14 07:27
Location: vietnam
Contact:

Postby tranthanh » 2006-06-21 16:44

thanks for your post.

chanas
Normal user
Normal user
Posts: 57
Joined: 2006-04-08 00:27
Location: Athens/Greece
Contact:

Postby chanas » 2006-07-02 16:52

I created CheckQuota.vbs first

Code: Select all

Option explicit

dim oApp
set oApp = CreateObject("hMailServer.Application")

dim oDomains
set oDomains = oApp.Domains

dim iTotalCount

dim iDomainIdx
For iDomainIdx = 0 To oDomains.Count -1

   dim oDomain
   set oDomain = oDomains.Item(iDomainIdx)

   ' Iterate over user accounts
   dim oAccounts
   set oAccounts = oDomain.Accounts

   dim iAccountCount
   iAccountCount = oAccounts.Count

   Dim iAccountIdx,MsgA,msg,SendEmail,strErrorString
   
   for iAccountIdx = 0 To iAccountCount - 1
      dim oAccount
      set oAccount = oAccounts.Item(iACcountIdx)
      if oAccount.QuotaUsed > 90 then
         'WScript.Echo oAccount.Address & " : " & vbTab & oAccount.QuotaUsed & vbTab & Msga
         SendEmail = true 'No problem encountered
         
         'Here I use JMail but you can use hMailServer
         ' Create the JMail message Object
         set msg = CreateOBject( "JMail.Message" )
         
         ' Set logging to true to ease any potential debugging
         ' And set silent to true as we wish to handle our errors ourself
         msg.Logging = true
         msg.silent = true
         
         
      
         msg.From = "support@domain.com"
         msg.FromName = "E-Mail Support"
         

         msg.AddRecipient oAccount.Address
   
         msg.Subject = "E-Mail Account near Quota"
         
         msg.Body = msg.Body & "Your email account(" & oAccount.Address &  ") is currently near quota." & vbCrLf
         msg.Body = msg.Body & "You are using " & oAccount.Size & " of " & oAccount.MaxSize & " ΜΒytes." & vbCrLf
         msg.Body = msg.Body & "Please delete some e-mails otherwise you may not be able to receive new e-mails."
         msg.Body = msg.Body & "." & vbCrLf & vbCrLf & vbCrLf
         
         msg.Body = msg.Body & "E-Mail Support"
         
         
         ' To capture any errors which might occur, we wrap the call in an IF statement
         if not msg.Send("mail.server") then
            SendEmail = false 'Problem encountered
            strErrorString = "Error encountered: " & msg.ErrorCode & " - " & msg.ErrorMessage & " - " & msg.ErrorSource
         end if
         
         set msg = nothing
      end if
      
      set oAccount = Nothing
      iTotalCount = iTotalCount +1
   next
      
   set oDomain = Nothing
Next

set oApp = Nothing


Then this .cmd file:

Code: Select all

@cscript.exe //B c:\LBin\CheckQuota.vbs


Which is scheduled through Task Scheduler to run daily at 6.00 am. So far all is fine, and users get an e-mail daily.

ikshadow
Normal user
Normal user
Posts: 75
Joined: 2006-07-19 11:17

Postby ikshadow » 2006-08-03 18:21

I have a problem couse scripts send emails to users even when IMAP max size is far from configured %, however all % is calculated corectly.

So users can recevie email: Email storage almost full when he has like only 20% of data ( or 6% etc.. )


Here is exact copy paste from my EventHandlers.vbs.


Code: Select all

'   Sub OnClientConnect(oClient)
'   End Sub

'   Sub OnAcceptMessage(oClient, oMessage)
'   End Sub

'   Sub OnDeliverMessage(oMessage)
Dim DebugLog

'**************User Defined Constants***************************
'Log Directory Where Debug log is stored
Const conLogDir = "D:\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 = "dzizus@salomon.si"
Const conSpaceWarningSubject = "Email storage almost full / Postni predal je skoraj poln"
Const conSpaceWarningBody = "********* SYSTEM MESSAGE FOR [address] **********\n\nENG: Your mailbox size is [size] / [maxsize] MB ([size_percentage]%). In case you reach 100% you wont receive new emails.\nSLO: Stanje vasega postnega predala je [size] / [maxsize] MB ([size_percentage]%). Ko dosezete 100% ne boste prejemali novih emailov.\n\n********* END SYSTEM MESSAGE **********"
'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 size_percentage
   
   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 )

                           size_percentage = round((oAccount.Size/oAccount.MaxSize)*100)
                           messageBody = Replace( messageBody, "[size_percentage]", size_percentage )

                  '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
'   End Sub

'   Sub OnBackupFailed(sReason)
'   End Sub

'   Sub OnBackupCompleted()
'   End Sub
hMailServer 5.4-B1950
MySQL 5.1.73
Domains: 32, Accounts: 1000+ , Messages: 1000.000+, Data size: 200GB+
Running since 18.7.2006 (hMailServer 4.2.2 - Build 199)

ikshadow
Normal user
Normal user
Posts: 75
Joined: 2006-07-19 11:17

Postby ikshadow » 2006-08-21 10:00

/bump
hMailServer 5.4-B1950
MySQL 5.1.73
Domains: 32, Accounts: 1000+ , Messages: 1000.000+, Data size: 200GB+
Running since 18.7.2006 (hMailServer 4.2.2 - Build 199)

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

Postby gogosb » 2007-04-12 16:11

I tried the script provided by cmurphy54, but it stops at line

Set oDomain = oDomains.ItemByName( strDomain )

because hmail needs authentication. I tried to complete the script with authentication, but I failed. Pls help.

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-22 19:18

guys i receive this error message

"ERROR" 2388 "2007-08-23 03:13:15.660" "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: 208 Column: 6 - Code: (null)"

Any idea on how to resolve this issue?

Cheers

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

Postby martin » 2007-08-22 19:51

Replace the line

Code: Select all

Set oDomains = CreateObject("hMailServer.Domains")


with

Code: Select all

Set oApp = CreateObject("hMailServer.Application")
oApp.Authenticate("Administrator", "your-main-hmailserver-password")
Set oDomains = oApp.Domains


(haven't tested it myself but it should work..)

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-23 03:52

it doesnot work....
Description on attempt to reload scripts: Cannot use parentheses when calling a sub - line: 204 colum: 52 - Code: oAPP.Authentication("Administrator", "password")

please help??

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-23 05:05

Code: Select all

Option explicit

dim oApp
set oApp = CreateObject("hMailServer.Application")
call oApp.Authenticate("Administrator", "mypassword")
dim oDomains
set oDomains = oApp.Domains

dim iTotalCount

dim iDomainIdx
For iDomainIdx = 0 To oDomains.Count -1

   dim oDomain
   set oDomain = oDomains.Item(iDomainIdx)

   ' Iterate over user accounts
   dim oAccounts
   set oAccounts = oDomain.Accounts

   dim iAccountCount
   iAccountCount = oAccounts.Count

   Dim iAccountIdx,MsgA,msg,SendEmail,strErrorString
   
   for iAccountIdx = 0 To iAccountCount - 1
      dim oAccount
      set oAccount = oAccounts.Item(iACcountIdx)
      if oAccount.QuotaUsed > 90 then
         'WScript.Echo oAccount.Address & " : " & vbTab & oAccount.QuotaUsed & vbTab & Msga
         SendEmail = true 'No problem encountered
         
         'Here I use JMail but you can use hMailServer
         ' Create the JMail message Object
         set msg = CreateOBject( "hMailServer.Message" )
         
         ' Set logging to true to ease any potential debugging
         ' And set silent to true as we wish to handle our errors ourself
 
         
         
       
         msg.From = "josh@Krazy-j.com"
         msg.FromName = "E-Mail Support"
         

         msg.AddRecipient oAccount.Address
   
         msg.Subject = "E-Mail Account near Quota"
         
         msg.Body = msg.Body & "Your email account(" & oAccount.Address &  ") is currently near quota." & vbCrLf
         msg.Body = msg.Body & "You are using " & oAccount.Size & " of " & oAccount.MaxSize & " ΜΒytes." & vbCrLf
         msg.Body = msg.Body & "Please delete some e-mails otherwise you may not be able to receive new e-mails."
         msg.Body = msg.Body & "." & vbCrLf & vbCrLf & vbCrLf
         
         msg.Body = msg.Body & "E-Mail Support"
         
         
         ' To capture any errors which might occur, we wrap the call in an IF statement
         if not msg.Send("mail.server") then
            SendEmail = false 'Problem encountered
            strErrorString = "Error encountered: " & msg.ErrorCode & " - " & msg.ErrorMessage & " - " & msg.ErrorSource
         end if
         
         set msg = nothing
      end if
       
      set oAccount = Nothing
      iTotalCount = iTotalCount +1
   next
       
   set oDomain = Nothing
Next

set oApp = Nothing


any idea what could be wrong with this code?

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

Postby martin » 2007-08-23 07:42

Okay, my mistake:
oApp.Authenticate("Administrator", "your-main-hmailserver-password")
with
Call oApp.Authenticate("Administrator", "your-main-hmailserver-password")

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-23 15:51

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
const g_sBNFrom = "MailServer Backup"
const g_sBNFromAddress = "backup@krazy-j.com"
const g_sBNSubject = "Backup completed"
const g_sBNRecipientName = "Joshua"
const g_sBNRecipientAddress = "josh@krazy-j.com"
const g_sAdminPassword = "mypassword"


Sub OnBackupCompleted()
   Set oApp = CreateObject("hMailServer.Application")

   ' Give this script permission to access all
   ' hMailServer settings.
   Call oApp.Authenticate("Administrator", g_sAdminPassword)

   sBackupLog = ReadFileAndDelete(oApp.Settings.Backup.LogFile)

   Set oMessage = CreateObject("hMailServer.Message")
   oMessage.From = g_sBNFrom & " <" & g_sBNFromAddress &  ">"
   oMessage.FromAddress = g_sBNFromAddress
   oMessage.Subject = g_sBNSubject
   oMessage.AddRecipient g_sBNRecipientName, g_sBNRecipientAddress
   oMessage.Body = "The backup completed succesfully." & vbNewLine & vbNewLine & sBackupLog
   oMessage.Save
End Sub

Function ReadFileAndDelete(sFile)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile(sFile, 1)
   ReadFileAndDelete = f.ReadAll
   f.Close
   fso.DeleteFile(sFile)
   Set f = Nothing
   Set fso = Nothing
End Function





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 = "josh@krazy-j.com"
Const conSpaceWarningSubject = "Email storage almost full"
Const conSpaceWarningBody = "********* SYSTEM MESSAGE FOR [address] **********\n\nENG: Your mailbox size is [size] / [maxsize] MB ([size_percentage]%). In case you reach 100% you wont receive new emails.\nSLO: Stanje vasega postnega predala je [size] / [maxsize] MB ([size_percentage]%). Ko dosezete 100% ne boste prejemali novih emailov.\n\n********* END SYSTEM MESSAGE **********"
'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 size_percentage
   
   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 )

                           size_percentage = round((oAccount.Size/oAccount.MaxSize)*100)
                           messageBody = Replace( messageBody, "[size_percentage]", size_percentage )

                  '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
Set oApp = CreateObject("hMailServer.Application")
call oApp.Authenticate("Administrator", "mypassword")
Set oDomains = oApp.Domains
      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
'   End Sub

'   Sub OnBackupFailed(sReason)
'   End Sub

'   Sub OnBackupCompleted()
'   End Sub


above is the whole events.vbs file -- i receive some errors in the log file.. iam just wondering what iam doing wrong??

error message is:
""ERROR" 2388 "2007-08-23 23:32:05.113" "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: 216 Column: 6 - Code: (null)"
"

^DooM^
Site Admin
Posts: 13853
Joined: 2005-07-29 16:18
Location: UK

Postby ^DooM^ » 2007-08-23 17:35

Are you sure you are writing the correct admin password in the script?

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-24 00:07

100% sure its the correct password because it works fine for the on backup completion script...?

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-24 10:32

is it possibly something to do with the Code: (Null) it returns???

Krazy-J
New user
New user
Posts: 8
Joined: 2007-08-22 19:17

Postby Krazy-J » 2007-08-26 03:01

any ideas?

Caizi
New user
New user
Posts: 1
Joined: 2007-09-11 17:12

Postby Caizi » 2007-09-11 17:15

Is this script compatible with hMailServer 4.3 and above or not? (as is posted in this thread http://www.hmailserver.com/forum/viewto ... ight=quota)

Thanks for reply.

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

Postby martin » 2007-09-11 18:17

Caizi, there's several scripts posted in this thread. If your copy contains a call to Authenticate it's probably meant to be compatbile with hMailServer 4.3 and later.

boogieman
New user
New user
Posts: 10
Joined: 2009-05-21 13:03

Re: Send a warning email when user approaches mailbox limit

Postby boogieman » 2009-07-05 19:54

working great with the authentication part changed!

many thanks!

ps. just wondering - any chance that this will be part of the usual interface one day? would be nice to have it there :)

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

Re: Send a warning email when user approaches mailbox limit

Postby martin » 2009-07-05 20:59

Not if nobody requests it in the feature request section...

boogieman
New user
New user
Posts: 10
Joined: 2009-05-21 13:03

Re: Send a warning email when user approaches mailbox limit

Postby boogieman » 2009-07-07 11:06

i found this in the archived requests : viewtopic.php?t=1909

but dont get me wrong - i dont want to complain - so far its working great! :D

maybe a quick question - i have the quota script implemented without any problems so far but now one of my users came over and complaint about all the "Warnings" about his nearly full mailbox. So i jumped on the system and according to the "Size" vs. "Max Size" he was only running on 10% of his mailbox space (he had about 10Mb on a mailbox with max of 100Mb) So the space thing should be fine but the user still got the Warnings.

Any idea where i can check what could cause this? Or force it to recalculate the space? (The System is running on 5.1.2-B346 with a MSSQL Express Database)

thanks!

entropicsinkhole
Normal user
Normal user
Posts: 119
Joined: 2007-05-28 21:10

Re: Send a warning email when user approaches mailbox limit

Postby entropicsinkhole » 2009-11-18 16:16

In case anyone is curious, this script works great with v 5.3 (with Martin's authentication addition, of course)

aty154
New user
New user
Posts: 9
Joined: 2006-05-25 14:45
Location: Pakistan/Karachi
Contact:

Re: Send a warning email when user approaches mailbox limit

Postby aty154 » 2010-06-24 09:44

Email server Information
1)Hmailserver 5.3.2 B1729
2)Windows server 2003
3)500+ email users
4)700+ email Messages

Security Options.

1)No Hmailserver administrator password


I try script provided by Krazy-J, whenever email is send email struck in Delivery queue and log file show following error

Severity: 2 (High), Code: HM4223, Source: DeliveryTask::DoWork, Description: SMTPDeliverer::DeliverMessage() failed"

I try to merge different code of quota notification given on hmailserver forums and uncheck smtp authection check on IP ranges of my computer & Internet but still same error

please anyone tell me what is wrong.

coby
New user
New user
Posts: 12
Joined: 2008-12-04 18:57

Re: Send a warning email when user approaches mailbox limit

Postby coby » 2010-06-24 19:30

can someone post again the script without the existing EventHandlers.vbs

thx

User avatar
mattg
Moderator
Moderator
Posts: 13928
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Send a warning email when user approaches mailbox limit

Postby mattg » 2010-06-25 02:50

I'm not sure I understand what you are asking for and I certainly don't understand why?
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

coby
New user
New user
Posts: 12
Joined: 2008-12-04 18:57

Re: Send a warning email when user approaches mailbox limit

Postby coby » 2010-06-25 18:52

mattg wrote:I'm not sure I understand what you are asking for and I certainly don't understand why?


because the here shown scripts do not work with my mail server

^DooM^
Site Admin
Posts: 13853
Joined: 2005-07-29 16:18
Location: UK

Re: Send a warning email when user approaches mailbox limit

Postby ^DooM^ » 2010-06-25 20:07

Are you running V4 of hmailserver?
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

coby
New user
New user
Posts: 12
Joined: 2008-12-04 18:57

Re: Send a warning email when user approaches mailbox limit

Postby coby » 2010-06-25 20:15

hMailServer 5.3.2 - Build 1769


let me guess, the script does not work with version 5 or? :?

^DooM^
Site Admin
Posts: 13853
Joined: 2005-07-29 16:18
Location: UK

Re: Send a warning email when user approaches mailbox limit

Postby ^DooM^ » 2010-06-25 20:23

Well it is in the hmailserver 4 section for a reason ;)

However

entropicsinkhole wrote:In case anyone is curious, this script works great with v 5.3 (with Martin's authentication addition, of course)


So read the whole thread. there are probably fixes.
If at first you don't succeed, bomb disposal probably isn't for you! ヅ

coby
New user
New user
Posts: 12
Joined: 2008-12-04 18:57

Re: Send a warning email when user approaches mailbox limit

Postby coby » 2010-06-25 20:25

^DooM^ wrote:Well it is in the hmailserver 4 section for a reason ;)


:lol:
sorry is there solution for v5?

Bill48105
Developer
Developer
Posts: 6171
Joined: 2010-04-24 23:16
Location: Michigan, USA

Re: Send a warning email when user approaches mailbox limit

Postby Bill48105 » 2010-06-25 20:41

Yeah, scroll down a little bit & read the rest of what he said.. Supposedly the scripts work with hmail 5 but it might take slight changes as noted in the numerous posts in this thread about it..
Bill
*** ABSENT FROM hMail! Those in IRC know how to find me if urgent. ***
hMailServer build LIVE on my servers: 5.4-B2014050402
Latest test builds: http://www.hmailserver.com/forum/viewtopic.php?f=10&t=21420

coby
New user
New user
Posts: 12
Joined: 2008-12-04 18:57

Re: Send a warning email when user approaches mailbox limit

Postby coby » 2010-06-25 20:49

Bill48105 wrote:Yeah, scroll down a little bit & read the rest of what he said.. Supposedly the scripts work with hmail 5 but it might take slight changes as noted in the numerous posts in this thread about it..
Bill



can someone post the adapted script for the version 5, please :D :D

topper
Normal user
Normal user
Posts: 30
Joined: 2009-10-15 09:23

Re: Send a warning email when user approaches mailbox limit

Postby topper » 2010-08-13 04:40

i had add the script to my hm(version? see my signature 8) ),thanks to upstairs!

two area should be edited to meet your self:

1.User Defined Constants
2.call oApp.Authenticate("Administrator", "111111")

when you test the script,you can turn the Const conDebug = true,then the system will ouput the debug file,it's helpful.

ever times when you edit the script,you should "check syntax",then "reload scripts"

here is my EventHandlers.vbs code:

Code: Select all

'   Sub OnClientConnect(oClient)
'   End Sub

'   Sub OnAcceptMessage(oClient, oMessage)
'   End Sub

'   Sub OnDeliverMessage(oMessage)
Dim DebugLog

'**************User Defined Constants***************************
'Log Directory Where Debug log is stored
Const conLogDir = "D:\hMailServer\Logs\"
'Percentage of space remaining when warning messages get sent
Const conSpaceRemainingWarningAt = 0.8
'Email Address that warning emails appear to be from
Const conSpaceWarningFrom = "system@your.com"
Const conSpaceWarningSubject = "Email storage almost full !!!"
Const conSpaceWarningBody = "--------------------- System Message --------------------\n\nYour mailbox size is [size]/[maxsize] MB (>80% usage).\nIn case you reach 100% you will won't receive new emails!\n\n--------------------- SLF MailServer --------------------"
'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 oApp = CreateObject("hMailServer.Application")
      call oApp.Authenticate("Administrator", "111111")
      Set oDomains = oApp.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
'   End Sub

'   Sub OnBackupFailed(sReason)
'   End Sub

'   Sub OnBackupCompleted()
'   End Sub
Vmware -> Win2003 + hmail.v5.5B + ClamAV.v0.98.4

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-03-08 17:38

v5.3.3-B1879 running here and the script which Topper posted (2010-08-12 22:40) to this topic...

viewtopic.php?p=114244#p114244

...is working great! Thank you very much.

I was hoping that someone may be able to tell me how to send a copy (cc) of the message to a specified account. I'm reasonably certain that the code goes here...

SendMessage conSpaceWarningFrom, Array( oAccount.Address ), conSpaceWarningSubject, messageBody

...but I don't know how to write the code.

Thanks.

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-03-09 17:22

*BUMP*

Any suggestions guys? :)

User avatar
mattg
Moderator
Moderator
Posts: 13928
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Send a warning email when user approaches mailbox limit

Postby mattg » 2012-03-12 14:10

In the Function Sendmessage about two thirds of the way down

Between the lines
oMessage.Body = strBody
oMessage.Save

add this one

oMessage.AddRecipient "Your Name", "name@domain.com"

change the email address and name to your liking.
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-03-12 15:14

mattg wrote:In the Function Sendmessage about two thirds of the way down...


Thanks Matt. After I've tested and tweaked my code I'll post it here in case someone can use it.

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-04-06 20:10

Thanks again for all of the help fellas. Here is my code which is running on 5.3.3 b1879. This code difers a bit from Topper's code post because it sends a extra copy of the email to an additional mail recipient (in my case it send a copy to the company mail administrator).

This code is running on my server and it appears to be functioning Qorrectly. But that's correct with a "Q" so be very Qareful!

Code: Select all

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'***************************************************************
'(From http://www.hmailserver.com/forum/viewtopic.php?f=14&t=2382)
'When you test the script,you can turn the Const conDebug = true,
'then the system will ouput the debug file,it's helpful.
'Every time when you edit the script, you should "check syntax"
'and then "reload scripts"
'***************************************************************

Dim DebugLog

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'USER DEFINED CONSTANTS FOR MAILBOX QUOTA NOTIFICATION
'***************************************************************
'Location of the Log Directory Where Debug log is stored
Const conLogDir = "D:\hMailServer\Logs\"
'Percentage of space remaining when warning messages get sent (.8 = 80%)
Const conSpaceRemainingWarningAt = 0.8
Const strAuthenicateName = "Administrator"
Const strAuthenicatePwd = "MyhMailPassword"
'Email Address that warning emails appear to be send from
Const conSpaceWarningFrom = "admin@MyDomaino.com"
'Name of person to send a copy of the message to someone, maybe the mail administrator
Const strSendCopyToName = "Email Administrator"
'Email address of person to send a copy of the message to someone (maybe the mail administrator?)
Const strSendCopyToEmailAddress = "admin@MyDomain.com"
'Email subject
Const conSpaceWarningSubject = "*WARNING* Your company  email storage is almost full!"
'Email message
Const conSpaceWarningBody = "-------- Start of System Warning Message --------\n\nYour company mailbox size is presently [size] of its [maxsize] MB allowed size (it is now more then 80% full).\n\nIf you reach 100% you will won't be able to receive any new emails.\n\nPlease contact your company email administrator for help with this issue.\n\n--------- End of System Warning Message ---------"
'If True, debug log is created to help debug
Const conDebug = false
'***************************************************************

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'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
'***************************************************************

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'***************************************************************
   '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 QUOTA CHECK & NOTIFICATION
'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
'***************************************************************

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'DISPOSEVARIABLES: CLEAN UP ANY VARIABLES WE MIGHT HAVE BEEN USING
'***************************************************************
Sub DisposeVariables
   DebugLog.Dispose
   Set DebugLog = Nothing
End Sub
'***************************************************************

'*****************************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'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 oApp = CreateObject("hMailServer.Application")
      call oApp.Authenticate(strAuthenicateName,strAuthenicatePwd)
      Set oDomains = oApp.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
'***************************************************************

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'SEND THE MESSAGE
'***************************************************************
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
   'Send a copy of the notification to the administrator
   oMessage.AddRecipient strSendCopyToName, strSendCopyToEmailAddress
   oMessage.Save

   Set oMessage = Nothing
   DebugLog.Log "Exiting SendMessage", DebugLog.DecreaseIndent
End Function
'***************************************************************

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'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
'***************************************************************

'***************************************************************
'MAILBOX QUOTA CHECK & NOTIFICATION
'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
'***************************************************************

Greta
Senior user
Senior user
Posts: 257
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Postby Greta » 2012-12-03 20:23

Is it possible to check the subject of all e-mails on the mailbox if there is already a limit warning message sent earlier?. So the user don’t receiver several limit warnings messages if he is not reading his e-mail for a while.

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-12-04 18:38

This is a very good idea Greta. When this script fires the user will receive a warning each time he/she receives an email. It would be better to send one (1) warning per day imho. However, scripting this is well beyond my Qapabilities. :(

User avatar
mattg
Moderator
Moderator
Posts: 13928
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Send a warning email when user approaches mailbox limit

Postby mattg » 2012-12-05 02:08

running once per day is easy enough, run as a scheduled task, and don't run it inside eventhandlers.vbs

checking the mailbox for specific wording in the subject is also possible.
Iterate though all messages in each folder looking at oMessage.subject http://www.hmailserver.com/documentatio ... ct_message
Just 'cause I link to a page and say little else doesn't mean I am not being nice.
https://www.hmailserver.com/documentation

Greta
Senior user
Senior user
Posts: 257
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Postby Greta » 2012-12-07 20:18

mattg wrote:checking the mailbox for specific wording in the subject is also possible.
Iterate though all messages in each folder looking at oMessage.subject http://www.hmailserver.com/documentatio ... ct_message

Is there may be somewhere an example how to do this? Because scripting this is also well beyond my Qapabilities.....

Greta
Senior user
Senior user
Posts: 257
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Postby Greta » 2012-12-12 20:05

Thanks for the link. It took a while for me to figure it out. But on the scrip this would be something like oAccount.Messages.Item(iMessageIdx).Subject

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-12-12 21:47

Greta wrote:Thanks for the link. It took a while for me to figure it out. But on the scrip this would be something like oAccount.Messages.Item(iMessageIdx).Subject


If you have a working production script would you please post it?

Greta
Senior user
Senior user
Posts: 257
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Postby Greta » 2012-12-13 09:45

No I have not a working script yet. At this moment I only have figured out how to get the subjects…
I don’t know anything about scripting. So it takes a while (trial on error) to get this working.

User avatar
Q2u2
Normal user
Normal user
Posts: 188
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Postby Q2u2 » 2012-12-13 17:49

mattg wrote:running once per day is easy enough, run as a scheduled task, and don't run it inside eventhandlers.vbs...


If you have a dedicated server, Matt's advice is very good and less overhead IMO because the script doesn't fire every time mail is received but rather it runs only once a day as an MS Windows scheduled system task...

Start > All Programs > Accessories > System Tools > Task Scheduler

(Or sumptin' like that dependant on the WinOS you run :? )


Return to “User contributed hMailServer 4 scripts”



Who is online

Users browsing this forum: No registered users and 1 guest