[NEU/FINAL] L1-Script - RefHeaderKuerzen_include

30/01/2009 - 08:02 von Hermann Hippen | Report spam
Moin Moin :-),

Ich hab es jetzt ausgiebig getestet und mich auch daran erinnert, das
der Ref Header nicht nur Leerzeichen zwischen den > < enthalten kann und
deshalb noch eine kleine Routine mit eingebaut, die dafür sorgt das der
Ref-Header korrekt eingelesen 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: 29.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, BM_MaxInt));
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);
Exit;
End;
End;
8<-->8

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

Lesen sie die antworten

#1 Reinhard Irmer
30/01/2009 - 14:11 | Warnen spam
Hallo *hiPP€r hErrMAnn*,

*_Hermann Hippen_* schrieb:
Ich hab es jetzt ausgiebig getestet



[...]

h := h + ' ' + Trim(Copy(Message[i], j, BM_MaxInt));


¯¯¯¯¯¯¯¯¯
das hier wird beim Kompilieren des OBSave angemeckert.


Viele Gruesse
Rεìñhατδ

,--[ *schwueles Geduenst* ]
[ liegt in der Luft und auf dam
[ Classic-Hamster 2.1.0.1501enh
`-

Ähnliche fragen