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

标题: exchange2003对指定域名不添加免责条款,对已有免责条款的邮件不添加。 [打印本页]

作者: ringoyang    时间: 2008-12-11 17:28
标题: exchange2003对指定域名不添加免责条款,对已有免责条款的邮件不添加。
今天和同事对公司的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>




欢迎光临 邮件服务器-邮件系统-邮件技术论坛(BBS) (http://bbs.5dmail.cn/) Powered by Discuz! X3.2