ORF反垃圾邮件系统

邮件服务器-邮件系统-邮件技术论坛(BBS)

 找回密码
 会员注册
查看: 3617|回复: 0
打印 上一主题 下一主题

[经验] exchange2003对指定域名不添加免责条款,对已有免责条款的邮件不添加。

[复制链接]
跳转到指定楼层
顶楼
发表于 2008-12-11 17:28:36 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
今天和同事对公司的exchange邮件服务器的免责条款的脚本进行了修改。
主要实现功能有
1.对指定域名的邮件不添加免责条款。
2. 对已有的免责条款的电子邮件不添加免责条款。通过判断免责条款中的一个字符串的值来决定,发现一个问题,若字符串中有空格则不能成功。也希望有高手能解决。
脚本如下:
<SCRIPT LANGUAGE="VBScript">
Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus)
On Error Resume Next
   Dim text1,text2,text3,strtomail,mypos,mypos1,bodytxt
if Msg.HTMLBody<>"" then
bodytxt=Msg.HTMLBody
mypos1=instr(1,bodytxt,"DISCLAIMER(domainname):",vbTextCompare)
end if
if Msg.TextBody<>"" then
bodytxt=Msg.TextBody
mypos1=instr(1,bodytxt,"DISCLAIMER(domainname):",vbTextCompare)
end if
if mypos1=0 then
   text1="DISCLAIMER(domainname):" & vbCrLf & "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
   text2="aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
   text3=" aaaaaaaaaaaa"
   TextDisclaimer = vbCrLf & text1 & vbCrLf & text2 & vbCrLf &text3
   HTMLDisclaimer = "<p></p><font style='font-size:13px;'><p>" &text1& "<br><br>" & text2 & "<br><br>" &text3&"</p></font>"
   mypos=0
   mypos1=0
   mypos2=0
   strtomail=msg.to+msg.cc+msg.bcc
   op = 1
   mypos = InStr(op, strtomail, "@")
   Do
   
   name1 = Mid(strtomail, mypos + 1, 3)
   name2 = Mid(strtomail, mypos + 1, 4)
   name3 = Mid(strtomail, mypos + 1, 5)
   
   If  name1 = "163" Or name2 = "sina" Or name3 = "china"  then
   distf = False
   Else
   distf = True
   Exit Do
   End If
   op = mypos + 1
   mypos = InStr(op, strtomail, "@")
   
   Loop Until mypos = 0
   if distf=true then
   If Msg.HTMLBody <> "" Then
      'Search for the "</body>" tag and insert our discliamer before that tag.
      pos = InStr(1, Msg.HTMLBody, "</body>", vbTextCompare)
      szPartI = Left(Msg.HTMLBody, pos - 1)
      szPartII = Right(Msg.HTMLBody, Len(Msg.HTMLBody) - (pos - 1))
      Msg.HTMLBody = szPartI + HTMLDisclaimer + szPartII
   End If
   If Msg.TextBody <> "" Then
      Msg.TextBody = Msg.TextBody & vbCrLf & TextDisclaimer & vbCrLf
   End If
   
   'Commit the content changes to the transport ADO Stream object.
   Msg.DataSource.Save ' Commit the changes into the transport Stream
   pEventStatus = cdoRunNextSink
   end if
end if
End Sub
</SCRIPT>
您需要登录后才可以回帖 登录 | 会员注册

本版积分规则

小黑屋|手机版|Archiver|邮件技术资讯网

GMT+8, 2024-12-24 10:40

Powered by Discuz! X3.2

© 2001-2016 Comsenz Inc.

本论坛为非盈利中立机构,所有言论属发表者个人意见,不代表本论坛立场。内容所涉及版权和法律相关事宜请参考各自所有者的条款。
如认定侵犯了您权利,请联系我们。本论坛原创内容请联系后再行转载并务必保留我站信息。此声明修改不另行通知,保留最终解释权。
*本论坛会员专属QQ群:邮件技术资讯网会员QQ群
*本论坛会员备用QQ群:邮件技术资讯网备用群

快速回复 返回顶部 返回列表