DeleteHeadersWhileSaving

From 40tude Dialog Wiki

Delete any header from incoming messages

With this little script (done by Thomas Barghahn) you are able to delete any header and its content from incoming emails and/or postings. If you found bugs feel free to contact the autor Thomas Barghahn (Th.Barghahn@t-online.de).

---

Install & setup the script

Of course the tags alone won't do much. You have to insert the following script into the OnBeforeSavingMessage event of your scripting window.

Change the following lines inside the script, to define you're own setup.

// set the header(s) you want to remove here, e.g. 'X-Scoring: , X-Hamster-Info:  '    
Remove_Headers = 'X-Scoring: ,X-Hamster-Info: ';

// remove header(s) from emails and/or postings
// set 'true' or 'false'
RemoveFromEmails = true;
RemoveFromNews   = true;

---

The script

program OnBeforeSavingMessage;

//
// Date: 2004/11/16
//

    const
//  ----------------------------------------------------
//  Configuration settings
//  ----------------------------------------------------

    // set the header(s) you want to remove here, e.g. 'User-Agent: ,X-Scoring: '
    
    Remove_Headers = 'X-Scoring: ,X-Hamster-Info: ';

    // remove header(s) from emails and/or postings
    // set 'true' or 'false'
    
    RemoveFromEmails = true;
    RemoveFromNews   = true;

   
//  ----------------------------------------------------
//  End of configuration settings
//  ---------------------------------------------------- 


   // --------------------------------------------------------------- //
   // ----  No user maintainable parts below this line -------------- //
   // --------------------------------------------------------------- //


procedure RemoveHeaders ( Message : TStringlist; 
                          IsEmail : boolean 
);

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


procedure OnBeforeSavingMessage(var Message    : TStringlist; 
                                    Servername : string; 
                                    IsEmail    : boolean
);

begin
   //Your code goes here
   RemoveHeaders(Message,IsEmail);
end;

begin
end.

---

René Fischer