Post new topic Reply to topic  [ 53 posts ] 
Author Message
 Post subject: Send a warning email when user approaches mailbox limit
PostPosted: 2005-08-12 00:17 
Senior user
Senior user

Joined: 2004-09-25 22:11
Posts: 550
Location: Atlanta, GA
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:
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 = "[email protected]"
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


Top
 Profile  
 
 Post subject:
PostPosted: 2005-08-12 01:22 
Developer
Developer

Joined: 2003-11-21 01:09
Posts: 6304
Location: Sweden
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.. :)


Top
 Profile  
 
 Post subject:
PostPosted: 2005-08-12 02:26 
Senior user
Senior user

Joined: 2004-09-25 22:11
Posts: 550
Location: Atlanta, GA
Quote:
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).


Top
 Profile  
 
 Post subject:
PostPosted: 2005-08-22 23:00 
Developer
Developer

Joined: 2003-11-21 01:09
Posts: 6304
Location: Sweden
> 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:
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?


Top
 Profile  
 
 Post subject:
PostPosted: 2005-08-22 23:16 
Senior user
Senior user

Joined: 2004-09-25 22:11
Posts: 550
Location: Atlanta, GA
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:
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.


Top
 Profile  
 
 Post subject:
PostPosted: 2005-10-29 08:28 
Normal user

Joined: 2004-04-19 03:57
Posts: 133
Location: Canada
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.


Top
 Profile  
 
 Post subject:
PostPosted: 2006-01-03 21:53 
Senior user
Senior user

Joined: 2004-09-25 22:11
Posts: 550
Location: Atlanta, GA
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.


Top
 Profile  
 
 Post subject:
PostPosted: 2006-04-27 20:14 
Normal user

Joined: 2006-04-08 00:27
Posts: 57
Location: Athens/Greece
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.


Top
 Profile  
 
 Post subject:
PostPosted: 2006-06-21 16:44 
New user
New user

Joined: 2005-05-14 07:27
Posts: 1
Location: vietnam
thanks for your post.


Top
 Profile  
 
 Post subject:
PostPosted: 2006-07-02 16:52 
Normal user

Joined: 2006-04-08 00:27
Posts: 57
Location: Athens/Greece
I created CheckQuota.vbs first

Code:
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 = "[email protected]"
         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:
@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.


Top
 Profile  
 
 Post subject:
PostPosted: 2006-08-03 18:21 
Normal user

Joined: 2006-07-19 11:17
Posts: 75
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:
'   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 = "[email protected]"
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)


Top
 Profile  
 
 Post subject:
PostPosted: 2006-08-21 10:00 
Normal user

Joined: 2006-07-19 11:17
Posts: 75
/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)


Top
 Profile  
 
 Post subject:
PostPosted: 2007-04-12 16:11 
New user
New user

Joined: 2007-04-12 15:46
Posts: 9
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.


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-22 19:18 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
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


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-22 19:51 
Developer
Developer

Joined: 2003-11-21 01:09
Posts: 6304
Location: Sweden
Replace the line

Code:
Set oDomains = CreateObject("hMailServer.Domains")


with

Code:
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..)


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-23 03:52 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
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??


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-23 05:05 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
Code:
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 = "[email protected]"
         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?


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-23 07:42 
Developer
Developer

Joined: 2003-11-21 01:09
Posts: 6304
Location: Sweden
Okay, my mistake:
oApp.Authenticate("Administrator", "your-main-hmailserver-password")
with
Call oApp.Authenticate("Administrator", "your-main-hmailserver-password")


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-23 15:51 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
Code:
'   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 = "[email protected]"
const g_sBNSubject = "Backup completed"
const g_sBNRecipientName = "Joshua"
const g_sBNRecipientAddress = "[email protected]"
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 = "[email protected]"
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)"
"


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-23 17:35 
Site Admin
User avatar

Joined: 2005-07-29 16:18
Posts: 13805
Location: UK
Are you sure you are writing the correct admin password in the script?


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-24 00:07 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
100% sure its the correct password because it works fine for the on backup completion script...?


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-24 10:32 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
is it possibly something to do with the Code: (Null) it returns???


Top
 Profile  
 
 Post subject:
PostPosted: 2007-08-26 03:01 
New user
New user

Joined: 2007-08-22 19:17
Posts: 8
any ideas?


Top
 Profile  
 
 Post subject:
PostPosted: 2007-09-11 17:15 
New user
New user

Joined: 2007-09-11 17:12
Posts: 1
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.


Top
 Profile  
 
 Post subject:
PostPosted: 2007-09-11 18:17 
Developer
Developer

Joined: 2003-11-21 01:09
Posts: 6304
Location: Sweden
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.


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2009-07-05 19:54 
New user
New user

Joined: 2009-05-21 13:03
Posts: 10
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 :)


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2009-07-05 20:59 
Developer
Developer

Joined: 2003-11-21 01:09
Posts: 6304
Location: Sweden
Not if nobody requests it in the feature request section...


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2009-07-07 11:06 
New user
New user

Joined: 2009-05-21 13:03
Posts: 10
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!


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2009-11-18 16:16 
Normal user

Joined: 2007-05-28 21:10
Posts: 119
In case anyone is curious, this script works great with v 5.3 (with Martin's authentication addition, of course)


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-24 09:44 
New user
New user

Joined: 2006-05-25 14:45
Posts: 9
Location: Pakistan/Karachi
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.


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-24 19:30 
New user
New user

Joined: 2008-12-04 18:57
Posts: 12
can someone post again the script without the existing EventHandlers.vbs

thx


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 02:50 
Moderator
User avatar

Joined: 2007-06-14 05:12
Posts: 11889
Location: 'The Outback' Australia
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.
Documentation


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 18:52 
New user
New user

Joined: 2008-12-04 18:57
Posts: 12
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


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 20:07 
Site Admin
User avatar

Joined: 2005-07-29 16:18
Posts: 13805
Location: UK
Are you running V4 of hmailserver?

_________________
If at first you don't succeed, bomb disposal probably isn't for you! ヅ


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 20:15 
New user
New user

Joined: 2008-12-04 18:57
Posts: 12
hMailServer 5.3.2 - Build 1769


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


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 20:23 
Site Admin
User avatar

Joined: 2005-07-29 16:18
Posts: 13805
Location: UK
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! ヅ


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 20:25 
New user
New user

Joined: 2008-12-04 18:57
Posts: 12
^DooM^ wrote:
Well it is in the hmailserver 4 section for a reason ;)


:lol:
sorry is there solution for v5?


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 20:41 
Developer
Developer

Joined: 2010-04-24 23:16
Posts: 6163
Location: Michigan, USA
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

_________________
hMailServer build LIVE on my servers: 5.4-B2014050402
Latest test builds: http://www.hmailserver.com/forum/viewtopic.php?f=10&t=21420
Urgent? Bored? JOIN US ON IRC!
DOGE ME: DSqtEcqP3Qv6Tj2XrGNpDmEUkSBcpBsuWk


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-06-25 20:49 
New user
New user

Joined: 2008-12-04 18:57
Posts: 12
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


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2010-08-13 04:40 
New user
New user

Joined: 2009-10-15 09:23
Posts: 26
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:
'   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 = "[email protected]"
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.3.4b1913 + ClamAV.v0.96.5


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-03-08 17:38 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
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.


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-03-09 17:22 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
*BUMP*

Any suggestions guys? :)


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-03-12 14:10 
Moderator
User avatar

Joined: 2007-06-14 05:12
Posts: 11889
Location: 'The Outback' Australia
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", "[email protected]"

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.
Documentation


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-03-12 15:14 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
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.


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-04-06 20:10 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
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:
'***************************************************************
'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 = "[email protected]"
'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 = "[email protected]"
'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
'***************************************************************


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-03 20:23 
Senior user
Senior user

Joined: 2007-01-02 13:23
Posts: 253
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.


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-04 18:38 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
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. :(


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-05 02:08 
Moderator
User avatar

Joined: 2007-06-14 05:12
Posts: 11889
Location: 'The Outback' Australia
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.
Documentation


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-07 20:18 
Senior user
Senior user

Joined: 2007-01-02 13:23
Posts: 253
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.....


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-12 20:05 
Senior user
Senior user

Joined: 2007-01-02 13:23
Posts: 253
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


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-12 21:47 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
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?


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-13 09:45 
Senior user
Senior user

Joined: 2007-01-02 13:23
Posts: 253
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.


Top
 Profile  
 
 Post subject: Re: Send a warning email when user approaches mailbox limit
PostPosted: 2012-12-13 17:49 
Normal user
User avatar

Joined: 2010-08-18 16:29
Posts: 161
Location: USA
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 :? )


Top
 Profile  
 
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 53 posts ] 


Who is online

Users browsing this forum: No registered users and 0 guests



Search for:
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group