DeleteTOFU and do BodyScoring

From 40tude Dialog Wiki

Contents

Delete Fullquotes and do Body-Scoring

This nice little script was done by Thomas Barghahn. With this script you are able to change delete fullquotes and do bodyscoring. You can define your own set of matching-terms, you want to be found inside articles. The script will add an X-Scoring-Header containing the terms, so its easy for you to score for this speficic header.


Install & setup the script

Please note that this script is an include-file!. You have to copy the following script inside a new custom script (for example "_DelTOFU_and_BodyScoring_include") and safe it. Please don't compile this custom script! After that you have to add the following lines to your OnBeforeSaving-Script:

{$I _DelTOFU_and_BodyScoring_include.ds}    
DelTofu_and_BodyScoring ( Message, IsEmail );

This may look like this:

program OnBeforeSavingMessage;
{$I _DelTOFU_and_BodyScoring_include.ds}    

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

begin
   DelTofu_and_BodyScoring ( Message, IsEmail );
end;

begin
end.

Just compile this OnBeforeSaving-Script now, to get your include-file to work. The setup of the script is shown inside the script. Please take a look at this to customize the script to your own fits.


[edit]

The script

[edit]

Changelog

2005-04-22: += (Signature) Too long signatures can be ignored now
2005-04-16: += (Bodyscoring) You can define groups which should be ignored
2005-04-16: += (Bodyscoring) Signatures now never get scanned for matching strings

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
);

begin

// Date: 2005/04/22

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

    // Change this to "true" if you want mark fullquotes with an
    // X-Scoring-Header 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 mark fullquotes with an
    // X-Scoring-Header in news
    // Setze hier "false", wenn Fullquote in reinkommenden News *nicht* 
    // durch "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 groups which should be ignored by the bodyscoring part of this 
    // script
    // Setze hier die Newsgruppen (kommagetrennt), welche vom Bodyscoring 
    // ausgeschlossen werden sollen
    NoBodyScoringInThisGroups := 'control.cancel,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
    // Lege hier kommagetrennt fest, auf welche Strings der reinkommende Artikel
    // geprüft werden soll
    MatchStrings := '40tude,example,example2,example3';

    // 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 := true;

    // 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 := true;
    
    // 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]*';

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

end;

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


procedure DelTofu_and_BodyScoring ( Message:TStringlist;IsEmail: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;
    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
 if Message.Count > 0 Then begin 
   Init_DelTOFU ( ChangeInEMails, ChangeInNews, BodyScoring, NoBodyScoringInThisGroups, 
                  Ignore_First_Lines, MatchStrings, DeleteTOFU, MessagebyLongSig, DelTOFUWithGoodSig, 
                  TOFUMessageInNewSig, TOFUMessage );

   if (( IsEmail=true )  and ( ChangeInEmails=true )) or
      (( IsEmail=false ) and ( ChangeInNews=true )) then begin 
      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
      try 
         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 l = length (MatchStrings) then
                  ScoreString.Add (copy (MatchStrings, CommaPos + 1 , l - CommaPos ));                   
            end;  // for
         end;   
         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;   
         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;
                  end;
               end;      
            end;
            j := j + 1;
         end;
      finally
      ScoreString.free
      GroupsString.free
      end; // finally      
      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;   
      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 ( 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 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, '*Message insert by 40tude-Dialog: Sorry - Sig was too long!*');
               TOFUMessage := '--------- 8< --------- Cut by 40tude-Dialog! --------- >8 ---------';
               j := i + 6;
               i := i + 1;
            end;   
            Sig := true;  
         end;      
         i := i + 1;
      end; // end of while 
      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;   
            i := i + 1;
         end;   
         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
         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;
         end
         else begin
            for i := 0 to Message.Count - 1 do begin
               s := s + Message.Strings[i] + #13#10;
            end;
         end;                 
         Message.text := s;
      end;      
   end;
 end;  
end;