Skripte, die die Welt nicht braucht [Reloaded 2] - Insert_DispositionNotificationTo

11/05/2013 - 19:18 von Vínzenz Ahréndt | Report spam
Hallo,

habe noch einen kleinen Schönheitsfehler entsorgt.

Beschreibung siehe Config Part.

Der übliche Einbau in OnBeforeSendingMessage:

//-

program OnBeforeSendingMessage;

// [...]

{$I Insert_DispositionNotificationTo.ds}


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

begin

// Your code goes here

// [...]


// Disposition-Notification-To in Email einfügen
Insert_DispositionNotificationTo ( Message, IsEmail );


end;

begin
end.

//-


Die Init-Routine und das Skript selbst:

//-

//--[Procedure Init_Insert_DispositionNotificationTo]-
Procedure Init_Insert_DispositionNotificationTo ( Var StartLine, FromLine, ReplyToLine, PriorityLine : String );
Begin
//-
// Configuration settings
//-
// 1. Auf Wunsch Einfügen des Headers "Disposition-Notification-To:" in
// Emails
// 2. Einer Email auf Wunsch eine hohe Prioritàt zuweisen
//
// Anm.: Ob dies beim Email-Empfànger jedoch wirklich etwas bewirkt, hàngt
// von der Konfiguration beim Email-Empfànger ab, wie dort mit diesen
// Headern umgegangen werden soll.
//
// Es kann gewàhlt werden, ob für den Header "Disposition-Notification-To:"
// die Email-Adresse aus dem From: oder dem Reply-To: verwendet werden
// soll.
//
// Anm.: Keine der Email-Adressen wird auf Plausibiltàt oder Gültigkeit hin
// geprüft. Es wird nur der Header mit der angegebenen Email-Adresse
// eingefügt. Wird Reply-To: gewàhlt, ohne daß ein Reply-To: im Header
// existiert, wird die From:-Adresse verwendet.
//
// StartLine, FromLine oder ReplyToLine und Priorityline müssen im Message-
// Body in unmittelbar aufeinanderfolgenden Zeilen und dort jeweils am
// Zeilenanfang stehen.
// In derselben Zeile darf kein anderer Text auftauchen.
// Die Priorityline kann wahlweise weggelassen werden. Ist sie im Body
// vorhanden,wird auf hohe Prioritàt umgestellt.
// Nach dem Versand werden StartLine, FromLine oder ReplyToLine und
// Priorityline wieder aus dem Message-Body entfernt.
//
// Anm.: Die Prioritàt allein ohne "Disposition-Notification-To:" kann mit
// diesem Skript nicht geàndert werden.
//
// Ist einer der nachfolgenden Parameter nicht gesetzt, wird die Prozedur
// nicht ausgeführt. Dies gilt auch für den Fall, daß womöglich ein
// Disposition-Notification-To:-Header bereits vorhanden ist. Ebenso
// erfolgt keine Ausführung des Skripts bei Postings in NGs.
//
// Keine Tabs, keine Leerzeichen in den Parametern!


// StartLine := '--disposnoti';
StartLine := '--disposnoti';

// Fromline := '--from';
FromLine := '--from';

// ReplyToLine := '--replyto';
ReplyToLine := '--replyto';

// Priorityline := '--high';
PriorityLine := '--high';


// Beispiele möglicher Ansendungen im Message-Body (hier natürlich
// mit //-Kommentarzeichen am Zeilenanfang):

// --disposnoti
// --from
// --high

// --disposnoti
// --replyto
// --high

// --disposnoti:
// --from

// --disposnoti:
// --replyto

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


//--[Check_I_DNT_Priority]-
Function Check_I_DNT_Priority ( i : Integer; str_PriorityLine : String; Message : TStringList ) : Boolean;

Var
b_Result : Boolean;


Begin
b_Result := false;

If (i < Message.Count - 2) Then
Begin
If (AnsiPos(str_PriorityLine , Message[i + 2]) = 1) Then
Begin
b_Result := true;
End;
End;

Result := b_Result;

End; // End Function


