hMailServer中文论坛

代码: 全选

'  Routine empties the TRASH folders (Zero days retained) and is called by scheduler
'  in the backup script

Option Explicit

'   Routine empties the TRASH folders (Zero days retained) and is called by scheduler in the backup script

'   #### CONFIG START ####
    Const DAYS_TO_KEEP_MESSAGES = "3"            ' Days old to keep mails
    Const MESSAGES_FOLDER = "trash"               ' Folder to delete from, case insensitive, subfolder delimiter needs to be as
                                                    ' below (.) based on ur delimiter setting in hmailserver, multiple fodlers can
                                                    ' be specified seprated by | (pipe)  eg: "spam|trash|deleted messages|deleted
                                                    ' items|junk e-mail"
    Const IMAP_DELIMITER = "."                      ' This needs to be same as what u used above for subfodlers based on delimiter
                                                    ' setting in hmailserver
    Const HMSADMINUSER = "Administrator"            ' Admin username
    Const HMSADMINPWD = "888888"               ' Admin password
    Const HMSSERVER = "localhost"           ' hMailServer Server (DCOM)
    Const FROM_EMAIL = "system@hmailserver.net"       ' Replace this with the email address you want the report to come from
    Const REPORT_TO_EMAIL = "admin@hmailserver.net"   ' Replace this with the email address you want the report to be sent to
'   #### CONFIG END ####


'   Objects
    Dim oApp, oDomains, oDomain, oAccounts, oAccount, oMessages, oMessage

'   Numeric
    Dim AccountSize, NumMsgs, NumDeleted, iMessages, x, y, z, MessageID, DeleteCount, LoopCount

'   Strings / arrays
    Dim SearchFolders, FindFolders, FoundFolder, FolderList, aFolder, SpamFolder
    Dim Message, CreateGUIDval, OutputMsg, w

'   Flags
    Dim Skipped, ReturnValue : ReturnValue = 0

'   Date / time
    Dim MessageDate

