Forums Neueste Beiträge
 

[UPDATE] @Karl-Heinz - http://kh-rademacher.de/4d/_DelTOFU_and_BodyScoring_include.html

29/12/2008 - 18:02 von Hermann Hippen | Report spam
Moin Moin :-),

http://kh-rademacher.de/4d/_DelTOFU...clude.html

Geputzt, optimiert - das Übliche halt :-)

8<--[ _DelTOFU_and_BodyScoring_include ]>8
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';
// 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,Hermann,Rene';
// 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 := True;
// 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 := '*[Fullquote entsorgt]*';
// -
// End of configuration settings
// -
End;
//
// No user maintainable parts below this line
//
Procedure DelTofu_and_BodyScoring ( Message:TStringlist;IsEmail:Boolean );
Var ChangeInEMails,
ChangeInNews,
BodyScoring,
DeleteTOFU,
MessagebyLongSig,
DelTOFUWithGoodSig,
TOFUMessageInNewSig,
WrongSig,
Sig,
LongSig,
tofu,
F_up,
X_post : Boolean;
NoBodyScoringInThisGroups,
s, MatchStrings,
TOFUMessage,
LastLine, NextLine,
ScoreHeader : String;
Ignore_First_Lines : Byte;
i,j,k,l : Integer;
ScoreString,
GroupsString : TStringList;
Begin
Init_DelTOFU ( ChangeInEMails, ChangeInNews, BodyScoring, NoBodyScoringInThisGroups,
Ignore_First_Lines, MatchStrings, DeleteTOFU, MessagebyLongSig, DelTOFUWithGoodSig,
TOFUMessageInNewSig, TOFUMessage );
If (( IsEmail = True ) and ( ChangeInEmails= False )) or
(( IsEmail = False ) and ( ChangeInNews = False )) Then Exit;
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;
ScoreString.CommaText := MatchStrings;
GroupsString.CommaText := NoBodyScoringInThisGroups;
While Message[j] <> '' do
Begin
If AnsiPos('Newsgroups:',Message[j]) > 0 Then
For l := 0 to GroupsString.Count - 1 do
If AnsiPos( GroupsString[l], Message[j] ) <> 0 Then BodyScoring := False;
j := j + 1;
End;
k := j;
j := j + Ignore_First_Lines + 1;
While ( j <= Message.Count - 1 ) and ( BodyScoring = True ) do
Begin
If (copy ( Message[j], 1, 2 ) = '--') Then Break;
If AnsiPos ( '>', Message[j] ) <> 1 Then
For l := 0 to ScoreString.Count - 1 do
If AnsiPos ( ScoreString[l], Message[j] ) <> 0 Then
If AnsiPos ( ScoreString[l], ScoreHeader ) = 0 Then
If Length ( ScoreHeader ) = 10
Then ScoreHeader := ScoreHeader + ' ' + '''' + ScoreString[l] + '''' + ','
Else ScoreHeader := ScoreHeader + '''' + ScoreString[l] + '''' + ',';
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[k] <> '' do k := k + 1;
Message.Insert( k, ScoreHeader );
End Else Message.Insert( k, ScoreHeader );
s := Message.text;
While ( i <= Message.Count - 1 ) do
Begin
If Copy ( Message[i], 1, 12 ) = 'Followup-To:' Then F_up := True;
If Copy ( Message[i], 1, 11 ) = 'Newsgroups:' Then
Begin
If ( AnsiPos ( ',', Message[i] ) > 0 ) or
( AnsiPos ( ';', Message[i] ) > 0 ) Then X_post := True;
End;
If ( F_up = True) and ( X_post = True ) Then Break; // break while
If ( Copy ( Message[i], 1, 1 ) = '>' ) and
( tofu = false ) and ( Sig = false ) Then
Begin
tofu := true;
j := i;
End;
If i = 0 Then LastLine := '' Else Lastline := Message[i - 1];
If i = Message.Count - 1 Then NextLine := '' Else NextLine := Message[i + 1];
If ( Copy ( Message[i], 1, 1 ) <> '>' ) and
( Copy ( LastLine, 1, 1) <> '>' ) and
( Copy ( NextLine, 1, 1) <> '>' ) and
( Message[i] <> '' ) and
( Message[i] <> '--' ) and
( Message[i] <> '-- ' ) and
( WrongSig = False ) and
( tofu = True ) Then tofu := False;
If Message[i] = '--' Then WrongSig := True;
If ( Message[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;
End Else Begin
i := 0;
While Message[i] <> '' do
Begin
If Copy ( Message[i], 1, 10 ) = 'X-Scoring:' Then
Begin
If Length ( ScoreHeader ) = 10
Then Message[i] := Message[i] + ' ' + '''' + '[TOFU]' + ''''
Else Message[i] := Message[i] + ',' + '''' + '[TOFU]' + '''';
End;
i := i + 1;
End;
s := '';
If (TOFUMessageInNewSig = True) and (DeleteTOFU = True) Then
Message[j] := #13#10 + '-- ' + #13#10 + TOFUMessage;
If (TOFUMessageInNewSig = False) and (DeleteTOFU = True) and (LongSig = False) Then
Message[j] := #13#10 + TOFUMessage;
If (TOFUMessageInNewSig = False) and (DeleteTOFU = True) and (LongSig = true) Then
Message[j] := TOFUMessage;
If DeleteTOFU = True
Then For i := 0 to j do s := s + Message[i] + #13#10
Else For i := 0 to Message.Count - 1 do s := s + Message.Strings[i] + #13#10;
Message.text := s;
End;
End;
8<-->8

Cu,
Hermann Hippen.
ž' š°º€ø?žžžžž?ø€º°š 'ž
ø€º° '<http://4ds.siteboard.eu>' °º€ø
'ž '40tude-Dialog Scriptwerkstatt' ž'
ø€º°' ž ž ø€º°ššššššš°º€øšž ž '°º€ø
 

Lesen sie die antworten

#1 Karl-Heinz Rademacher
30/12/2008 - 01:19 | Warnen spam
Hallo Hermann,

Hermann Hippen schrieb:
http://kh-rademacher.de/4d/_DelTOFU...clude.html

Geputzt, optimiert - das Übliche halt :-)



Ich bedanke mich freundlichst. :-)

Zusàtzlich habe ich auch noch Didi's Skript mit auf die Seite gesetzt.

http://kh-rademacher.de/4d/_DelTOFU...clude.html


Mit freundlichen Gruß,
Karl-Heinz Rademacher
,--[ Die 40tude Dialog - Seiten! ]
Š http://kh-rademacher.de/4d
Š http://kh-rademacher.de/face
`-

Ähnliche fragen