SpamHouse

[Fennek]

Hallo,

während mittlere und größere Firmen Email aufwändig auf malware prüfen, könnte es bei kleinen Firmen, Vereinen oder Privaten Verbesserungsbedarf bestehen.

Seit jahrzenten sammelt SpamHouse IP-Adressen von verdächtigen Servern und ermöglicht relativ einfach eine Abfrage.

Der Code ermittelt für die letzte eingegangen EMail die IP-Adresse, schickt diese pre NsLookUp an Spamhouse und wertet die Antwort aus.

Code:

Sub Last_EML_get_IP_SPAMHOUSE()
'https://isc.sans.edu/forums/diary/Querying+Spamhaus+for+IP+reputation/27320/
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.regexp")
Dim NSp: Set NSp = Application.GetNamespace("MAPI")
Dim EML As MailItem, IBx As Folder
Set IBx = NSp.Folders.Item(### Email-Adresse ###).Folders.Item("Posteingang")

Set EML = IBx.Items.GetLast
RegEx.Pattern = "\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}"

Set RR = RegEx.Execute(GetInetHeaders(EML))
aIP = Split(RR(0), ".")
IP = aIP(3) & "." & aIP(2) & "." & aIP(1) & "." & aIP(0)
Debug.Print RR.Count, RR(0), IP
'IP = "222.11.16.196" 'ist gelistet
ret = CreateObject("wscript.shell").exec("nslookup " & IP & ".zen.spamhaus.org").stdout.readall
If InStr(1, ret, "127.0.0") > 0 Then MsgBox "SPAM"
End Sub

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String

    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkMsg.PropertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function

Im Gegensatz zu Excel akzeptierte mein Anti-Virus hier das "WScript.Shell".

(Rhetorische) Frage: Besteht Bedarf für mehr Email-Sicherheit?

mfg