[BUGFIX] L1-Script - RefHeaderKuerzen_include

31/01/2009 - 03:29 von Hermann Hippen | Report spam
Moin Moin :-),

B U G F I X - Unter bestimmten Umstànden verschwand der References
Header wie von Zauberhand - gefixt

Sollte ein Script zum References Header falten benutzt werden, muss das
nach diesem Script ausgeführt werden, da sonst das Falten durch dieses
Script wieder aufgehoben wird.

Dieses Script kürzt den References Header. Die maximale Anzahl der
RefHeader kann im Kopf des Script's eingegeben werden.

Speichern unter 'Eigene Scripte' als RefHeaderKuerzen_include

Einbindung/Aufruf in OnBeforeSavingMessage:

| Program OnBeforeSavingMessage;
| uses textfile, Forms, StdCtrls;

| {$I RefHeaderKuerzen_include}


| Procedure OnBeforeSavingMessage( Var Message : TStringlist;
| Const Servername : String;
| Const IsEmail : Boolean );
| Begin
| If Message.Count = 0 Then Exit;

| RefHeaderKuerzen(Message);


| End;
| Begin
| End.


Beispiel, der Ref Header soll gekürzt werden, eingestellt sind im Kopf
des Script's maximal 3 Ref Header die angezeigt werden sollen.

Der Original Header:

| References: <290109.002137.d.c.s.4-d.2771@hesa.ath.cx> <-- Aktuelle Ref Mid
| <290109.142647.dcs4d.337@reinhard.irmer.dialin.t-online.de>
| <290109.153024.d.c.s.4-d.2773@40tude.net>
| <290109.154236.d.c.s.4-d.262@joachimreiter.my-fqdn.de>
| <290109.163450.d.c.s.4-d.2776@40tude.net> <-- Ursprungs MID

nach dem Kürzen:

| References: <290109.002137.d.c.s.4-d.2771@hesa.ath.cx> <-- Aktuelle Ref Mid
| <290109.154236.d.c.s.4-d.262@joachimreiter.my-fqdn.de>
| <290109.163450.d.c.s.4-d.2776@40tude.net> <-- Urprungs Mid

Die aktuelle Ref Mid (direkt neben References) bleibt stehen und die MID
des Ursprungspostings bleibt stehen. Dazwischen wird gekürzt.

8<--[ RefHeaderKuerzen_include ]-->8
// RefHeaderKuerzen_include. Stand: 31.01.2009
Function MaxRefHeader:Integer;
Begin
// Hier die maximale Zahl der Ref Header angeben.
Result := 3;
End;
Function CountRefHeader(Var rh: String):Integer;
Var i: Integer;
Begin
Result := 0;
For i := 1 to Length(rh) Do if rh[i]='>' Then Result := Result + 1;
End;
Procedure ReferencesStr(Message: TStringlist; Var L:Integer; Var H:String);
Var i, j : Integer;
Begin
h := ''; i := 0 ;
Repeat
If Pos('References:',Message[i]) = 1 Then
Begin
L := I;
Repeat
j := AnsiPos('<', Message[i]);
h := h + ' ' + Trim(Copy(Message[i], j, Length(Message[I])));
Message.Delete(i);
Until ( Message[i][1] <> ' ') And ( Message[i][1] <> Chr(9));
Exit;
End;
i := i + 1;
Until Message[i] = '';
End;
Procedure RefHeaderKuerzen(Var Message:TStringlist);
Var Max,rhc,posi : Integer;
tmp,rh1 : String;
Begin
Max := MaxRefHeader;
ReferencesStr(Message,posi,tmp);
If tmp = '' Then Exit;
rhc := CountRefHeader(tmp) - Max;
If rhc > 0 Then
Begin
rh1 := Trim(Copy(tmp,Pos('<',tmp), Pos('>',tmp)));
Repeat
tmp := Copy(tmp,Pos('>',tmp) + 1, Length(tmp));
rhc := rhc - 1;
Until rhc = -1;
Message[posi]:='References: ' + rh1 + ' ' + Trim(tmp);
End Else Message[posi] := 'References: ' + tmp;
End;
8<-->8

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

Lesen sie die antworten

#1 Dieter Goebel
31/01/2009 - 11:53 | Warnen spam
Hermann Hippen schrieb:

Moin Moin :-),

B U G F I X - Unter bestimmten Umstànden verschwand der References
Header wie von Zauberhand - gefixt



Vielen Dank, Hermann, jetzt klappts wie gewünscht. Ich war gestern
schon zu müde zum Weitertesten mit meinen installierten Scripten,
wollte jetzt gerade damit anfangen und - siehe da, du hast die Lösung
offenbar in Nachtschicht gefunden.

Da alles nun funktioniert, verzichte ich auf ein reply auf dein


Danke nochmal.


Gruss, Dieter

Wenn du jemandem einen Gefallen tust, gehört das sofort zu deinem Job

Ähnliche fragen