2007.05.11 08:38:27 Update: I no longer recommend or use SpamCOP. Thier MailHosts configuration has become more and more conviluted and confusing, the "user to user" help forum is sometimes quite rude and thier developers are uninterested in improving the user experience. For example, when registering a mailhost, there is an ID number in the header that must match the ID in the body of the email they send. Some MTA (including ASSP) pad header lines with spaces (which, as far as I can see, does not violate any RFQ), but this causes the match to fail because they do not trim the spaces before compairing the values. Despite the fact that there is a well visited, sticky post on thier forum explaining the issue, the developers appear totally unwilling to take the few seconds it would require to add an RTRIM to the header parsing script. Even after manually trimming the values, the resulting MailHosts listing apparently shows every domain ever registered to your IP address rather than your current domain or RIP. This is confusing at best and is not mentioned in any documentation I could find. combined with the fact that SpamCOP keeps blocking innocent gmail users leads me to believe that since IronPort took over, SpamCOP has gone to heck. Use This pages remains for historical purposes.
A VBS SPAM reporting script for MS Outlook automatically do all the reporting for emails that I see ARE SPAM and that I place in a "spam" folder in Outlook.
It will report the spam to spamcop.net, retrieve the result, extract the form elements, approve the default options and actually trigger the sending of the spam reports. It will then log the result, move the message to an "oldspam" folder and go on to the next spam.
The idea is that as spam comes in, I just move it to the spam
folder. At night, a scheduled job runs this script via the command line
cscript ol-spam-rpt.vbs //Nologo >>
spamlog.html
and logs the results. I don't think spam reporting can get any easier...
With the recent security "upgrades" my MS, I can't do it at night anymore..
I have to answer this stupid little box:
This is now a
project...
http://sourceforge.net/projects/ol-vbs-spam-rpt/
as
is was spamcop
http://sourceforge.net/projects/spamcop/
Keep in mind that you must have the Collaborative Data Objects option installed with Outlook. If you run the installer for Outlook or Office, go into the advanced options, you will find this item.
2004.12.21 Now incorporates past (unreported) spams and works with any sort of SpamCop account.
ol-spam-rpt.vbs:
function urlenc(astr)
dim i, c, e
for i = 1 to len(astr)
c = mid(astr,i,1)
if C = " " then
urlenc = urlenc & "+"
elseif (c >= "0" and C <= "9") or (c >= "a" and C <= "z") or (c >= "A" and C <= "Z") then
urlenc = urlenc & c
else
urlenc = urlenc & "%" & right( "00" & hex( asc(c) ) , 2)
end if
next
end function
'wscript.stdout.write urlenc(")(ABC* & * ^ $^%$*&)(*")
function GetHTMLAttrib(anAttrib, aString)
GetHTMLAttrib = ""
on error resume next
GetHTMLAttrib = split(aString,anAttrib&"=")(1)
if left(GetHTMLAttrib,1)=chr(34) then GetHTMLAttrib = mid(GetHTMLAttrib,2)
if instr(GetHTMLAttrib,"""")>0 then GetHTMLAttrib = split(GetHTMLAttrib,"""")(0)
end function
wscript.stdout.write chr(13)&chr(10)&"<P> <A TITLE="&chr(34)&"Started:"&Now()&chr(34)&">-</A>"
olFolderInbox = 6
'Set objXhttp = Wscript.CreateObject("Msxml2.ServerXMLHTTP.4.0")
'ServerXMLHTTP.4.0 doesn't seem to be able to post data to the site.
Set objhttp = Wscript.CreateObject("Microsoft.XmlHttp")
wscript.stdout.write "<A TITLE="&chr(34)&"Got XMLHTTP"&chr(34)&">-</A>"
Set objSession = Wscript.CreateObject("MAPI.Session")
objSession.Logon , , False, False
wscript.stdout.write "<A TITLE="&chr(34)&"Got MAPI.Session"&chr(34)&">-</A>"
Set ol = Wscript.CreateObject("Outlook.Application")
wscript.stdout.write "<A TITLE="&chr(34)&"Got Outlook.Application"&chr(34)&">-</A>"
Set olns = ol.GetNameSpace("MAPI")
wscript.stdout.write "<A TITLE="&chr(34)&"Got MAPI Namespace"&chr(34)&">-</A>"
Set MyFolder = olns.GetDefaultFolder(olFolderInbox).Folders("spam")
wscript.stdout.write "<A TITLE="&chr(34)&"Got SPAM folder"&chr(34)&">-</A>"
Set myDestFolder = MyFolder.Folders("oldspam")
wscript.stdout.write "<A TITLE="&chr(34)&"Got oldspam folder"&chr(34)&">-</A>"
Set fs = CreateObject("Scripting.FileSystemObject")
' Get the number of items in the folder.
NumItems = MyFolder.Items.Count
' Set MyItem to the collection of items in the folder.
Set MyItems = MyFolder.Items
DIM myMsgs()
REDIM PRESERVE myMsgs(NumItems)
I = 0
for each myItem in MyItems
I = I + 1
wscript.stderr.WriteLine I & " " & myItem.Subject
set myMsgs(I) = myItem
next
' Loop through all of the items in the folder.
For I = 1 to NumItems
'for each myMsg in myMsgs
Set MyMsg = MyMsgs(I)
if datediff( "d", MyMsg.ReceivedTime, now() ) >= 3 then
wscript.stderr.write chr(13)&chr(10)&" - "&myMsg.ReceivedTime & " " & chr(34)& myMsg.Subject & chr(34) & " TOO OLD!"
MyMsg.Delete
else
strEntryID = MyMsg.EntryID
wscript.stdout.write chr(13)&chr(10)&"<P> <A TITLE="&chr(34)&strEntryID&chr(34)&">-</A>"
strStoreID = MyMsg.Parent.StoreID
Set objCDOMsg = objSession.GetMessage(strEntryID, strStoreID)
' Set myStream = objCDOMsg.GetStream 'don't work in OL98
' myStr = ""
' j = 1
' for each myfield in objCDOMsg.Fields
' if myField.ID = 8192030 then
' myStr = myStr & chr(13)&chr(10) & j & myField.Name & "(" & myField.ID&")"&"-" &myfield.Value
' end if
' MsgBox MyMsg.Subject & myStr
' myStr = ""
' j = j + 1
' next
' MsgBox MyMsg.Subject & myStr
on error resume next
mySubject = split(myMsg.Subject & "**SPAM ", "**SPAM")(0)
wscript.stderr.write chr(13)&chr(10)&" - "&myMsg.ReceivedTime &" " &datediff( "d", MyMsg.ReceivedTime, now() )& " " & chr(34)& mySubject & chr(34) & " "
wscript.stdout.write "<B>"&MyMsg.ReceivedTime & " </B><I>"""&mySubject&"""</I>"
myStr = objCDOMsg.Fields.Item(8192030) 'this is the raw headers
myStr = replace(myStr, myMsg.Subject, mySubject)
myStr = replace(myStr, "Post.Office MTA v3.5.3", "MetaMail v1.2" )
myStr = myStr & chr(13)&chr(10) & objCDOMsg.Fields.Item(269680670) 'this is the raw html (only for HTML encoded messages)
on error goto 0
myStr = myStr & objCDOMsg.Text 'this is the raw text
truncatemsg = chr(13)&"[truncated by SpamCop]"&chr(13)
if len(myStr)>50000 then myStr = left(myStr, 50000-len(truncatemsg))&truncatemsg
' myStr = "action=submit&oldverbose=&spam="&myStr&"&submit=x1"
myStr = "action=submit&oldverbose=1&spam="&urlenc(myStr)&"&submit=x1"
Set a = fs.CreateTextFile("spam0.txt", True)
a.Write(myStr)
a.Close
startTime = Now()
wscript.stdout.write "<A TITLE="&chr(34)&"askspamcop"&chr(34)&">-</A>"
' wscript.stdout.write urlenc(myStr)
' objhttp.open "POST", "http://mailsc.spamcop.net/sc", FALSE, "jamesnewton@spamcop.net", "password"
objhttp.open "POST", "http://www.spamcop.net/sc", FALSE
'http://spamcop.net?code=CBxs1Qp8k8mTE5mm
objhttp.setRequestHeader "EncodeingType", "multipart/form-data"
objhttp.setRequestHeader "ContentType", "text/plain"
objhttp.send(myStr)
myStr = objhttp.responseText
ID = GetHTMLAttrib("/sc?id",myStr)
wscript.stderr.write " id='"&ID&"'"
Set a = fs.CreateTextFile("spam1.txt", True)
a.WriteLine("ID: "&ID&chr(13)&chr(10) )
' a.WriteLine(objhttp.statusText)
' a.WriteLine(objhttp.getOption(-1))
'getOption(-1) returns the actual URL *after* the redirection
'but generates an error with Microsoft.XmlHttp object
' a.WriteLine(chr(13)+chr(10))
' a.WriteLine(objhttp.getAllResponseHeaders())
a.WriteLine(myStr)
a.Close
dResp = datediff("s",startTime,now())
wscript.stdout.write "<A TITLE="&chr(34)&"id="&ID&" in "&dResp&"s"&chr(34)&">-</A>"
if dResp > 45 then
wscript.stderr.write " Spamcop is loaded. Reply took:"& dResp &" seconds. Try later."
wscript.quit
end if
while ID = Empty and dResp < 120
wscript.stderr.write " Waiting for un-reported"
wscript.stdout.write "<A TITLE="&chr(34)&"backthen="&backthen&chr(34)&">-</A>"
backthen = now()
tick = now()
do
if DateDiff("s",tick,now()) > 0 then
tick = now()
wscript.stderr.write "."
end if
loop while DateDiff("s",backthen,now()) < 10
wscript.stdout.write "<A TITLE="&chr(34)&"now()="&now()&chr(34)&">-</A>"
objhttp.open "GET", "http://www.spamcop.net", FALSE
objhttp.send("")
myStr = objhttp.responseText
ID = GetHTMLAttrib("/sc?id",myStr)
wscript.stderr.write " id='"&ID&"'"
Set a = fs.CreateTextFile("spam2.txt", True)
a.WriteLine("ID: "&ID&chr(13)&chr(10) )
' a.WriteLine(objhttp.statusText)
' a.WriteLine(objhttp.getOption(-1)) 'getOption(-1) returns the actual URL *after* the redirection
' a.WriteLine(objhttp.getAllResponseHeaders())
a.Write(myStr)
a.Close
dResp = datediff("s",startTime,now())
wend
if instr(myStr, "spamid")<1 AND ID<>Empty then 'go get the past report
wscript.stderr.write " Getting saved report"
objhttp.open "GET", "http://www.spamcop.net/sc?id="&ID, FALSE, "jamesnewton@spamcop.net", "password"
objhttp.send("")
myStr = objhttp.responseText
Set a = fs.CreateTextFile("spam3.txt", True)
a.Write(myStr)
a.Close
end if
myStr = split(myStr&ID&" ", ID,2)(1)
wscript.stderr.write ". Reporting to: "
if instr(myStr, "spamid")>0 then
' myStr = "<input type=""hidden"" name=""action"" value=""flexsend"">"
sendStr = ""
urlStr = "http://www.spamcop.net"
for each myStr in split(replace(myStr,"<","><"),">") '>
if left(myStr,1) = "<" then
if instr(1, myStr, "action=display", 1) > 0 then
idLinkStr = replace(urlStr & GetHTMLAttrib("href", myStr),"&action=display","")
end if
select case ucase(split(mid(myStr,2))(0))
case "FORM"
urlAction = GetHTMLAttrib("action", myStr)
if left(urlAction,4)="http" then urlStr = urlAction else urlStr = urlStr & urlAction
methodStr = ucase(GetHTMLAttrib("method", myStr))
case "INPUT"
typeStr = GetHTMLAttrib("type", myStr)
if typeStr = "checkbox" and instr(1,myStr, "checked",1)>0 then
sendStr = sendStr &"&"&GetHTMLAttrib("name", myStr) &"="
sendStr = sendStr &"on"
elseif typeStr = "submit" then
' if GetHTMLAttrib("name",myStr) = empty then
' sendStr = sendStr &"&submit="
' sendStr = sendStr &urlenc(GetHTMLAttrib("value", myStr))
' end if
elseif instr(myStr,"imaphost.com") then
wscript.stderr.write "NOT Cybervalince "
else
sName = GetHTMLAttrib("name", myStr)
sendStr = sendStr &"&"&sName&"="
sValue = GetHTMLAttrib("value", myStr)
sendStr = sendStr &urlenc(sValue)
if sName = "source" then wscript.stdout.write chr(13)&chr(10)&"<BR>Source:"&sValue
if instr(sValue, "@") then wscript.stderr.write sValue&"; "
end if
case "TEXTAREA"
sendStr = sendStr &"&"&GetHTMLAttrib("name", myStr) &"="
case "SELECT"
case "OPTION"
case "/SELECT"
case "/FORM"
case else
end select
else
end if
next
wscript.stdout.write chr(13)&chr(10)&"<BR><A HREF="""&idLinkStr&""">"&idLinkStr&"</A>"
objhttp.open methodStr, urlStr, FALSE, "jamesnewton@spamcop.net", "password"
' objhttp.open methodStr, urlStr, FALSE, "", ""
' objhttp.setRequestHeader "ContentType", "application/x-www-form-urlencoded"
' objhttp.setRequestHeader "ContentType", "text/html;charset=UTF-8"
objhttp.setRequestHeader "ContentType", "multipart/form-data"
objhttp.send(mid(sendStr,2))
myStr = objhttp.responseText
Set a = fs.CreateTextFile("spamrep.txt", True)
a.WriteLine(methodStr)
a.WriteLine(urlStr)
a.WriteLine(mid(sendStr,2)&chr(13)&chr(10))
a.WriteLine(objhttp.statusText&chr(13)&chr(10))
' a.WriteLine(objhttp.getAllResponseHeaders())
a.Write(myStr)
a.Close
myStr = split(myStr, "<p>")(1)
wscript.stdout.write chr(13)&chr(10)&"<BR>"&myStr&"</P>"
else
wscript.stdout.write chr(13)&chr(10)&"Rejected: <BR>"
wscript.stderr.write chr(13)&chr(10)&"Rejected"
e=instr(1,myStr, "<p>"&chr(10)&"<font color=""red"">",1)
if e > 0 then wscript.stdout.write split(mid(myStr,e)&"</font> ","</font>")(0)&"</font>"
e=instr(1,myStr, "error:",1)
if e > 0 then
wscript.stdout.write split(mid(myStr,e)&"<br> ","<br>")(0)&"<br>"
wscript.stderr.write split(mid(myStr,e)&"<br> ","<br>")(0)
end if
end if
myMsg.Move myDestFolder
' wscript.quit
end if
Next
next
2004.04.13 Confirmed to work in Outlook 2003, although Outlook has this annoying tendancy to ask you if it is ok all the time.
2002.08.13 Updated the script to include debug info in the log file as html anchor text so that you can mouse over the -'s in IE and see the messages. It is also now confirmed to work in Outlook 2000 on Windows XP.
Interested:
Questions: