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;