//*********************************************************************
//*                     Remove_Headers 2020-04-20                     *
//*                   >> OnBeforeSendingMessage <<                    *
//*                                                                   *
//* Dieses Script löscht unerwünschte Header vor dem Versenden!       *
//* Besonders geeignet ist dieses Script bei einem Supersedes, damit  *
//* doppelte Einträge von Headern verhindert werden! Ein *MUSS* also! *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum     : überarbeitet am 20.04.2020  (Corona-Zeit)             *
//* Autoren   : Dietmar Vollmeier & Thomas Barghahn                   *
//*                                                                   *
//* DateiName : _i_OBSendM_Remove_Headers.ds                          *
//* Einbindung: {$I _i_OBSendM_Remove_Headers.ds}                     *
//* Aufruf    : Result := Remove_Headers                              *
//*                       (Result, Message, IsEmail, Error_Func);     *
//*********************************************************************

procedure Init_Remove_Headers ( var RemoveHeaders    : string;
                                var RemoveFromEmails : boolean;
                                var RemoveFromNews   : boolean
);

begin

//{-------------------------------------------------------------------}
//{                 Anwenderspezifische Einstellungen                 }
//{-------------------------------------------------------------------}

    // Setze hier die Header, welche beim Versenden der Nachricht
    // gelöscht werden sollen. Z.B.: 'User-Agent: ,X-Scoring: '
    RemoveHeaders := 'X-PGP-Hash: ,X-PGP-Hash-Info: ,X-PGP-Key: ,' +
                     'X-PGP-Sig: ,X-Scoring: ,X-Hinweis: ,' +
                     'X-Sig-Check: ,X-MyCheck-PGP: ,X-PGP-V: ,' +
                     'X-Hamster-Info: ,X-Old-Xref: ,Keywords: ';
                     // Organization: '; 

    // Sollen die Header aus E-Mails und/oder News gelöscht werden?
    // Setze hier 'true' or 'false'

    RemoveFromEmails := true;
    RemoveFromNews := true;

   
//{-------------------------------------------------------------------}
//{                       Ende der Einstellungen                      }
//{-------------------------------------------------------------------}
end;

//{===================================================================}
//{           !!!  Ab hier bitte nichts mehr ändern  !!!              }
//{===================================================================}

//--[ START Function Remove_Headers ]---------------------------------

Function Remove_Headers (fbkResult  : Boolean;
                         Msg        : TStringlist; 
                         IsEmail    : boolean;
                     var Error_Func : String) : Boolean;

var i                : integer;
    k                : integer;
    RemoveHeaders    : string;
    DelHeader        : TStringlist;
    RemoveFromEmails : boolean;
    RemoveFromNews   : boolean;
    
    
begin
   // Rückgabewert entsprechend vorheriger Scriptprobleme setzen
   Result := fbkResult;

   // Wenn bereits irgendein Script einen Fehler verursacht hat,
   // dann braucht dieses hier nicht mehr ausgeführt werden
   If Not Result Then begin
      WriteToLog ('==== ANFANG =======================================' ,4);     
      WriteToLog ('Script *** Remove_Headers *** wurde nicht mehr ausgefuehrt' ,4);
      WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4);
      WriteToLog ('==== ENDE =========================================' ,4);     
      Exit;
   end;   

   i := 0;
   Init_Remove_Headers ( RemoveHeaders, RemoveFromEmails,
                         RemoveFromNews );
   if ((IsEmail=true)  and (RemoveFromEmails=true)) or
      ((IsEmail=false) and (RemoveFromNews=true)) then begin
      If ( RemoveHeaders <> '' ) then begin
         try 
            DelHeader := TStringlist.Create;
            DelHeader.CommaText := RemoveHeaders;
            k := 0;
            while k <= ( DelHeader.Count - 1 ) do begin 
               Msg := RemoveHeader (DelHeader[k], Msg);
               k := k + 1;
            end; // while
            If ansipos('tagesgeschehen', GetHeader('Newsgroups',Msg)) > 0 then
               Msg := RemoveHeader ('User-Agent', Msg);
         Except 
            // Bei Problemen das Senden der Nachricht unterbinden
            begin
               WriteToLog ('FEHLER im Script *** Remove_Headers ***' ,5);
               Error_Func := '*** Remove_Headers ***';    
               Result := false;
            end; // Except  
         finally
            // Speicher freigeben
            DelHeader.Free;
         end; // Try ... Except ... Finally 
      end; // if  
   end; // if

end; // Remove_Headers

//--[ ENDE Function Remove_Headers ]----------------------------------