DeleteFullquote

From 40tude Dialog Wiki

Delete Fullquote

This nice little OnBeforeSavingMessage event script was done by Thomas Barghahn. Its purpose is to delete fullquotes behind quotes.

---

Install & Setup the script

You have to insert the script into the OnBeforeSavingMessage event of your scripting window.

Setup in the script:
If you want to change the setup, you have to edit the lines below inside the script.

// Change this to "true" if you want delete fullquotes also in emails
ChangeInEmails = false;

// Change this to "false" if you don't want delete fullquotes in news
ChangeInNews = true;

// Change this to "false" if you don't want delete fullquotes with a good
// signature (seperated by "-- ").
DelTOFUWithGoodSig = true;

// Change this to "true" if you like to see "TOFUMessage" in a new signature
TOFUMessageInNewSig = false;

// This text will be shown instead the fullquote
TOFUMessage = '[Fullquote behind posters text deleted by 40tude-Dialog]';

---

program OnBeforeSavingMessage;
const

// delete TOFU in emails and/or postings
// set 'true' or 'false'

    ChangeInEmails = false;
    ChangeInNews = true;

    DelTOFUWithGoodSig = true;
    TOFUMessageInNewSig = false;
    TOFUMessage = '[Fullquote behind posters text deleted by 40tude-Dialog]';
    
procedure DelTofu(Message:TStringlist;IsEmail:boolean);

var i        : integer;
    j        : integer;
    s        : string;
    WrongSig : boolean;
    Sig      : boolean;
    tofu     : boolean;
    F_up     : boolean;
    X_post   : boolean;
    
begin
   if (( IsEmail=true )  and ( ChangeInEmails=true )) or
      (( IsEmail=false ) and ( ChangeInNews=true )) then begin
      s := Message.text;
      i := 1;
      j := 0;
      F_up := False;
      X_post := False;
      tofu := False;
      WrongSig := False;
      Sig := False;
      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     ( copy ( Message.Strings[i], 1, 1 ) <> '>' )
            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;
            Sig := True;
         end;      
         i := i + 1;
      end; { end of while }
      If tofu = false then
         Message.text := s
      else begin
         s := '';
         If TOFUMessageInNewSig = True then
            Message.Strings[j] := '-- ' + #13#10 + TOFUMessage
         else
            Message.Strings[j] := TOFUMessage;       
         for i := 1 to j do begin
               s := s + Message.Strings[i] + #13#10
         end;   
         Message.text := s;
      end;      
   end;
end;


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

begin
// Your code goes here 
// Thanks :-)  Th.Barghahn
   DelTofu ( Message, IsEmail );
end;

begin
end.

---

René Fischer