program OnBeforeSendingMessage;

(*
Format for Remove_Headers: {} = required, [] = optional
  {HeaderName: }[,HeaderName: ][,HeaderName: ][...]
Examples:
- Single header: 'User-Agent: '
- Multiple headers: 'User-Agent: ,X-Face: '
*)
procedure RemoveHeaders(Message : TStringlist;
                        const Remove_Headers: String
);
var i                : integer;
    k                : integer;
    s                : string;
    CommaPos         : integer;
    DelHeader        : TStringlist;
    RemoveH          : String;
begin
   RemoveH := Remove_Headers;
   i := 0;
   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; // RemoveHeaders

(*
Format for Add_Headers: {} = required, [] = optional
  {HeaderName: HeaderValue{#13#10}}[HeaderName: HeaderValue{#13#10}][...]
Examples: (each header must end with CR+LF)
- Single header: 'User-Agent: '#13#10
- Multiple headers: 'User-Agent: MyNewsClient'#13#10'X-Comment: To be, or not to be'#13#10
*)
procedure AddHeaders(var Message : TStringlist;
                     const Add_Headers: String
);
var
  SeparatorIndex: integer;
  s: string;
begin
  s:= Message.Text;
//  writetolog('***before***'#13#10+s, 7);
  SeparatorIndex:= pos(#13#10#13#10, s);
  Insert(Add_Headers, s, SeparatorIndex+2);
  Message.Text:= s;
//  writetolog('***after***'#13#10+s, 7);
end;

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 if (StrMatch(from, 'john doe <[email protected]>')) then
    result := 'id3'
  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 if StrMatch(newsgroup, 'alt.test') then
    result := 'id3'
  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; var FromIdentity: String; var NewsgroupIdentity: String;
  var 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;

procedure LogHeaders(var Message: TStringlist);
var
  i: integer;
  s: string;
begin
  s:= '';
  for i:= 0 to message.count-1 do
  begin
    if message[i] <> '' then s:= s+message[i]+#13#10
    else break;
  end;
  writetolog(s, 7);
end;

function OnBeforeSendingMessage(var Message     : TStringlist;
                                    Servername  : string;
                                    IsEmail     : boolean
):boolean;
var
  ForEmail: boolean;
  ForNewsgroup : boolean;
  FromIdentity: String;
  NewsgroupIdentity: String;
  ServerIdentity: String;
  Remove_Headers: String;
  Add_Headers: String;
begin
  //get the identities of the message
  GetIdentities(message, servername, isEmail, FromIdentity, NewsgroupIdentity, ServerIdentity);

  ForEmail := false;     //don't do email message by default
  ForNewsgroup := false; //don't do newsgroup message by default
  Remove_Headers := '';  //don't remove any header by default
  Add_Headers := '';     //don't add any header by default

  {The main decision.

   For FromIdentity, comparison must match against string returned by From2Identity() function.
   Same applies to NewsgroupIdentity and ServerIdentity.
   Note that identities may be an empty string.

   Set Remove_Header to remove header(s).
   Set Add_Header to add header(s).
   Set ForEmail and/or ForNewsgroup to `true` to add/remove header for email/newsgroup messages.
  }
  if FromIdentity = 'id1' then
  begin
    ForNewsgroup := true;
    Remove_Headers := 'User-Agent: ,Message-ID: ';
  end
  else if (FromIdentity = 'id2') and (NewsgroupIdentity = 'id1') then
  begin
    ForNewsgroup := true;
    Remove_Headers := 'User-Agent: ,Content-Transfer-Encoding: '
    Add_Headers := 'X-Comment: John Doe was here';
  end
  else if (FromIdentity = 'id3') and (ServerIdentity = 'id2') then
  begin
    ForEmail := true;
    ForNewsgroup := true;
    Remove_Headers := 'User-Agent: ,Mime-Version: ';
    Add_Headers := 'X-Comment: Jane Doe was here'#13#10 +
      'X-Greeting: Hello there!'#13#10;
  end;

  if (IsEmail and ForEmail) or ((not IsEmail) and ForNewsgroup) then
  begin
    if Remove_Headers <> '' then RemoveHeaders(Message, Remove_Headers);
    if Add_Headers <> '' then AddHeaders(Message, Add_Headers);
  end;

  result := true;
//  result := false; //uncomment this line for testing purposes (doesn't send the message)
end;
// ----------------------------------------------------------------------
begin
end.