Skripte, die die Welt nicht braucht - Remove_UserAgent

07/05/2013 - 15:44 von Vínzenz Ahréndt | Report spam
Hallo,

nachdem ich mich jetzt mal etwas mit der Skript-Materie befaßt habe, hab
ich auch gleich eines geschrieben. Ist aus der Ecke "Skripte, die die Welt
nicht braucht", erklàrt sich dafür aber von selbst, siehe
Konfigurationsteil.

Der übliche Einbau in OnBeforeSendingMessage:

//-

program OnBeforeSendingMessage;

// [...]

{$I Remove_UserAgent.ds}


function OnBeforeSendingMessage( var Message : TStringlist; const Servername : string; const IsEmail : boolean ) : boolean;

begin

// Your code goes here

// [...]

// User-Agent entfernen
Remove_UserAgent ( Message, IsEmail );

end;

begin
end.

//-


Die Init-Routine und das Skript selbst:

//-

//--[Procedure Init_Remove_UserAgent]--
Procedure Init_Remove_UserAgent (Var b_Remove_UAInAllEmails: Boolean; Var b_Remove_UAInAllNews: Boolean; Var strl_ExFrom: TStringList);
Begin
// --
// Configuration settings
// --
// Remove User-Agent in all emails and/or Postings
// set 'true' or 'false'
b_Remove_UAInAllEmails := false;
b_Remove_UAInAllNews := true;

// From-Eintràge definieren
// Name oder Namensteile oder Mail-Adressen oder Teile davon, bei deren
// Vorhandensein der User-Agent nicht erntfernt werden soll
// Eintràge durch ein Komma ',' trennen. Leerzeichen erlaubt.

strl_ExFrom.CommaText := ' @gmx.de , @gmx.at , ';

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


//--[Procedure Remove_UserAgent]
Procedure Remove_UserAgent( Message:TStringlist; IsEmail:boolean );

var
b_Remove_UAInAllEmails, b_Remove_UAInAllNews : Boolean;
strl_ExFrom : TStringList;

b_Remove_UA, b_UAString_vorhanden, b_Message_changed : Boolean;
i : integer;
str_H : String;
strl_MessageText : TStringList;


Begin
strl_MessageText := TStringList.Create;
strl_ExFrom := TStringList.Create;

b_Remove_UA := true;
b_UAString_vorhanden := false;
b_Message_changed := false;
str_H := '';

Init_Remove_UserAgent ( b_Remove_UAInAllEmails, b_Remove_UAInAllNews, strl_ExFrom);
strl_ExFrom.CommaText := AnsiLowerCase(strl_ExFrom.CommaText);

// Müssen wir hier überhaupt was tun?
If (strl_ExFrom.Count > 0) Then
Begin
strl_MessageText.Text := Message.Text;
End;

If ( (strl_MessageText.Count > 0) and (Pos('User-Agent:', strl_MessageText.Text) <> 0) ) Then
Begin
b_UAString_vorhanden := true;
End;

// From:-String auslesen und mit Vorgabe vergleichen
If (
( (strl_ExFrom.Count > 0) and (b_UAString_vorhanden = true) )
and
( ( (IsEmail = true) and (b_Remove_UAInAllEmails = false) ) or ( (IsEmail = false) and (b_Remove_UAInAllNews = false) ) )
) Then
Begin
For i := 0 To strl_MessageText.IndexOf('') - 1 Do
Begin
// From:-String auslesen
If AnsiPos('From:' , strl_MessageText[i]) = 1 Then
Begin
str_H := Trim(Copy(strl_MessageText[i], AnsiPos(' ', strl_MessageText[i]) + 1, Length(strl_MessageText[i])));
str_H := AnsiLowerCase(str_H);
Break;
End;
End; // End For

// Ausgelesenen From:-String prüfen und bei Übereinstimmung mit Vorgabe
// Flag setzen, um Entfernung des UA-Strings zu verhindern
If str_H <> '' Then
Begin
For i := 0 To strl_ExFrom.Count - 1 Do
Begin
If AnsiPos(strl_ExFrom[i], str_H) > 0 Then
Begin
b_Remove_UA := false;
Break;
End;
End; // End For
End;

End;


// User-Agent jetzt entfernen, falls vorhanden und Flag gesetzt
If ( (b_UAString_vorhanden = true) and (b_Remove_UA = true) ) Then
Begin
For i := 0 To strl_MessageText.IndexOf('') - 1 Do
Begin
If AnsiPos('User-Agent:' , strl_MessageText[i]) = 1 Then
Begin
strl_MessageText.Delete(i);
b_Message_changed := true;
Break;
End;
End; // End For
End;

// Geànderte Nachricht übernehmen
If ( b_Message_changed = true ) Then
Begin
Message.Clear;
Message.Text := strl_MessageText.Text;
End;

strl_MessageText.Free;
strl_ExFrom.Free;

End;

//-


Bitte schön.

/
°
 

Lesen sie die antworten

#1 Hermann Hippen
07/05/2013 - 16:41 | Warnen spam
Es schrieb Vínzenz Ahréndt:

[SKRIPT]

Gibt es schon hier:
http://kh-rademacher.de/4d/RemoveAn...clude.html

Mit dem kann man beliebige Header entfernen lassen.

*40tDlg Skripts : http://4d.vollmeier.at/
*40tDlg FAQ : http://www.wolfgang-bauer.at/4td_faq/
*Raady's 40tDlg Archiv : http://kh-rademacher.de/4d/
*AP Hamster & KN : http://h-hippen.de/kn.html

Ähnliche fragen