//--[Get_I_DNT_Header]--
Function Get_I_DNT_Header ( strl_MessageHeader : TStringList; str_SearchH : String ) : String;

Var
i : Integer;

str_H : String;


Begin
str_H := '';

For i := 0 To strl_MessageHeader.IndexOf('') - 1 Do
Begin
If AnsiPos(str_SearchH, AnsiLowerCase(strl_MessageHeader[i])) = 1 Then
Begin
str_H := Trim(Copy(strl_MessageHeader[i], AnsiPos(' ', strl_MessageHeader[i]) + 1, Length(strl_MessageHeader[i])));

// Header mehrzeilig?
i := i + 1;
While Trim(Copy(strl_MessageHeader[i], 1, 1)) = '' Do
Begin
If i = strl_MessageHeader.IndexOf('') Then
Break;

str_H := str_H + ' ' + Trim(strl_MessageHeader[i]);
i := i + 1;
End; // End While

Break;
End;
End; // End For

Result := str_H;

End; // End Function


//--[Get_I_DNT_MailAdi_from_Header]-
Function Get_I_DNT_EmailAdr_from_String ( str_Header : String ) : String;

Var
i,
j : Integer;


Begin
For i := 1 To (Length(str_Header)) Do
If str_Header[i] = '<' Then
Break;

For j := i To Length(str_Header) Do
If str_Header[i] = '>' Then
Break;

Result := Copy(str_Header, i + 1, j - i - 2);
End; // End Function


//--[Procedure Insert_I_DNT_Header]-
Procedure Insert_I_DNT_Header(strl_MessageHeader : TStringlist; str_Header, str_Insert : String; b_Set_Priority : Boolean);

Var
i : Integer;


Begin
i := strl_MessageHeader.IndexOf('');
strl_MessageHeader.Insert(i, str_Header + str_Insert);

If b_Set_Priority = true Then
Begin
strl_MessageHeader.Insert(i + 1, 'X-Priority: 1 (Highest) Importance: High');
strl_MessageHeader.Insert(i + 2, 'X-MSMail-Priority: High');
End;
End;


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

var
strl_MessageHeader : TStringList;

b_fangenwirgarnichterstan,
b_Use_From,
b_Use_ReplyTo,
b_Set_Priority : Boolean;

i,
j,
k,
i_StartLine : integer;

str_H,
str_StartLine,
str_FromLine,
str_ReplyToLine,
str_PriorityLine : String;


Begin
strl_MessageHeader := TStringList.Create;

b_fangenwirgarnichterstan := false;
b_Use_From := false;
b_Use_ReplyTo := false;
b_Set_Priority := false;
str_H := '';


// Ist ein Disposition-Notification-To:-Header bereits vorhanden?
For i := 0 To Message.IndexOf('') - 1 Do
Begin
If AnsiPos('disposition-notification-to:' , AnsiLowerCase(Message[i])) = 1 Then
Begin
b_fangenwirgarnichterstan := true;
Break;
End;
End; // End For


