Another Spam Graph – The Impact of Spammers Changing Tactics

Well, Raymond Chen has blown me away with his detail, but I have another take on the whole History of Spam thing – the impact of spammers changing message formats to get past the spam filters.

My curious habit is to count my email into two categories; read vs. unread. This was originally meant to be a measure of the pointless cc: / newsletter / internal announcement stuff I receive everyday; I have Outlook set to mark an eMail as Read only after I have opened it or looked in the Preview pane for more than 10 seconds (Tools, Options, Other, Preview Pane). Note this is running against my internal Outlook account, behind corporate firewall and Spam filter.

700 Days
Click to enlarge ...

The graph shows the 700 days previous to Friday 9/10. It skips weekdays because I didn’t get much internal eMail on the weekend (well, at least when I started) .

Anyhoo, the first signs of trouble were January 2003 – a marked uptick in unread mail due partially to a buggy corporate Spam filtering service. They got it working again, or so they thought, but in the summer of 2002, the amount of Spam that got through the corporate filter started rising steadily. This is roughly when the misspellings (Pain R.eli&ef meds sol%d here) and embedded text and other filter-defeating tricks started.

What I’ve noted is that, even though many say it’s a security risk, I do appreciate the Preview pane that allows me to quickly scan eMail without spending too much time on it. The amount of “real work” spent with eMails (the Read Mail) has been pretty constant, and tools like Spambayes have helped shuffle off this trash out of my way.

The source for my counter is presented below …

[vb] ‘ —– —– —– —– —– —– —– —– —– —– —– —–
‘ Copyright (c) 2005-2006 James P. MacLennan All Rights Reserved
‘ Questions? Comments? Suggestions? Let me know … www.cazh1.com

‘ This program is free software; you can redistribute it and/or modify
‘ it under the terms of the GNU General Public License as published by
‘ the Free Software Foundation; either version 2 of the License, or
‘ (at your option) any later version.

‘ This program is distributed in the hope that it will be useful,
‘ but WITHOUT ANY WARRANTY; without even the implied warranty of
‘ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
‘ GNU General Public License for more details.
‘ —– —– —– —– —– —– —– —– —– —– —– —–

‘ requires a reference to the Microsoft Outlook 8.0 Object Library

Option Explicit

Sub DailyEMailCount()
‘ Given a date / range, count the number of read / unread emails
‘ 12/20/2000 jpm – updated to count for a whole week (loop is a little long)
‘ 12/22/2000 jpm – start counting more outlook object types

Dim olMAPI As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim oldStatusBar

Set olMAPI = GetObject("", "Outlook.Application").GetNamespace("MAPI")
Range("rLastRun").Value = Now
Range("rRead").Value = 0
Range("rUnread").Value = 0
Range("rCalendar").Value = 0

oldStatusBar = Application.StatusBar
Application.DisplayStatusBar = True

‘ Call CountByDate("", olMAPI.Folders("Personal Folders"), "->")
Call CountByDate("", olMAPI.Folders("Mailbox – MacLennan, James"), "->")

Application.DisplayStatusBar = False
Application.StatusBar = oldStatusBar

Beep

Set olMAPI = Nothing

End Sub

Sub CountByDate(sParentName As String, tempfolder As Outlook.MAPIFolder, a$)
‘ Loop thru open folder set, counting read / unread messages

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim sWorkDate As String
Dim dFromDate(10) As Date
Dim dToDate(10) As Date
Dim sCheckString As String ‘ List of folder names to skip
Dim sStatusInit As String
Const STATUS_LEAD = "Counting Outlook transactions ("

sCheckString = "Calendar Tasks Contacts"

sWorkDate = CStr(Range("rDate01").Value)
dFromDate(1) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(1) = CDate(sWorkDate & " 11:59:59 PM")
sWorkDate = CStr(Range("rDate02").Value)
dFromDate(2) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(2) = CDate(sWorkDate & " 11:59:59 PM")
sWorkDate = CStr(Range("rDate03").Value)
dFromDate(3) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(3) = CDate(sWorkDate & " 11:59:59 PM")
sWorkDate = CStr(Range("rDate04").Value)
dFromDate(4) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(4) = CDate(sWorkDate & " 11:59:59 PM")
sWorkDate = CStr(Range("rDate05").Value)
dFromDate(5) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(5) = CDate(sWorkDate & " 11:59:59 PM")
sWorkDate = CStr(Range("rDate06").Value)
dFromDate(6) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(6) = CDate(sWorkDate & " 11:59:59 PM")
sWorkDate = CStr(Range("rDate07").Value)
dFromDate(7) = CDate(sWorkDate & " 12:00:00 AM")
dToDate(7) = CDate(sWorkDate & " 11:59:59 PM")

sStatusInit = STATUS_LEAD & sParentName & "/" & tempfolder.Name & ") "
Application.StatusBar = sStatusInit

‘ If this folder is in the Skip list, then geddoudahere

If InStr(sCheckString, tempfolder.Name) = 0 Then

‘ Count the read / unread in this folder
For j = 1 To tempfolder.Items.Count
Application.StatusBar = Application.StatusBar & "."
If Len(Application.StatusBar) > 100 Then
Application.StatusBar = sStatusInit
End If

‘ Mail Items
If tempfolder.Items(j).Class = olMail Then
For k = 1 To 7
If tempfolder.Items(j).ReceivedTime <= dToDate(k) Then
If tempfolder.Items(j).ReceivedTime >= dFromDate(k) Then
Application.StatusBar = Application.StatusBar & "!"
If tempfolder.Items(j).UnRead Then
Range("rUnread")(k).Value = Range("rUnread")(k).Value + 1
Else
Range("rRead")(k).Value = Range("rRead")(k).Value + 1
End If
End If
End If
Next k
End If

‘ Calendar Items

If (tempfolder.Items(j).Class = olMeetingCancellation) Or (tempfolder.Items(j).Class = olMeetingRequest) Or (tempfolder.Items(j).Class = olMeetingResponseNegative) Or (tempfolder.Items(j).Class = olMeetingResponsePositive) Or (tempfolder.Items(j).Class = olMeetingResponseTentative) Then
For k = 1 To 7
If tempfolder.Items(j).ReceivedTime <= dToDate(k) Then
If tempfolder.Items(j).ReceivedTime >= dFromDate(k) Then
Application.StatusBar = Application.StatusBar & "#"
Range("rCalendar")(k).Value = Range("rCalendar")(k).Value + 1
End If
End If
Next k
End If

Next j

End If

‘ Recurse thru all folders

If tempfolder.Folders.Count Then
For i = 1 To tempfolder.Folders.Count
Call CountByDate(tempfolder.Name, tempfolder.Folders(i), a$ & "->")
Next i
End If

End Sub
[/vb]

This Post Has 0 Comments

Leave a Reply

Your email address will not be published. Required fields are marked *

Related Articles
Digital Transformation Automation

Simple Ways to Quickly Build Valuable Digital Experience

Practical thoughts and examples - how to manufacture time and attention, to get hands-on, relevant skills in new technologies

Read more

3D Printing Requires Wildly Different Thinking

Additive Manufacturing faces slow adoption in most industrial companies due to material costs - and the challenge for designers to think differently about what was previously impossible.

Read more