-
Notifications
You must be signed in to change notification settings - Fork 0
/
CheckPhishingTest.bas
101 lines (89 loc) · 2.96 KB
/
CheckPhishingTest.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Attribute VB_Name = "Module1"
Option Explicit
Const PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
Function EvalCurrentItem()
Dim objItem As Object
Set objItem = GetCurrentItem()
If objItem.Class = olMail Then
CheckTest
Else
MsgBox "Class ID " & objItem.Class
End If
Set objItem = Nothing
End Function
Sub CheckTest()
Const TempMsg = "c:\temp\TempEmail.msg"
On Error GoTo ErrorHandler
Dim objMsg As Outlook.MailItem
Dim objExtMsg As Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim iLoc1 As Integer
Dim strHeader As String
Dim strExtHeader As String
Dim bTest As Boolean
Dim fso As Object
Dim objItem As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set objItem = GetCurrentItem()
bTest = False
If TypeName(objItem) = "MailItem" Then
Set objMsg = objItem
With objMsg
strHeader = .PropertyAccessor.GetProperty(PropName)
iLoc1 = InStr(1, strHeader, "X-Testing", 1)
If iLoc1 > 0 Then
MsgBox ("This message has a test email header.")
bTest = True
End If
iLoc1 = InStr(1, strHeader, "X-PHISHTEST", 1)
If iLoc1 > 0 Then
MsgBox ("Just got an phish test email")
bTest = True
End If
If .Attachments.Count > 0 Then
Set objAttachment = .Attachments.item(1)
If objAttachment.Type = olEmbeddeditem Then
objAttachment.SaveAsFile (TempMsg)
Set objExtMsg = CreateItemFromTemplate(TempMsg)
strExtHeader = objExtMsg.PropertyAccessor.GetProperty(PropName)
iLoc1 = InStr(1, strExtHeader, "X-Testing", 1)
If iLoc1 > 0 Then
MsgBox "Contains an attachment with test email header"
bTest = True
End If
iLoc1 = InStr(1, strExtHeader, "X-PHISHTEST", 1)
If iLoc1 > 0 Then
MsgBox "Contains an attachment with phish test message"
bTest = True
End If
If Not bTest Then MsgBox "Contains a normal email attached"
End If
End If
End With
If Not bTest Then
MsgBox ("Normal message. Subject: " & objMsg.Subject)
End If
Else
MsgBox ("item is class: " & objMsg.Class)
End If
If fso.FileExists(TempMsg) Then
fso.DeleteFile TempMsg, True
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub