//********************************************************************* //* 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 ]--------------------------