OSEC

Neohapsis is currently accepting applications for employment. For more information, please visit our website www.neohapsis.com or email hr@neohapsis.com
 
From: Agricola (agricolaCHRISCOM.NL)
Date: Thu Mar 21 2002 - 19:30:10 CST

  • Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]

    The security holes in Outlook 2002 inspire to do some checking before
    mails can be opened.

    Outlook 2002 provides the feature to start a VBA subroutine in the Rules
    Wizard. The last rule should be a rule that checks all new email and
    passes it to the procedure listed below. The procedure scans the body of
    the mail for suspicious words if the mail has an HTML format. If the
    mail is found to be suspicious, it is 'flattened', so that is can safely
    be read.
    The email is also moved to a subfolder of Inbox named 'Virus', if this
    folder exists.

    Listing:
    =======

    Public Sub TestMail(opMail As MailItem)
      Dim slBody As String

      If opMail.BodyFormat <> olFormatPlain Then
        slBody = opMail.HTMLBody
        If Contains(slBody, "<object", "<script", "<vbscript", _
          "createobject", "clsid:", "<iframe", "<frame", "cid:", _
          "about:", "javascript:") Then

          'highly suspicious!
          'flatten it
          opMail.BodyFormat = olFormatPlain
          opMail.Body = "SUSPICIOUS MAIL!" & vbCrLf & vbCrLf & slBody

          'move to 'virus' folder, if this folder exists
          On Error Resume Next
          opMail.Move Application.GetNamespace("MAPI"). _
            GetDefaultFolder(olFolderInbox).Folders("virus")
        End If
      End If
    End Sub

    Private Function Contains(spBody, ParamArray spText() As Variant) As
    Boolean
      Dim slText As Variant

      For Each slText In spText()
        If InStr(spBody, slText) Then
          Contains = True
          Exit For
        End If
      Next
    End Function