hMailServer中文论坛 QQ群:80049760 SSL在线生成 https://www.sssssssss.com/ 临时邮箱 https://www.linshiyouxiang.com

垃圾邮件报告

与hMailServer脚本相关,戳此进入。
回复
头像
Hsia
网站管理员
网站管理员
帖子: 336
注册: 2014年11月26日, 12:41
地址: 上海
联系:

垃圾邮件报告

帖子 Hsia »

使用下面的脚本,运行后总结垃圾邮件,该脚本可以调用任务计划程序每天或者一周一次。这个看你自己。

SpamReport.vbs

代码: 全选

Option Explicit

'   #### CONFIG START ####
   
    Const MESSAGES_FOLDER = "SPAM"                  ' Folder to delete from, case insensitive. Multiple folders can be separated by PIPE | symbol
    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 = "yoursecretpassword"        ' Admin password
    Const HMSSERVER = "localhost"                   ' hMailServer Server (DCOM)
    Const FROM_EMAIL = "system@yourdomain.com"      ' Replace this with the email address you want the Spam Report to come FROM
    Const REPORT_TO_ADMIN = TRUE                    ' Admin receives copy of all users Spam Reports (TRUE or FALSE)
    Const REPORT_TO_EMAIL = "admin@yourdomain.com"  ' Replace this with the ADMIN email address you want the Spam Report to be sent a copy to
   '   #### CONFIG END ####

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

'   Numeric
    Dim NumMsgs, NumChecked, x, y, z, MessageID

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

'   Flags
    Dim ReturnValue : ReturnValue = 0

'    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)
                If oAccount.Active Then
                    AtLeastFound = False
                    Set Message = CreateObject("hMailServer.Message", HMSSERVER)
                    OutputMsgList = ""
                    NumChecked = 0
                    For Each SpamFolder in SearchFolders
                        NumMsgs = 0
                        NumChecked = 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
                                AtleastFound = True
                                FoundFolder = True
                                SpamFolder = z
                                Exit For
                            End If
                        Next
                        If FoundFolder Then
                            Set oMessages  = GetInsideFolders(oAccount.IMAPFolders, SpamFolder)
                            Do While oMessages.Count > (NumChecked)
                                Set oMessage = oMessages.Item(NumChecked)
                                NumMsgs = oMessages.Count
                                NumChecked = NumChecked + 1
                                If CLng(oMessage.ID) > 0 Then
                                   OutputMsgList = OutputMsgList & "<tr><td>" & oMessage.FromAddress & "</td>"
                                   OutputMsgList = OutputMsgList & "<td>" & oMessage.Date & "</td>"
                                   OutputMsgList = OutputMsgList & "<td>" & oMessage.Subject & "</td></tr>"
                                End If
                            Loop
                        End If
                    Next
                    If AtLeastFound then
                        OutputMsg = "<font face=""Calibri"">Account: " & oAccount.Address & "<br><br>The following " & NumChecked & _
                        " messages are currently held in your Spam mail folder """ & MESSAGES_FOLDER & """.<br><br>"
                        If NumChecked > 0 then
                            OutputMsg = OutputMsg & "<table><tr><td><b>From</b></td><td><b>Date</b></td><td><b>Subject</b></td></tr>" & vbCrLf & OutputMsgList
                            OutputMsg = OutputMsg & "</table>" & vbCrLf
                        End If
                    Else
                        OutputMsg = "<tr>""" & MESSAGES_FOLDER & """ folder Not Found in account " & oAccount.Address   & "</tr>"
                    End If
                    Message.HeaderValue("Message-ID") = "<" & CreateGUID & ">"
                    Message.FromAddress = FROM_EMAIL
                    Message.From = "Spam Report Daemon <"& FROM_EMAIL & ">"
                    If REPORT_TO_ADMIN then
                        Message.AddRecipient "System Administrator", REPORT_TO_EMAIL
                    End If
                    Message.AddRecipient oAccount.Address , oAccount.Address
                    Message.Subject = "Spam Report - " & oAccount.Address
                    Message.HTMLBody = OutputMsg
                    Message.Save
                End If
            Next
        End If
    Next

    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
jimmy
Level 2
Level 2
帖子: 8
注册: 2014年11月26日, 16:28

Re: 垃圾邮件报告

帖子 jimmy »

期待你整个自动识别垃圾邮件方法出来,自带的用不习惯
jasonshaw
Level 3
Level 3
帖子: 34
注册: 2015年5月6日, 11:16

Re: 垃圾邮件报告

帖子 jasonshaw »

不知道怎么用,现在好不容易能收发邮件了
但是现在仅能收外部邮件,却不能发送外部邮件
回复