I'm seeing the following error in logs\ERROR_hmailserver_2012-04-06.log. I'm afraid I just don't know enough VBScript to fix it. I'm hoping that one of you code wizards will be able to help me fix it...
ERROR_hmailserver_2012-04-06.log:
Code:
"ERROR" 1572 "2012-04-06 09:18:49.648" "Script Error: Source: Microsoft VBScript runtime error - Error: 800A01A8 - Description: Object required: 'DebugLog' - Line: 93 Column: 3 - Code: (null)"
Here is Line: 93 Column: 3 in my EventHandlers.vbs script:
Code:
93 Column: 3: DebugLog.LogWithTimestamp "Entering OnDeliverMessage", DebugLog.IncreaseIndent
This code relates to a script I run which checks to determine if any user's mailbox is approaching their quote and (if true) emails a warning to the user and to the mail administrator. Here is all of the code related to this functionality...
Code:
'BEGIN STUFF NEEDED FOR MAILBOX QUOTA CHECK & NOTIFICATION
'Q2U2 Sez: 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"
'******** 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 = "MyPassword"
'Email Address that warning emails appear to be send from
Const conSpaceWarningFrom = "admin@mydomain.com"
'Name of person to send a copy of the message to someone, maybe the mail administrator
Const strSendCopyToName = "Company Admin"
'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 ontact your\nCompany email administrator for assistance.\n\n--------- End of System Warning Message ---------"
'If True, debug log is created to help debug
Const conDebug = true
'***************************************************************
'***************************************************************
'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
'END STUFF NEEDED FOR MAILBOX QUOTA CHECK & NOTIFICATION
'BEGIN STUFF NEEDED FOR 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 STUFF NEEDED FOR MAILBOX QUOTA CHECK & NOTIFICATION
End Sub
'BEGIN STUFF NEEDED FOR 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
'***************************************************************
'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(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
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
'***************************************************************
'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 STUFF NEEDED FOR MAILBOX QUOTA CHECK & NOTIFICATION