在Exchange 2000 Server中为SMTP服务注册传输事件接收

Sub IEventIsCacheable_IsCacheable()
'To implement the interface, and return S_OK implicitly
Eng Sub

Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus )
Dim envFlds
Dim colAttachs
Dim iFound
Set envFlds = Msg.EnvelopeFields

If Msg.Subject = "" Or Len(Msg.Subject) < 5 Then iFound = 0
Else
   iFound = Instr(1, Msg.Subject, "VIRUS", 1) ' First position of the word VIRUS
End If

'Check whether the message contains a VBS attachment
Set colAttachs = Msg.Attachments
For Each oAttach in colAttachs
   If Instr(1, oAttach.FileName, "vbs", 1)> 0 Then iFound = 1
Next

If iFound > 0 Then
  'Do not deliver, place message in the Badmail directory.
envFlds ("http://schemas.microsoft.com/cdo/smtpenvelope/messagestatus") = 3
envFlds.Update       'Commit the changes of the message status
'Skip remain event sinks
EventStatus = 1
End If
End Sub