'    On Error Resume Next

    SearchFolders = Split(MESSAGES_FOLDER, "|")

    Set oApp = CreateObject("hMailServer.Application", HMSSERVER)
    Call oApp.Authenticate(HMSADMINUSER, HMSADMINPWD)

    For x = 0 To oApp.Domains.Count - 1
        Set oDomain = oApp.Domains.Item(x)
        If oDomain.Active Then
            For y = 0 To oDomain.Accounts.Count - 1
                Set oAccount = oDomain.Accounts.Item(y)
                OutputMsg = OutputMsg & "<tr><td colspan=" & Chr(34) & "5" & Chr(34) & ">&nbsp;</td></tr>" & vbCrLf
                If oAccount.Active Then
                    Skipped = ""
                    For Each SpamFolder in SearchFolders
                        AccountSize = 0
                        NumMsgs = 0
                        NumDeleted = 0
                        Set FindFolders = oAccount.IMAPFolders
                        FoundFolder = False
                        FolderList = ListFolders(FindFolders, 0, "")
                        aFolder = Split(Left(FolderList, Len(FolderList) - 1), "|")
                        For Each z in aFolder
                            If UCase(z) = UCase(Trim(SpamFolder)) Then
                                FoundFolder = True
                                SpamFolder = z
                                Exit For
                            End If
                        Next
                        If FoundFolder Then
                            Set oMessages  = GetInsideFolders(oAccount.IMAPFolders, SpamFolder)
                            NumMsgs = oMessages.Count
                            iMessages = 0
                            DeleteCount = 0
                            LoopCount = 0
                            Do While oMessages.Count > (LoopCount - DeleteCount)
                                Set oMessage = oMessages.Item(iMessages)
                                AccountSize = AccountSize + oMessage.Size
                                MessageDate = oMessage.InternalDate
                                If (MessageDate < CDate(Now - DAYS_TO_KEEP_MESSAGES)) Then
                                    If CLng(oMessage.ID) > 0 Then
                                        NumDeleted = NumDeleted + 1
                                        DeleteCount = DeleteCount + 1
                                        WScript.Echo "Executing oMessages.DeleteByDBID(oMessage.ID) :: iMessages = " & iMessages & " oMessage.ID = " & CLng(oMessage.ID)
                                        oMessages.DeleteByDBID(oMessage.ID)
                                    Else
                                        WScript.Echo "iMessages = " & iMessages & " oMessage.ID = " & CLng(oMessage.ID)
                                        Skipped = " *"
                                        ShowError("--->  Delete failed  <---")
                                    End If
                                Else
                                    iMessages = iMessages + 1
                                End If
                                If oMessages.Count = (NumMsgs - DeleteCount) Then
                                    LoopCount = LoopCount + 1
                                Else
                                    NumMsgs = oMessages.Count
                                    iMessages = 0
                                    DeleteCount = 0
                                    LoopCount = 0
                                End If
                            Loop

                            WScript.Echo "Removed " & NumDeleted & " message(s) from " & SpamFolder & " folder in account " & oAccount.Address & vbCrLf
                            OutputMsg = OutputMsg & "<tr><td>" & oAccount.Address & "</td>"
                            OutputMsg = OutputMsg & "<td>" & SpamFolder & "</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumMsgs, 0, True, False, True) & "</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(AccountSize, 0, True, False, True) & "K</td>"
                            OutputMsg = OutputMsg & "<td align=" & Chr(34) & "right" & Chr(34) & ">" & FormatNumber(NumDeleted, 0, True, False, True) & Skipped & "</td></tr>" & vbCrLf
                        Else
                            WScript.Echo SpamFolder & " folder Not Found in account " & oAccount.Address
                        End If
                    Next
                End If
            Next
        End If
    Next

    OutputMsg = "<font face=" & Chr(34) & "Calibri" & Chr(34) & "><table border=" & Chr(34) & "1" & Chr(34) & "><tr><td><b>Email Account</b></td><td><b>Folder</b></td><td><b>Mail Count</b></td><td><b>Mail Size</b></td><td><b>Deleted</b></td></tr>" & vbCrLf & OutputMsg
    OutputMsg = OutputMsg & "</table>" & vbCrLf

    Set Message = CreateObject("hMailServer.Message", HMSSERVER)
    Message.HeaderValue("Message-ID") = "<" & CreateGUID & ">"
    Message.FromAddress = FROM_EMAIL
    Message.From = "Email Clearup Daemon <"& FROM_EMAIL & ">"
    Message.AddRecipient "System Administrator", REPORT_TO_EMAIL 
    Message.Subject = "Email Clearup deletion report"
    Message.HTMLBody = OutputMsg
    Message.Save

    Wscript.Quit ReturnValue

    Function ShowError(strMessage)
        WScript.Echo strMessage
        WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " &  Err.Description
        ReturnValue = Err.Number
   Err.Clear
    End Function

    Function ListFolders(obFolders, iRecursion, rootFolder)
        iRecursion = iRecursion + 1
        Dim sMessage
        Dim i
        For i = 0 To obFolders.Count -1
            Dim obFolder
            Set obFolder = obFolders.Item(i)
            If iRecursion > 1 Then
                sMessage = sMessage & rootFolder & IMAP_DELIMITER & obFolder.Name & "|"
            Else
                sMessage = sMessage & obFolder.Name & "|"
            End If
            sMessage = sMessage & ListFolders(obFolder.SubFolders, iRecursion,  obFolder.Name)
        Next
        iRecursion = iRecursion -1
        ListFolders = sMessage
    End Function

    Function GetInsideFolders(obFolders2, subFolders)
        Dim iRecursion2
        iRecursion2 = 1
        Dim SeprateFodlers
        SeprateFodlers = Split(subFolders, IMAP_DELIMITER)
        For Each w in SeprateFodlers
            If iRecursion2 = 1 Then
                Set obFolders2 = obFolders2.ItemByName(w)
                iRecursion2 = iRecursion2 + 1
            Else
                Set obFolders2 = obFolders2.SubFolders.ItemByName(w)
            End If
        Next
        Set GetInsideFolders = obFolders2.Messages
    End Function

    Function CreateGUID()
        ' Generate a random string.
        With CreateObject("hMailServer.Utilities", HMSSERVER)
            CreateGUID = Mid(.GenerateGUID, 2, 36) & "@randommail"
        End With
    End Function