|
今天和同事对公司的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> |
|