spamchck.pas

siMail, siMail, siMail, siMail

Here is the spamchck.pas unit
-----------------------------------------------
spamchck.pas
-----------------------------------------------
unit spamchck;

interface

//Query's the spamhaus.org database of spam lists using synapse dns

uses Classes, SysUtils, SynaUtil, SynSock;

type
  TSpamCheck = class (TObject)
  protected
  public
    FDNSBL:String; //DNS BlockList
    constructor Create;
    function IsSpammer (IP:String):Integer; overload;
    function IsSpammer (MailHeader:TStrings):Integer; overload;
  end;


implementation

{ TSpamCheck }

constructor TSpamCheck.Create;
begin
  inherited;
  FDNSBL := 'sbl-xbl.spamhaus.org';
  // alternatively use sbl.spamhaus.org (spam) or
  // xbl.spamhaus.org (open relays, proxys)
  // or an alternative source DNSBL source.
  // the sbl-xbl is the combined list.
end;

function TSpamCheck.IsSpammer(IP: String): Integer;
var RevIP:String;
    i:Integer;
    p:PHostEnt;
begin
  //Query the database
  //First, reverse the IP
  Result := -1;
  if IsIP (IP) then
    begin
      //Reverse the IP
      RevIP := '';
      for i:=0 to 2 do
        begin
          RevIP := '.'+Copy (IP, 1, pos ('.', IP)-1) + RevIP;
          IP := Copy (IP, pos('.', IP)+1, maxint);
        end;
      RevIP := IP + RevIP;

      //Now, query the database:
      RevIP := RevIP + '.' + FDNSBL;
      p := GetHostByName (PChar(RevIP));
      if Assigned (p) then
        begin //Results come back as 127.0.0.x where x > 1
              // 127.0.0.2 = spam
              // 127.0.0.4 = open relay etc.
          Result := byte(p^.h_addr^.S_un_b.s_b4);
        end
      else //no dns entry found, mark it as safe:
        Result := 0;
    end;

end;

function TSpamCheck.IsSpammer(MailHeader: TStrings): Integer;
var v,ip:String;
    i,r:Integer;
begin
  //Parse a email header
  //Look for 'Received' header
  //extract IP address, assuming form 'Received by w.x.y.z from a.b.c.d
  //Validate this IP address at spamhaus.
  i := 0;
  Result := -1;
  while i<MailHeader.Count do
    begin
      if pos ('received: ', lowercase (MailHeader[i])) = 1 then
        begin
          v := MailHeader[i];
          //search for additional headers:
          while ((i+1)<MailHeader.Count) and
                (MailHeader[i+1]<>'') and
                (MailHeader[i+1][1]=' ') do
            begin
              inc (i);
              v := v+MailHeader[i];
            end;
          //v now contains one line, find last ip address:
          v := lowercase (v);
          v := copy (v, pos ('from', v)+4, maxint);
          //search for digit:
          v := copy (v, pos ('(', v)+1, maxint);
          v := copy (v, 1, pos (')', v)-1);
          //valid format is also:
          //Received: from somehost.com (somehost.com [1.2.3.4])
          //alternatively:
          //Received from somehost.com (1.2.3.4).
          //check.
          if pos ('[', v)>0 then
            begin
              v := copy (v, pos ('[', v)+1, maxint);
              v := copy (v, 1, pos (']', v)-1);
            end;

          Result := IsSpammer (v);

          //a single received line is sufficient
          if Result > 0 then
            break;
          //
        end;
      inc (i);  
    end;
end;

end.


-------------------------------------
Here's an example of how i use the spamcheck with IMAP:

  IsSpam := TSpamCheck.Create;

//..//

      IMAP.FetchHeader (uid, FHeaders); //top them
      IMAP.GetFlagsMess (uid, d);
//      if ifRecent in IMAP.LastFlags then //check for spam on new 
messages
        begin
          if IsSpam.IsSpammer (FHeaders) > 0 then
            begin
              //drop somewhere, in the recycle bin for example
              IMAP.StoreFlags (uid, [ifDeleted], faAdd);
            end;
        end;