//********************************************************************* //* Set_Lines_Header 2020-06-04 * //* >> OnBeforeSavingMessage << * //* * //* Dieses Script setzt einen Lines-Header, wenn dieser nicht * //* vorhanden oder falsch ist. * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : 04.05.2006; ueberarbeitet am: 04.06.2020 * //* Autoren : Thomas Barghahn, Dietmar Vollmeier * //* * //* DateiName : _i_OBSaveM_Set_Lines_Header.ds * //* Einbindung: {$I _i_OBSaveM_Set_Lines_Header.ds} * //* Aufruf : Not_Error := Set_Lines_Header (Not_Error, Message, * //* IsEmail, Error_Func); * //********************************************************************* procedure Init_Set_Lines_Header (var ChangeInEmails : Boolean; var ChangeInNews : Boolean ); begin //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} // Den Header in Mails und News setzen // Setze 'true' oder 'false' ChangeInEmails := true; ChangeInNews := true; //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} end; //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} //--[ START Function Set_Lines_Header ]-------------------------------- Function Set_Lines_Header (fbkResult : Boolean; Message : TStringlist; IsEmail : boolean; Error_Func : String) : Boolean; var i : integer; z : integer; ChangeInEmails : Boolean; ChangeInNews : Boolean; begin // Rückgabewert entsprechend vorheriger Scriptprobleme setzen Result := fbkResult; // Wenn bereits irgendein Script einen Fehler verursacht hat, // dann muss der User benachrichtigt werden If not Result Then begin WriteToLog ('==== ANFANG =======================================' ,4); WriteToLog ('Script *** Set_Lines_Header *** wird weiterhin ausgefuehrt' ,4); WriteToLog ('Script ' + Error_Func + ' hat diese WARNUNG verursacht!' ,4); WriteToLog ('==== ENDE =========================================' ,4); end; if Message.Count > 0 Then begin Init_Set_Lines_Header ( ChangeInEmails, ChangeInNews ); Try if ((IsEmail=true) and (ChangeInEmails=true)) or ((IsEmail=false) and (ChangeInNews=true)) then begin i := GetHeaderLine ('Lines:', Message); z := Message.IndexOf (''); If i > -1 then Message[i] := 'Lines: ' + IntToStr(Message.Count - 1 - z) Else Message.insert (z, 'Lines: ' + IntToStr(Message.Count - 1 - z)); end; Except // Bei Problemen den User benachrichtigen. begin WriteToLog ('FEHLER im Script *** Set_Lines_Header ***' ,4); WriteToLog ('From : ' + GetHeader('From: ', Message), 4); WriteToLog ('Newsgroups : ' + GetHeader('Newsgroups: ', Message), 4); WriteToLog ('Date : ' + GetHeader('Date: ', Message), 4); WriteToLog ('Message-ID : ' + GetHeader('Message-ID: ', Message), 4); Error_Func := '*** Set_Lines_Header ***'; Result := false; end; // Except end; // Try ... Except end; // If Message.Count > 0 ... end; // Function //--[ ENDE Function Set_Lines_Header ]---------------------------------