ueberarbeitetes Script "AttributionLines_include"

05/04/2008 - 21:53 von Thomas Barghahn | Report spam
Hallo zusammen,

alle diejenigen, welche schon mit diesem Script vertraut sind, können es
hier nun updaten.
Eine komplette Version mit dem dazugehörenden ini-File wird in Kürze auf
den Seiten von *Karl-Heinz Rademacher* erscheinen.

*Nur* der Include-File ist auszutauschen und *nicht* zu kompilieren!
*Neu kompiliert wird nur das Ereignisscript "OnBeforeSendingMessage"!*

Das Script wurde nach einer Idee von *Dietmar Vollmeier* dahin geàndert,
dass in der Einleitungszeile nun auch *nur der Vorname* des vorherigen
Posters "eingebaut" werden *kann* (also nicht muss<!>).


procedure Init_Change_Attribution_Lines ( var ChangeInEmails : boolean;
var ChangeInNews : boolean;
var ChInEmails : boolean;
var ChInNews : boolean;
var MyDialogFolder : string;
var MyIniFile : string;
var FullToFirst : boolean;
var ConstStartName : string;
var ConstEndName : string;
var bold : boolean;
var italic : boolean
);
begin

// Autoren: Dietmar Vollmeier & Thomas Barghahn
// Date : 2008/04/05


// -
// Configuration settings
// -

// Change name(s) in emails and/or postings
// set 'true' or 'false'
ChangeInEmails := true;
ChangeInNews := true;

// Change this to "false" if you don't want to use the
// "Attribution_Line.ini" in mails
ChInEmails :=true;

// Change this to "true" if you want to use the
// "Attribution_Line.ini" in newsgroups
ChInNews := false;

// set the Žname(s) you want to change in File "MyIniFile"
MyDialogFolder := 'C:\Programme\40tude_Dialog\';
MyIniFile := 'Attribution_Lines.ini';

// change FullName to FirstName?
// set 'true' or 'false'
// e.g. Dietmar Vollmeier => Dietmar
FullToFirst := false;

// Defines start-tag for name recognition.
// Everything after that (and between end-tag) is recogniced as name.
ConstStartName := '/*';

// Defines end-tag of name recognition.
// Please use chars, you normaly not type inside your text.
ConstEndName := '*/';

// name in bold and/or italic?
// set 'true' or 'false'
bold := true; // fett
italic := false; // kursiv

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

end;

// //
// - No user maintainable parts below this line -- //
// //


procedure Change_Attribution_Lines ( Message : TStringlist;
IsEmail : boolean
);

var i, k, MaxInt : integer;
DelimiterPos : integer;
rf : TReplaceFlags;
MyDialogFolder : String;
MyIniFile : String;
AttributionList : TStringList;
ChangeNameList : TStringlist;
ReplaceNameList : TStringList;
ChangeInEmails : boolean;
ChangeInNews : boolean;
ChInEmails : boolean;
ChInNews : boolean;
FullToFirst : boolean;
ConstStartName : string;
ConstEndName : string;
FullName : string;
FirstName : string;
Found_in_ini : boolean;
bold : boolean;
italic : boolean;
BoldString : String;
ItalicString : String;

begin
rf := [rfReplaceAll];
MaxInt := 2147483647;
i := 0;
FullName := '';
FirstName := '';
Found_in_ini := false;
BoldString := '';
ItalicString := '';
Init_Change_Attribution_Lines (
ChangeInEmails, ChangeInNews, ChInEmails, ChInNews, MyDialogFolder,
MyIniFile, FullToFirst, ConstStartName,
ConstEndName, bold, italic);
If bold = true then BoldString := '*';
If italic = true then ItalicString := '/';
if ((IsEmail=true) and (ChangeInEmails=true)) or
((IsEmail=false) and (ChangeInNews=true)) then begin
try
AttributionList := TStringlist.Create;
AttributionList.LoadFromFile(MyDialogFolder + MyIniFile);
ReplaceNameList := TStringlist.Create;
ChangeNameList := TStringlist.Create;
AttributionList.Add (#10#13);
for k := 0 to AttributionList.Count - 1 do begin
If copy (AttributionList[k], 1, 1) <> ';' then begin
DelimiterPos := pos (',', AttributionList[k]);
ChangeNameList.Add (trim (copy ( AttributionList[k], 1, DelimiterPos - 1 )));
ReplaceNameList.Add (trim (copy ( AttributionList[k], DelimiterPos + 1, MaxInt )));
end; // if
end; // for
// searching for 1st Bodyline (Attribution_Line)
while (Message.Strings[i]<>'') do begin
i := i + 1;
end; // while
// searching for 'X-Comment-To-Header
// see "Insert_XCT_Header_include.ds"
if copy (Message.Strings[i], 1, 6) = 'X-C-T:' then
i := i + 2
else
i := i + 1;
If FullToFirst = True then begin
FullName := copy ( Message.Strings[i], pos (ConstStartName, Message.Strings[i]) + length(ConstStartName),
pos (ConstEndName, Message.Strings[i]) - (pos (ConstStartName, Message.Strings[i]) + length(ConstStartName)));
If pos (' ',FullName) > 0 then
FirstName := copy (FullName, 1, pos (' ', FullName) - 1)
else
FirstName := FullName;
end;
k := 0;
If (( IsEmail=true ) and ( ChInEmails=true )) or
(( IsEmail=false ) and ( ChInNews=true )) then begin
while k <= ( ChangeNameList.Count - 1 ) do begin
if (pos( ChangeNameList[k], Message.Strings[i] ) <> 0) then begin
Message.Strings[i] := StringReplace(Message.Strings[i],ChangeNameList[k],ReplaceNameList[k],rf);
Found_in_ini := true;
end;
k := k + 1;
end; // while
end; // if
If (Found_in_ini = false) and (FullToFirst = True) then
Message.Strings[i] := StringReplace(Message.Strings[i],FullName,FirstName,rf);
finally
AttributionList.Free;
ChangeNameList.Free;
ReplaceNameList.Free;
end; // try - finally
end; // if
Message.Strings[i] := StringReplace(Message.Strings[i],ConstStartName,ItalicString + BoldString,rf);
Message.Strings[i] := StringReplace(Message.Strings[i],ConstEndName,BoldString + ItalicString,rf);
end; // procedure


Fragen zu diesem Script werden - wie immer - natürlich in dieser Gruppe
beantwortet.

Freundliche Grüße
Thomas Barghahn
+++ +++ +++ +++ +++ +++ +++ +++ +++ ++
Richtig Quoten ist nichts für Idioten!
+++ +++ +++ +++ +++ +++ +++ +++ +++ ++
 

Lesen sie die antworten

#1 Reinhard Irmer
06/04/2008 - 00:26 | Warnen spam
Hallo /*tHoMaS*/,

am 05.Apr.2008 schrieb *Thomas Barghahn*:

Supersedes
Hallo zusammen,

alle diejenigen, welche schon mit diesem Script vertraut sind, können es
hier nun updaten.



done :-)

Feine Sache das Teil; DANKE


Viele Gruesse
Reinhard

,- [3 weisse Bi-hirken] -.
| in meiner Heimat steh'n und auf |
| dem Classic- Hamster 2.1.0.1501 |
''

Ähnliche fragen