//*********************************************************************
//*                DelTOFU_and_BodySoring 2020-06-04                  *
//*                   >> OnBeforeSavingMessage <<                     *
//*                                                                   *
//* Dieses Script loescht nach Wunsch TOFU, sucht nach Woertern oder  *
//* Textpassagen und setzt einen Header um all diese Dinge zu         *
//* kennzeichnen.                                                     *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum     : 22.04.2005; ueberarbeitet am: 04.06.2020              *
//* Autoren   : Thomas Barghahn                                       *
//*                                                                   *
//* DateiName : _i_OBSaveM_DelTOFU_and_BodySoring.ds                  *
//* Einbindung: {$I _i_OBSaveM_DelTOFU_and_BodySoring}                *
//* Aufruf    : Not_Error := DelTOFU_and_BodySoring (Not_Error,       *
//*                          Message, IsEmail, Error_Func);           *
//*********************************************************************

procedure Init_DelTOFU (var ChInEmails                : Boolean;
                        var ChInNews                  : Boolean;
                        var BodyScoring               : Boolean;
                        var NoBodyScoringInThisGroups : String;
                        var Ignore_First_Lines        : Byte; 
                        var MatchStrings              : String;
                        var DeleteTOFU                : Boolean;
                        var MessagebyLongSig          : Boolean;
                        var DelTOFUWithGoodSig        : Boolean;
                        var TOFUMessageInNewSig       : Boolean;
                        var TOFUMessage               : String;
                        var LongSigMessage            : String
);

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

    // Change this to "true" if you want delete fullquotes also in emails
    // Setze hier "true", wenn Fullquote in reinkommenden e-Mails durch 
    // einen "X-Scoring-Header" markiert werden soll
    ChInEmails := false;
    
    // Change this to "false" if you don't want delete fullquotes in news
    // Setze hier "false", wenn Fullquote in reinkommenden News *nicht* 
    // durch einen "X-Scoring-Header" markiert werden soll
    ChInNews := true;

    // Set this to "false" if you don't want score the bodys
    // Setze hier "false", wenn *kein* "Bodyscoring" erfolgen soll
    BodyScoring := true;

    // Define here the news groups (comma delimited) which should be excluded from the Bodyscoring 
    // Setze hier die Newsgruppen (kommagetrennt), welche vom Bodyscoring ausgeschlossen
    // werden sollen
    NoBodyScoringInThisGroups := 'alabama.test';
    
    // Set number of lines from the start you don't want to be scanned for
    // bodyscoring terms
    // Lege hier die ersten Zeilen fest, welche von der Prüfung 
    // ausgeschlossen werden sollen
    Ignore_First_Lines := 3;
    
    // Define your bodyscoring terms (comma delimited)
    // Lege hier kommagetrennt fest, auf welche Strings der reinkommende Artikel
    // geprüft werden soll
    MatchStrings := 'Thomas Barghahn, Bert , Bert.,Bert ';

    // Set this to "true" if you want delete fullquotes
    // Setze hier "true", wenn die unter ChInEmails und/oder ChInNews markierten
    // Fullquotes gelöscht werden sollen - bei dem hier möglichen Eintrag "false"
    // wird dann nur der Header "X-Scoring" mit den entsprechenden Parametern
    // gesetzt
    DeleteTOFU := false;

    // Change this to "false" if a too long signature should not be shortened 
    // and not be criticized 
    // Setze hier "false", wenn eine zu lange Signatur *nicht* gekürzt und *nicht*
    // bemängelt werden soll
    MessagebyLongSig := false;
    
    // Change this to "false" if you don't want delete fullquotes with a good
    // signature (seperated by "-- ").
    // Setze hier "false", wenn ein Fullquote mit einer "guten" Sig *nicht*
    // gelöscht werden soll
    DelTOFUWithGoodSig := false;
    
    // Change this to "true" if you like to see "TOFUMessage" in a new signature
    // Setze hier "true", wenn eine TOFU-Nachricht als neue Sig erscheinen soll  
    TOFUMessageInNewSig := false;    
    
    // This text will be shown instead the fullquote
    // Der folgende Text wird statt des Fullquotes eingefügt
    TOFUMessage := '*[(full)quote behind posters text deleted by 40tude-Dialog]*';
    
    // This text will be inserted before the too long signature
    // Der folgende Text wird vor der zu langen Signatur eingefügt
    // LongSigMessage := '*Message insert by 40tude-Dialog: Sorry - Sig was too long!*';
    LongSigMessage := '*Message insert by 40tude-Dialog: Sorry - Sig war einfach zu lang!*';
    

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

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

