Segue código fonte, instruções nos comentários do código.Código: Selecionar todos
'******************************************************************************************************************************
' Script para alerta da utilização de Quota dos usuários do hMailServer
' Salvar em: C:\Program Files (x86)\hMailServer\Addons\Utilities
' Agendar utilizando o Agendador de Tarefas do Windows e no campo
' Iniciar em, adicionar o caminho C:\Program Files (x86)\hMailServer\Addons\Utilities
' Autoria do usuário ultramedecine do fórum hMailServer - https://hmailserver.com/forum/
' Traduzido por Marcelo Leães do fórum itbr.org - http://itbr.org
'******************************************************************************************************************************
'Porcentagem para disparar o e-mail com o alerta, valor deve ser de 0 à 100
Const conSpaceRemainingWarningAt = 90
'Usuário administrador do hMailServer
Const strAuthenticateName = "Administrator"
'Senha do usuário administrador
Const strAuthenticatePwd = "senhaaqui"
'Nome exibido de quem enviou
Const conSpaceWarningFrom = "E-mail Server"
'Nome exibido no e-mail de cópia
Const strSendCopyToName = "Infraestrutura e-tab"
'E-mail a ser copiado
Const strSendCopyToEmailAddress = "[email protected]"
'Assunto do e-mail
Const conSpaceWarningSubject = "*ALERTA* Caixa de e-mail perto do limite contratado"
'Corpo do e-mail
Const conSpaceWarningBody = "\n\nSua caixa de e-mail atualmente possui [size] MB e ocupa mais de 90% do tamanho contratado: [maxsize] MB.\n\nRemova e-mails antigos ou solicite backup dos mesmos para continuar recebendo e-mails corretamente.\n\nOu acesse o nosso Helpdesk solicitando ajuste no tamanho de sua conta http://helpdesk.e-tab.com.br\n\n-- E-tab Tecnologia - www.e-tab.com.br --"
'Localização do arquivo de log
Dim Log, DebugLog
Const conLogDir = "C:\Program Files (x86)\hMailServer\Logs\"
Const conLogFile = "alerta_quota.txt"
'Habilita recurso de log
Const conLog = true
'Define se deve fazer debug, false para desativar
Const conDebug = true
Set NormalLog = new DebugLogger
Set DebugLog = new DebugLogger
NormalLog.IsEnabled = conLog
DebugLog.IsEnabled = conDebug
Dim oApp
Set oApp = CreateObject("hMailServer.Application")
Call oApp.Authenticate (strAuthenticateName, strAuthenticatePwd)
NormalLog.Log "*********************************************************************************************************************************", null
NormalLog.LogWithTimestamp "Inicio do Script", null
for DomIter=0 to oApp.Domains.Count-1
Set obDomain = oApp.Domains(DomIter)
DebugLog.Log "Analisando domínio : " & obDomain.Name, DebugLog.IncreaseIndent
if obDomain.accounts.count>0 then
for AccountIter=0 to obDomain.accounts.count-1
Set obAccount = obDomain.accounts(AccountIter)
DebugLog.Log "Caixa" & vbTab & obAccount.Address & vbTab & "usa" & vbTab & obAccount.Size & vbTab & "MB de" & vbTab & obAccount.MaxSize & vbTab & "MB utilização em porcentagem" & vbTab & obAccount.QuotaUsed, null
if obAccount.QuotaUsed > conSpaceRemainingWarningAt then
NormalLog.Log "** Alerta de quota para " & obAccount.Address, null
Dim messageBody
messageBody = conSpaceWarningBody
messageBody = Replace( messageBody, "\n", vbCRLF )
messageBody = Replace( messageBody, "[address]", obAccount.Address )
messageBody = Replace( messageBody, "[maxsize]", obAccount.MaxSize )
messageBody = Replace( messageBody, "[size]", obAccount.Size )
DebugLog.Log "** Enviado alerta para " & obAccount.Address, null
SendMessage conSpaceWarningFrom, Array( obAccount.Address ), conSpaceWarningSubject, messageBody
end if
next
end if
DebugLog.Log "Finalizado : " & obDomain.Name, DebugLog.DecreaseIndent
next
NormalLog.LogWithTimestamp "Fim do Script", null
NormalLog.Log "*********************************************************************************************************************************", null
Function SendMessage( strFrom, arrRecipients, strSubject, strBody )
DebugLog.Log "Montando email de alerta: 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.AddRecipient strSendCopyToName, strSendCopyToEmailAddress
oMessage.Save
Set oMessage = Nothing
DebugLog.Log "Montagem do e-mail de alerta concluída", DebugLog.DecreaseIndent
End Function
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 LogFile
LogFile = conLogFile
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
Log "**Erro: Descrição: " & Err.Description & " Severidade: " & apgSeverityError & " Número: " & 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
If intIndentType = DecreaseIndent Then
DecIndent
End If
SET oFs = CreateObject("Scripting.FileSystemObject")
SET oFil = ofs.OpenTextFile( LogDir & LogFile, 8, True)
For i = 0 To Indent
oFil.write(" ")
Next
oFil.WriteLine( strString )
oFil.Close
SET oFil = Nothing
SET oFs = Nothing
If intIndentType = IncreaseIndent Then
IncIndent
End If
End If
End Sub
End Class