// Init
If ( (b_fangenwirgarnichterstan = false) and (IsEmail = true) ) Then
Begin
Init_Insert_DispositionNotificationTo ( str_StartLine, str_FromLine, str_ReplyToLine, str_PriorityLine );
str_StartLine := StringReplace(str_StartLine, ' ', '', [rfReplaceAll, rfIgnoreCase]);
str_StartLine := StringReplace(str_StartLine, #9, '', [rfReplaceAll, rfIgnoreCase]);
str_FromLine := StringReplace(str_FromLine, ' ', '', [rfReplaceAll, rfIgnoreCase]);
str_FromLine := StringReplace(str_FromLine, #9, '', [rfReplaceAll, rfIgnoreCase]);
str_ReplyToLine := StringReplace(str_ReplyToLine, ' ', '', [rfReplaceAll, rfIgnoreCase]);
str_ReplyToLine := StringReplace(str_ReplyToLine, #9, '', [rfReplaceAll, rfIgnoreCase]);
str_PriorityLine := StringReplace(str_PriorityLine, ' ', '', [rfReplaceAll, rfIgnoreCase]);
str_PriorityLine := StringReplace(str_PriorityLine, #9, '', [rfReplaceAll, rfIgnoreCase]);

If ( (str_StartLine = '') or (str_FromLine = '') or (str_ReplyToLine = '') or (str_PriorityLine = '') ) Then
b_fangenwirgarnichterstan := true;

End;


// Prüfen, ob im Message-Body StartLine, FromLine oder ReplyToLine (und PriorityLine) in Folge auftauchen
If b_fangenwirgarnichterstan = false Then
Begin
For i := Message.IndexOf('') + 1 To Message.Count - 2 Do
Begin
If ( (AnsiPos(str_StartLine , Message[i]) = 1) and (AnsiPos(str_FromLine , Message[i + 1]) = 1) ) Then
Begin
b_Use_From := true;
i_StartLine := i;
b_Set_Priority := Check_I_DNT_Priority ( i, str_PriorityLine, Message);
Break;
End;

If ( (AnsiPos(str_StartLine , Message[i]) = 1) and (AnsiPos(str_ReplyToLine , Message[i + 1]) = 1) ) Then
Begin
b_Use_ReplyTo := true;
i_StartLine := i;
b_Set_Priority := Check_I_DNT_Priority ( i, str_PriorityLine, Message);
Break;
End;
End; // End For
End;


If ( (b_Use_From = true) or (b_Use_ReplyTo = true) ) Then
Begin
// Message erst mal wieder reparieren
If b_Set_Priority = true Then
Message.Delete(i_StartLine + 2);

Message.Delete(i_StartLine + 1);
Message.Delete(i_StartLine);

// Header der Message (samt Leerzeile) übernehmen
i := Message.IndexOf('');
j := i;
For i := 0 To j Do
strl_MessageHeader.Add(Message[i]);

End;


// ReplyTo-Email-Adresse auslesen
If b_Use_ReplyTo = true Then
Begin

str_H := Get_I_DNT_Header (strl_MessageHeader, 'reply-to:');
str_H := AnsiLowerCase(str_H);

// ReplyTo-String nicht vorhanden
If str_H = '' Then
Begin
b_Use_From := true;
// Problem: Wàhrend der Anzeige der MessageBox wird ein Timeout-Fehler generiert, es erfolgt kein Versand
// der Nachricht mehr.
// I_DNT_MessageBox( 0, 'Für "Disposition-Notification-To:" wird die Email-Adresse aus dem From: verwendet.',
// 'Fehler: Kein Reply-To:-Header vorhanden', $40 );
End
Else
Begin
// Reply-To:-Adresse in Disposition-Notification-To: eintragen
Insert_I_DNT_Header(strl_MessageHeader, 'Disposition-Notification-To: ', str_H, b_Set_Priority);
End;
End;


// From-Email-Adresse auslesen
If b_Use_From = true Then
Begin
str_H := Get_I_DNT_Header (strl_MessageHeader, 'from:');
str_H := AnsiLowerCase(str_H);
str_H := Get_I_DNT_EmailAdr_from_String(str_H);

// From:-Adresse in Disposition-Notification-To: eintragen
Insert_I_DNT_Header(strl_MessageHeader, 'Disposition-Notification-To: ', str_H, b_Set_Priority);
End;


If ( (b_Use_From = true) or (b_Use_ReplyTo = true) ) Then
Begin
// Geànderte Header in Nachricht schreiben
// Anzahl Message-Header erhöhen
i := Message.IndexOf('');
k := i;
j := strl_MessageHeader.IndexOf('');
While i < j Do
Begin
Message.Insert(i, '--');
i := Message.IndexOf('');
End; // End While

// Geànderte Header abgleichen
For i := k - 1 To j - 1 Do
Message[i] := strl_MessageHeader[i];

End;

strl_MessageHeader.Free;

End;

//-


/
°
 

Lesen sie die antworten

#1 Hermann Hippen
11/05/2013 - 19:25 | Warnen spam
Es schrieb Vínzenz Ahréndt:

habe noch einen kleinen Schönheitsfehler entsorgt.



Es reicht jetzt aber wirklich... :-(


*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