//--[ START Function DelTofu_and_BodyScoring ]-------------------------


Function DelTofu_and_BodyScoring ( fbkResult  : Boolean;
                                   Message : TStringlist;
                                   IsEmail : boolean;
                                   Error_Func : String) : Boolean;

var ChangeInEMails            : boolean;
    ChangeInNews              : boolean;
    BodyScoring               : boolean;
    NoBodyScoringInThisGroups : String;
    Ignore_First_Lines        : Byte;
    MatchStrings              : string;
    DeleteTOFU                : boolean;
    MessagebyLongSig          : boolean;
    DelTOFUWithGoodSig        : boolean;
    TOFUMessageInNewSig       : boolean;
    TOFUMessage               : String;
    LongSigMessage            : String;
    i                         : integer;
    j                         : integer;
    k                         : integer;
    l                         : integer;
    CommaPos                  : integer;
    s                         : string;
    WrongSig                  : boolean;
    Sig                       : boolean;
    LongSig                   : boolean;
    tofu                      : boolean;
    F_up                      : boolean;
    X_post                    : boolean;
    LastLine                  : String;
    NextLine                  : String;
    ScoreHeader               : String;
    ScoreString               : TStringList;
    GroupsString              : TStringList;

begin

   // Rückgabewert entsprechend vorheriger Scriptprobleme setzen
   Result := fbkResult;

   // Wenn bereits irgendein Script einen Fehler verursacht hat,
   // dann muss der User benachrichtigt werden
   If not Result Then begin
      WriteToLog ('==== ANFANG =======================================' ,4);     
      WriteToLog ('Script *** DelTofu_and_BodyScoring *** wird weiterhin ausgefuehrt' ,4);
      WriteToLog ('Script ' + Error_Func + ' hat diese WARNUNG verursacht!' ,4);
      WriteToLog ('==== ENDE =========================================' ,4);     
   end;   

   if Message.Count > 0 Then begin 
      Init_DelTOFU ( ChangeInEMails, ChangeInNews, BodyScoring, NoBodyScoringInThisGroups, 
                     Ignore_First_Lines, MatchStrings, DeleteTOFU, MessagebyLongSig, DelTOFUWithGoodSig, 
                     TOFUMessageInNewSig, TOFUMessage, LongSigMessage );
      if (( IsEmail=true )  and ( ChangeInEmails=true )) or
         (( IsEmail=false ) and ( ChangeInNews=true )) then begin
         Try
            i := 0;
            j := 0;
            k := 0;
            F_up := False;
            X_post := False;
            tofu := False;
            WrongSig := False;
            Sig := False;
            LongSig := False;
            ScoreHeader := 'X-Scoring:';
            If ( BodyScoring = True ) and ( MatchStrings <> '' ) then begin
               ScoreString := TStringlist.Create;
               GroupsString := TStringlist.Create;
               if ansipos ( ',', MatchStrings) = 0 then begin
                  ScoreString.Add (MatchStrings);
               end 
               else begin
                  CommaPos := 0;   
                  for l := 1 to length (MatchStrings) do begin
                     If MatchStrings[l] = ',' then begin
                        ScoreString.Add (copy (MatchStrings, CommaPos + 1 , l - ( CommaPos + 1 )));
                        CommaPos := l;
                     end; // If
                     if l = length (MatchStrings) then
                        ScoreString.Add (copy (MatchStrings, CommaPos + 1 , l - CommaPos ));                   
                  end;  // for
               end; // If  
               if ansipos ( ',', NoBodyScoringInThisGroups) = 0 then begin
                  GroupsString.Add (NoBodyScoringInThisGroups);
               end
               else begin 
                  CommaPos := 0;   
                  for l := 1 to length (NoBodyScoringInThisGroups) do begin
                     If NoBodyScoringInThisGroups[l] = ',' then begin
                        GroupsString.Add (copy (NoBodyScoringInThisGroups, CommaPos + 1 , l - ( CommaPos + 1 )));
                        CommaPos := l;
                     end;
                     if l = length (NoBodyScoringInThisGroups) then
                        GroupsString.Add (copy (NoBodyScoringInThisGroups, CommaPos + 1 , l - CommaPos ));                   
                  end;  // for
               end; // If  
               while Message.Strings[j] <> '' do begin
                  if copy ( Message.Strings[j], 1, 11 ) = 'Newsgroups:' then begin
                     For l := 0 to GroupsString.Count - 1 do begin
                        if ansipos ( GroupsString.Strings[l], Message.Strings[j] ) <> 0 then begin
                           BodyScoring := false;
                        end; //if
                     end; //for      
                  end;
                  j := j + 1;
               end; //while   
               k := j;
               j := j + Ignore_First_Lines + 1;
               while ( j <= Message.Count - 1 ) and ( BodyScoring = true ) do begin
                  if (copy ( Message.Strings[j], 1, 2 ) = '--') then Break;
                  if ansipos ( '>', Message.Strings[j] ) <> 1 then begin
                     For l := 0 to ScoreString.Count - 1 do begin
                        if ansipos ( ScoreString.Strings[l], Message.Strings[j] ) <> 0 then begin
                           if ansipos ( ScoreString.Strings[l], ScoreHeader ) = 0 then begin
                              if length ( ScoreHeader ) = 10 then
                                 ScoreHeader := ScoreHeader + ' ' +  '''' + ScoreString.Strings[l] + '''' + ','
                           else
                              ScoreHeader := ScoreHeader + '''' + ScoreString.Strings[l] + '''' + ',';
                           end; // If
                        end; // If
                     end;  // For    
                  end; // If
                  j := j + 1;
               end; // while
            end; // if BodyScoring     
            if length ( ScoreHeader ) > 10 then 
               delete ( ScoreHeader, length (ScoreHeader), 1);
            If k = 0 then begin
               while Message.Strings[k] <> '' do
                  k := k + 1;
               Message.insert( k, ScoreHeader );
            end
            else begin
               Message.insert( k, ScoreHeader );
            end;  // If k = 0 
            s := Message.text;
            while ( i <= Message.Count - 1 ) do begin
               if copy ( Message.Strings[i], 1, 12 ) = 'Followup-To:' then
                  F_up := True;
               if copy ( Message.Strings[i], 1, 11 ) = 'Newsgroups:' then begin
                  if    ( AnsiPos ( ',', Message.Strings[i] ) > 0 )
                     or ( AnsiPos ( ';', Message.Strings[i] ) > 0 ) then
                     X_post := True;
               end; // If  
               if ( F_up = True) and ( X_post = True )  Then Break; // break while       
               if     ( copy ( Message.Strings[i], 1, 1 ) = '>' ) 
                  and ( tofu = false ) 
                  and ( Sig = false ) then begin
                  tofu := true;
                  j := i;
               end; // If
               If i = 0 then 
                  LastLine := ''
               else
                  Lastline := Message.Strings[i - 1];
               if i = Message.Count - 1 then
                  NextLine := ''
               else
                  NextLine := Message.Strings[i + 1];        
               if     ( copy ( Message.Strings[i], 1, 1 ) <> '>' )
                  and ( copy ( LastLine, 1, 1) <> '>' ) 
                  and ( copy ( NextLine, 1, 1) <> '>' )
                  //   and ( AnsiPos (' ', Message.Strings[i] ) <> 0 )
                  and ( Message.Strings[i] <> '' )
                  and ( Message.Strings[i] <> '--' )
                  and ( Message.Strings[i] <> '-- ' )
                  and ( WrongSig = False )
                  and ( tofu = true ) then
                     tofu := false;
               if Message.Strings[i] = '--' then
                  WrongSig := True;
               if ( Message.Strings[i] = '-- ' ) then begin
                  if DelTOFUWithGoodSig = True then
                     WrongSig := True
                  else   
                     WrongSig := False;
                  if ((i + 5) <= Message.Count - 1) and (MessagebyLongSig = true) then begin
                     LongSig := True;
                     tofu := true;
                     Message.insert (i, LongSigMessage);
                     TOFUMessage := '--------- 8< --------- Cut by 40tude-Dialog! --------- >8 ---------';
                     j := i + 6;
                     i := i + 1;
                  end;  // If 
                  Sig := true;  
               end; // If  ( Message.Strings[i] = '-- ' )    
               i := i + 1;
            end; // while ( i <= Message.Count - 1 )
            If tofu = false then begin
               if length ( ScoreHeader ) = 10 then
                  Message.delete (k);
               s := Message.text;   
               Message.text := s;
            end   
            else begin
               i := 0;
               while Message.Strings[i] <> '' do begin
                  if copy ( Message.Strings[i], 1, 10 ) = 'X-Scoring:' then begin
                     if length ( ScoreHeader ) = 10 then
                        Message.Strings[i] := Message.Strings[i] + ' ' + '''' + '[TOFU]' + ''''
                     else
                        Message.Strings[i] := Message.Strings[i] + ',' + '''' + '[TOFU]' + '''';     
                  end; // If  
               i := i + 1;
               end;  // While
               s := '';
               If (TOFUMessageInNewSig = True) and (DeleteTOFU = True) then
                  Message.Strings[j] := #13#10 + '-- ' + #13#10 + TOFUMessage;
               If (TOFUMessageInNewSig = False) and (DeleteTOFU = True) and (LongSig = false) then
                  Message.Strings[j] := #13#10 + TOFUMessage;
               If (TOFUMessageInNewSig = False) and (DeleteTOFU = True) and (LongSig = true) then
                  Message.Strings[j] := TOFUMessage;         
               If DeleteTOFU = True then begin
                  for i := 0 to j do begin
                     s := s + Message.Strings[i] + #13#10;
                  end; // For
               end
               else begin
                  for i := 0 to Message.Count - 1 do begin
                     s := s + Message.Strings[i] + #13#10;
                  end; // For
               end; // If DeleteTOFU ...             
               Message.text := s;
            end; // If TOFU ...     
         Except
            // Bei Problemen den User benachrichtigen.
            begin
               WriteToLog ('FEHLER im Script *** DelTofu_and_BodyScoring ***' ,4);
               WriteToLog ('From : ' + GetHeader('From: ', Message), 4);
               WriteToLog ('Newsgroups : ' + GetHeader('Newsgroups: ', Message), 4);
               WriteToLog ('Date : ' + GetHeader('Date: ', Message), 4);
               WriteToLog ('Message-ID : ' + GetHeader('Message-ID: ', Message), 4);
               Error_Func := '*** DelTofu_and_BodyScoring ***';    
               Result := false;
            end; // Except        
         finally
            ScoreString.free
            GroupsString.free
         end; // Try ... Except ... Finally
      end; // if (( IsEmail=true ) ...
   end;  // if Message.Count > 0 ...
end; // Function

//--[ ENDE Function DelTofu_and_BodyScoring ]--------------------------