program OnBeforeSendingMessage;

const
    RemoveFromEmails = true;
    RemoveFromNews   = true;

(*
Format for Remove_Headers: {} = required, [] = optional
  {HeaderName: }[,HeaderName: ][,HeaderName: ][...]
Examples:
- Single header: 'User-Agent: '
- Multiple headers: 'User-Agent: ,X-Face: '
*)
procedure RemoveHeaders ( Message : TStringlist;
                          IsEmail : boolean;
                          const Remove_Headers: String
);
var i                : integer;
    k                : integer;
    s                : string;
    CommaPos         : integer;
    DelHeader        : TStringlist;
    RemoveH          : String;
begin
   RemoveH := Remove_Headers;
   i := 0;
   if ((IsEmail=true)  and (RemoveFromEmails=true)) or
      ((IsEmail=false) and (RemoveFromNews=true)) then begin
      If ( RemoveH <> '' ) then begin
      try
         DelHeader := TStringlist.Create;
         if ansipos ( ',', RemoveH) = 0 then begin
            DelHeader.Add ( LowerCase ( TrimLeft( RemoveH )));
         end // if
         else begin
            CommaPos := 0;
            for k := 1 to length ( RemoveH ) do begin
               If RemoveH[k] = ',' then begin
                  DelHeader.Add ( LowerCase ( TrimLeft (copy ( RemoveH,
CommaPos + 1, k - ( CommaPos + 1 )))));
                  CommaPos := k;
               end; // if
               if k = length ( RemoveH ) then
                  DelHeader.Add ( LowerCase ( TrimLeft (copy ( RemoveH,
CommaPos + 1, k - CommaPos ))));
            end; // for
         end; // else
         s:=Message.text;
         while (Message.Strings[i]<>'') do begin
            k := 0;
            while k <= ( DelHeader.Count - 1 ) do begin
               if pos( DelHeader[k], LowerCase ( Message.Strings[i] )) = 1
then begin
                  delete ( s, pos(DelHeader[k], LowerCase (s) ), length (
Message.Strings[i] ) + 2 );
                  i := i - 1;
                  k := DelHeader.Count - 1;
                  message.text := s;
               end; // if
               k := k + 1;
            end; // while
            i := i + 1;
         end; //while
         message.text:=s;
      finally
      DelHeader.Free;
      end; // try - finally
      end; // if
   end; // if
end; // RemoveHeaders

function StrMatch(str: String; pattern: String):Boolean;
var
  patternSize : Integer;
  subStr : String;
  compareRes : Integer;
begin
  patternSize := Length(pattern);
  subStr := Copy(str, 1, patternSize);
  compareRes := CompareStr(pattern, subStr);
  if (compareRes = 0) then
    result := true
  else
    result := false;
end;

//the xxx2Identity() functions must return an empty string if specified string is not identified

function From2Identity(from: String): String;
begin
  if (StrMatch(from, 'First1 Last1 <[email protected]>')) then
    result := 'id1'
  else if (StrMatch(from, 'First2 Last2 <[email protected]>')) then
    result := 'id2'
  else
    result := '';
end;

function NewsGroup2Identity(newsgroup: String): String;
begin
  if StrMatch(newsgroup, 'news.software.readers') then
    result := 'id1'
  else if StrMatch(newsgroup, 'alt.free.newsservers') then
    result := 'id2'
  else
    result := '';
end;

function Server2Identity(server: String): String;
begin
  if (CompareStr(server, 'aioe') = 0) then
    result := 'id1'
  else if (CompareStr(server, 'albasani') = 0) then
    result := 'id2'
  else
    result := '';
end;

procedure GetIdentities(var message: TStringlist; servername: string;
  isEmail: boolean; FromIdentity: String; NewsgroupIdentity: String;
  ServerIdentity: String);
var i : Integer;
begin
  FromIdentity := '';
  NewsgroupIdentity := '';
  ServerIdentity := '';
  if (not IsEmail) then
  begin
    for i := 0 to Message.Count - 1 do
    begin
      if (strMatch(Message[i], 'From:')) then
        fromIdentity := Copy(Message[i], 7, Length(Message[i]) - 6);
      if (strMatch(Message[i], 'Newsgroups:')) then
        newsgroupIdentity := Copy(Message[i], 13, Length(Message[i]) - 12);
    end;
    fromIdentity := From2Identity(fromIdentity);
    newsgroupIdentity := NewsGroup2Identity(newsgroupIdentity);
    serverIdentity := Server2Identity(servername);
    // The lines below write to the log file ./40tude/logs/20161231.log
    WriteToLog('  fromIdentity = ' + fromIdentity, 7);
    WriteToLog('  newsgroupIdentity = ' + newsgroupIdentity, 7);
    WriteToLog('  serverIdentity = ' + serverIdentity, 7);
  end;
end;

function OnBeforeSendingMessage(var Message     : TStringlist;
                                    Servername  : string;
                                    IsEmail     : boolean
):boolean;
var
  FromIdentity: String;
  NewsgroupIdentity: String;
  ServerIdentity: String;
  Remove_Headers: String;
begin
  //get the identities of the message
  GetIdentities(message, servername, isEmail, FromIdentity, NewsgroupIdentity, ServerIdentity);
  //check the identities. make sure they are all identified.
  if (FromIdentity <> '') and (NewsgroupIdentity <> '') and (ServerIdentity <> '') then
  begin
    Remove_Headers := '';

    {The main decision.
     For FromIdentity, comparison must match against string returned by From2Identity() function.
     Same applies to NewsgroupIdentity and ServerIdentity.
    }
    if FromIdentity = 'id1' then
      Remove_Headers := 'User-Agent: ,Message-ID: '
    else if FromIdentity = 'id2' then
      Remove_Headers := 'User-Agent: ,Content-Transfer-Encoding: '
    else
      Remove_Headers := 'User-Agent: ,Mime-Version: ';

    if Remove_Headers <> '' then RemoveHeaders(Message, IsEmail, Remove_Headers);
  end;
  result := true;
//  result := false; //uncomment this line for testing purposes (doesn't send the message)
end;
// ----------------------------------------------------------------------
begin
end.