mail_user_filter

'限制使用者寄發非許可網域的信,若是使用者寄發時會通知他,針對寄信
'郵件寄件者 oMessage.FromAddress
'收件者數量 oMessage.recipients.count
'清除原有的收件者 oMessage.clearrecipients()
'寫一封信oApp= CreateObject("hMailServer.Application")
Sub OnDeliverMessage(oMessage)
   Dim LocalOnlyAccounts(100) '只允許本地帳號
   Dim temprecipients(100)    '收件者帳號
   Dim varDomain              '本地網域
   Dim varAddress
   Dim RejectedAddress        '拒絕位址
   Dim GroupDomains(10)       '集團網域


   varDomain = "a.com.tw"       '網域的名稱
   GroupDomains(0) = "b.com.tw" '公司集團網域1
   GroupDomains(1) = "c.com.tw" '公司集團網域2

   LocalOnlyAccounts(0)= "abc" & "@" & varDomain      '限制使用者1
   'LocalOnlyAccounts(1)= "user2" & "@" & varDomain   '限制使用者2

   RejectedAddress = ""
   For i = 0 to uBound(LocalOnlyAccounts)
      If oMessage.FromAddress = LocalOnlyAccounts(i) then '寄件者,如果是被限制的帳號
         for j = 0 to oMessage.recipients.count -1        '將收件者寫入陣列temprecipients
            temprecipients(j) = oMessage.recipients.item(j).address
         next 'j
         j = 0
         k = oMessage.recipients.count -1
         while j <= k
            If instr(temprecipients(j),"@"& VarDomain) = 0 and _
               instr(temprecipients(j),"@"&GroupDomains(0)) = 0 and _
               instr(temprecipients(j),"@"&GroupDomains(1)) = 0 then '收件者,如果未包含本地的使用者
               l= j
               RejectedAddress = RejectedAddress & temprecipients(l) & VBNewLine
               while l < k
                  temprecipients(l) = temprecipients(l+1)
                  l=l+1
               wend
               temprecipients(k) = ""
               k=k-1
            else
               j=j+1
            end if
         wend
         oMessage.clearrecipients()
         For j = 0 to k
            varAddress = temprecipients(j)
            oMessage.AddRecipient "", varAddress
         Next 'j
         oMessage.save

      End if
   Next 'i

   If RejectedAddress <> "" then      '當發現一些不合法的收件者時,寫一封信告訴他
      dim oApp, newMessage
      dim MessageSubject
      dim MessageRecipientAddress

      Set oApp = CreateObject("hMailServer.Application")

      ' Give this script permission to access all
      ' hMailServer settings.
      Call oApp.Authenticate("Administrator", "AdminPassword")        '使用管理者來驗證

      MessageRecipientAddress = oMessage.FromAddress
      MessageSubject = "自動拒絕的郵件"                   '設定郵件的主旨

      Set newMessage = CreateObject("hMailServer.Message")
      newMessage.From = "自動系統郵件 <admin@a.com.tw>"     '寄件者
      newMessage.FromAddress = "admin@a.com.tw"            '寄件者
      newMessage.Subject = MessageSubject
      newMessage.AddRecipient "", MessageRecipientAddress
      newMessage.Body = "你的郵件主旨: " & oMessage.subject & " 因為你的帳號被限制只能寄信給集團內部的使用者"
      newMessage.Body = NewMessage.body & "所有位於:" & vbNewLine & VarDomain
      for i = 0 to ubound(GroupDomains)
          newMessage.Body = NewMessage.body & GroupDomains(i)
      next

      newMessage.Body = NewMessage.body & vbNewLine & vbNewLine
      newMessage.Body = NewMessage.body & "下面的收寄者不會收到你的信"
      newMessage.Body = NewMessage.body & RejectedAddress
      newMessage.Save
   End if
End Sub