[xmail] Re: log file => spammers

[T. Mike Howeth]

ok, here are the details for a simplified implementation -

first, I share the directory on the server that contains the spammer list and modify 
its permissions so that I can write to some of
the files in it from the machine & userID that I normally use (my "dev box").

on the dev box, I use a 3rd-party utility "Redemption". 
(http://www.dimastr.com/redemption/).  I do this because the retrieval of
certain message information from code in Outlook triggers a security warning that is 
unnecessary in this context, and Redemption
gets around it.  Use of Redemption is not required but makes the result nicer.

in outlook, I added a toolbar button that invokes vba code that does the work.  First, 
it retrieves the message header (using
Redemption); it could also be retrieved by calling CDO directly I assume.

Public Function MailItemGetHeaders(MItem As Outlook.MailItem) As String
  Dim utils, PrHeaders
  Dim result As String
  On Error Resume Next
  Set utils = CreateObject("Redemption.MAPIUtils")
  PrHeaders = &H7D001E
  result = utils.HrGetOneProp(MItem.MAPIOBJECT, PrHeaders)
  utils.Cleanup
  MailItemGetHeaders = result
End Function

the vba code then parses the first Received: header and extracts the sending MTA's IP 
address and reverse DNS info.  Since the
received header was constructed by xmail, I always know exactly what its format is. 
(Received: headers normally have no specific
standard format).  

(The reverse DNS info is available because I have xmail add it to the Received: 
headers but it is not required for this to work
although I use it for other purposes)

finally, the vba code adds the IP address to the spammer list (I removed some of the 
error checking from this to make it easier to
read):

Public Sub IPIsSpammer(ByVal IPInfo As String)
  Dim Path As String
  Dim IPAdr As String
  Dim fd As Integer
  On Error Resume Next
  IPAdr = Left(IPInfo, InStr(IPInfo & " ", " ") - 1) ' discard RDNS info if present
  Path = "(pathname of spammers.tab file)"
  fd = FreeFile
  Open Path For Append As #fd
  if err.number=0 then
    Print #fd, """" & IPAdr & """" & Chr(9) & """255.255.255.255"""
    Close #fd
  end if
End Sub

---
tmike




-
To unsubscribe from this list: send the line "unsubscribe xmail" in
the body of a message to [EMAIL PROTECTED]
For general help: send the line "help" in the body of a message to
[EMAIL PROTECTED]