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.
Post Reply
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

Post by 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: 6846
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by 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:

Post by 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: 6846
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by 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:

Post by 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

Post by 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:

Post by 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:

Post by 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:

Post by 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:

Post by 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

Post by 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

Post by 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

Post by 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

Post by 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: 6846
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by 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

Post by 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

Post by 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: 6846
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by 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

Post by 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: 13861
Joined: 2005-07-29 16:18
Location: UK

Post by ^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

Post by 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

Post by 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

Post by Krazy-J » 2007-08-26 03:01

any ideas?

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

Post by 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: 6846
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Post by 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

Post by 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: 6846
Joined: 2003-11-21 01:09
Location: Sweden
Contact:

Re: Send a warning email when user approaches mailbox limit

Post by 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

Post by boogieman » 2009-07-07 11:06

i found this in the archived requests : http://www.hmailserver.com/forum/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

Post by 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

Post by 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

Post by coby » 2010-06-24 19:30

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

thx

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

Re: Send a warning email when user approaches mailbox limit

Post by 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

Post by 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: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Send a warning email when user approaches mailbox limit

Post by ^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

Post by 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: 13861
Joined: 2005-07-29 16:18
Location: UK

Re: Send a warning email when user approaches mailbox limit

Post by ^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

Post by 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: 6192
Joined: 2010-04-24 23:16
Location: Michigan, USA

Re: Send a warning email when user approaches mailbox limit

Post by 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
hMailServer build LIVE on my servers: 5.4-B2014050402
#hmailserver on FreeNode IRC https://webchat.freenode.net/?channels=#hmailserver
*** ABSENT FROM hMail! Those in IRC know how to find me if urgent. ***

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

Re: Send a warning email when user approaches mailbox limit

Post by 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: 50
Joined: 2009-10-15 09:23

Re: Send a warning email when user approaches mailbox limit

Post by 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
ESXi -> hmail.v5.6.9B2607 + ClamAV + SpamAssassin

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

Re: Send a warning email when user approaches mailbox limit

Post by 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...

http://www.hmailserver.com/forum/viewto ... 44#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: 190
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Post by Q2u2 » 2012-03-09 17:22

*BUMP*

Any suggestions guys? :)

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

Re: Send a warning email when user approaches mailbox limit

Post by 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: 190
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Post by 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: 190
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Post by 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: 339
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Post by 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: 190
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Post by 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: 22437
Joined: 2007-06-14 05:12
Location: 'The Outback' Australia

Re: Send a warning email when user approaches mailbox limit

Post by 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: 339
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Post by 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: 339
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Post by 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: 190
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Post by 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: 339
Joined: 2007-01-02 13:23
Contact:

Re: Send a warning email when user approaches mailbox limit

Post by 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: 190
Joined: 2010-08-18 16:29
Location: USA

Re: Send a warning email when user approaches mailbox limit

Post by 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 :? )

Post Reply