//********************************************************************* //* Change_Intro_Lines 2021-10-24 * //* >> OnBeforeSendingMessage << * //* * //* Dieses Script ändert Namen in der Einleitungszeile und setzt * //* die "Ingrid" nach Wunsch. * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : überarbeitet am 24.10.2021 * //* Autoren : Dietmar Vollmeier & Thomas Barghahn (2008-05-18) * //* * //* DateiName : _i_OBSendM_Change_Intro_Lines.ds * //* Einbindung: {$I _i_OBSendM_Change_Intro_Lines.ds} * //* Aufruf : Result := Change_Intro_Lines ( Result, Message, * //* IsEmail, Error_Func); * //********************************************************************* procedure Init_Change_Intro_Lines ( var GreetingLine : string; var ChIntroInEmails : boolean; var ChIntroInNews : boolean; var MyIniFile : string; var FullToFirst : boolean; var ConstIntroStartName : string; var ConstIntroEndName : string; var bold : boolean; var italic : boolean ); begin //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} // Grußformel bei neuen Postings // ============================= // Hier kannst du einen Begrüßungstext eingeben, der // erscheint, wenn du ein /neues/ Posting erstellst. // Gibst du keinen Text ein wird auch nichts eingefügt. // Es sind alle Zeichen innerhalb des ANSI-Zeichensatzes erlaubt! // GreetingLine := ''; // keine Begrüßungstext // GreetingLine := 'Hallo zusammen,'; // "Hallo zusammen," und // eine Leerzeile // GreetingLine := 'Grüß euch,'; // "Grüß euch," und // eine Leerzeile GreetingLine := ''; // Grußformel bei Antworten // ======================== // Sollen die Änderungen in E-Mails und/oder News vorgenommen // werden? // Setze hier 'true' or 'false' ChIntroInEmails := false; ChIntroInNews := true; // Setze die Namen, welche du ändern möchtest, in der Datei // "MyIniFile", welcher sich im *Dialog-Verzeichnis* befindet! MyIniFile := 'Intro_Lines.ini'; // Namen kürzen auf den 1. Namensteil (Vorname)? // Setze auf 'True' oder 'False' // z.B. Thomas Barghahn -> Thomas FullToFirst := False; // Definiere einen "Start-Tag" für die Namenserkennung. // Alles danach (und zwischen dem End-Tag) wird als Name erkannt. ConstIntroStartName := '/*'; // Definiere einen "End-Tag" für die Namenserkennung. // Verwende eine Kombination, welche in deinen Texten nie // verwendet wird ConstIntroEndName := '*/'; // Soll der Name *fett* oder /kursiv/ dargestellt werden? // Setze jeweils 'true' oder 'false' bold := true; // fett italic := false; // kursiv //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} end; //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} //--[ START Function Change_Attribution_Lines ]------------------------ Function Change_Intro_Lines ( fbkResult : Boolean; Message : TStringlist; IsEmail : Boolean; var Error_Func : String ) : Boolean; var i, MaxInt : integer; rf : TReplaceFlags; GreetingLine : String; ChIntroInEmails : boolean; ChIntroInNews : boolean; MyIniFile : String; FullToFirst : boolean; ConstIntroStartName : string; ConstIntroEndName : string; bold : boolean; italic : boolean; Replace_Name : String; FullName : string; FirstName : string; Found_in_ini : boolean; BoldString : String; ItalicString : String; Ref_Ebene : Integer; NewPost : boolean; NG_Name : String; INI_FileNotFound : String; strTxt : String; begin // Rückgabewert entsprechend vorheriger Scriptprobleme setzen Result := fbkResult; INI_FileNotFound := 'Die Datei "%fname%" konnte nicht gefunden werden!' + #10#13 + 'Soll Dialog *OHNE* "Change_Intro_Lines" fortfahren?'; // Wenn bereits irgendein Script einen Fehler verursacht hat, // dann braucht dieses hier nicht mehr ausgeführt werden If Not Result Then begin WriteToLog ('==== ANFANG =======================================' ,4); WriteToLog ('Script *** Change_Intro_Lines *** wurde nicht mehr ausgefuehrt' ,4); WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4); WriteToLog ('==== ENDE =========================================' ,4); Exit; end; // Liegt ein Supersedes oder ein Cancel vor, dann wird sofort abgebrochen! If (GetHeaderLine ('Supersedes: ', Message) > 0) or (GetHeaderLine ('Control: ', Message) > 0) then begin Exit; // Function end; Init_Change_Intro_Lines ( GreetingLine, ChIntroInEmails, ChIntroInNews, MyIniFile, FullToFirst, ConstIntroStartName, ConstIntroEndName, bold, italic ); If ((IsEmail=true) and (ChIntroInEmails=true)) or ((IsEmail=false) and (ChIntroInNews=true)) then begin if (FileExists(MyIniFile) = false) then begin strTxt := stringReplace(INI_FileNotFound, '%fname%', MyIniFile, [rfReplaceAll]); if MsgBox(0, strTxt, 'ACHTUNG - Ein Hinweis:', MB_YesNo or MB_IconExclamation) = IDNO then begin WriteToLog ('Script *** Change_Intro_Lines *** wurde nicht mehr ausgefuehrt' + #13#10 + 'Datei "' + MyIniFile + '" wurde nicht gefunden!' + #13#10 + '*** ABBRUCH DURCH USER ***',4); Error_Func := '*** Change_Intro_Lines *** WURDE ABGEBROCHEN -- DER USER'; Result := false; end; end else begin With Message do begin Try rf := [rfReplaceAll]; MaxInt := 2147483647; i := 0; NewPost := True; FullName := ''; FirstName := ''; Found_in_ini := false; BoldString := ''; ItalicString := ''; If bold = true then BoldString := '*'; If italic = true then ItalicString := '/'; // searching for 1st Bodyline (Attribution_Line) while (Strings[i]<>'') do begin // Wenn Supersedes dann Script Ende If AnsiPos('Supersedes:' , Strings[i]) = 1 Then Exit; // Wenn Cancel Post dann Script Ende If AnsiPos('Control: cancel', Strings[i]) = 1 Then Exit; // Suche nach References - bei neuen Postings sind keine vorhanden If AnsiPos('References:' , Strings[i]) = 1 Then Begin Ref_Ebene := CAL_CountChar(Strings[i], ' '); NewPost := false; end; // If // Gruppennamen aus Header holen If AnsiPos('Newsgroups:' , Strings[i]) = 1 Then NG_Name := Strings[i]; i := i + 1; end; // while i := i + 1; If (NewPost = True) and (GreetingLine <> '') then begin GreetingLine := check_charset ('Change_Intro_Name', GreetingLine, Message); Insert (i, GreetingLine + chr(13) + chr(10)); end else begin // Suche nach 'X-Comment-To-Header' // siehe: "Insert_XCT_Header_include.ds" // Suche nach 'sign' // siehe: "GPGsign_include.ds" if (copy (Strings[i], 1, 6) = 'X-C-T:') or (copy (Strings[i], 1, 4) = 'sign') then begin if copy (Strings[ i + 1 ], 1, 6) = 'X-C-T:' then begin i := i + 2; end else begin i := i + 1; end; // If else end; // If (copy (Strings[i] ... FullName := copy ( Strings[i], pos (ConstIntroStartName, Strings[i]) + length(ConstIntroStartName), pos (ConstIntroEndName, Strings[i]) - (pos (ConstIntroStartName, Strings[i]) + length(ConstIntroStartName))); If FullToFirst = True then begin If pos (' ',FullName) > 0 then FirstName := copy (FullName, 1, pos (' ', FullName) - 1) else FirstName := FullName; end; // If FullToFirst If (pos (ConstIntroStartName, Strings[i] ) <> 0) then begin Replace_Name := Read_Ini (MyIniFile, 'Introduction_Settings', FullName); If (Replace_Name <> '') and (ansipos(Replace_Name, Strings[i]) = 0) then begin Strings[i] := StringReplace(Strings[i],FullName,Replace_Name,rf); Found_in_ini := true; end; // If Replace_Name ... end; // if (pos (ConstIntroStartName ... If (Found_in_ini = false) and (FullToFirst = True) and (pos( ConstIntroStartName, Strings[i] ) <> 0) then Strings[i] := StringReplace(Strings[i],FullName,FirstName,rf); end; // else begin Strings[i] := StringReplace(Strings[i],ConstIntroStartName,ItalicString + BoldString,rf); Strings[i] := StringReplace(Strings[i],ConstIntroEndName,BoldString + ItalicString,rf); Except // Bei Problemen das Senden der Nachricht unterbinden begin WriteToLog ('FEHLER im Script *** Change_Intro_Lines ***' ,5); Error_Func := '*** Change_Intro_Lines ***'; Result := false; end; // Except end; // Try - Except end; // With end; // FileExist end; // If IsEmail ... end; // Function //--[ ENDE Function Change_Attribution_Lines ]-------------------------