//********************************************************************* //* XPost_and_FUp2_Information 2020-04-25 * //* >> OnBeforeSendingMessage << * //* * //* Dieses Script setzt Informationen zum F'up2 und schreibt alle * //* relevanten Gruppen ans Ende des Bodys. * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : unbekannt * //* Autoren : unbekannt * //* Überarbeitung: Thomas Barghahn (25.04.2020) * //* * //* DateiName : _i_OBSendM_XPost_and_FUp2_Information.ds * //* Einbindung: {$I _i_OBSendM_XPost_and_FUp2_Information.ds} * //* Aufruf : * //* Result := XPost_and_FUp2_Information (Result, Message, * //* IsEmail, Error_Func); * //********************************************************************* procedure Init_XPost_and_FUp2_Information ( var MessageXPost : String; var MessageFup2 : String; var GLClickable : Boolean ); begin //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} MessageXPost := 'X'+#39+'Post to: '; MessageFup2 := 'F'+#39+'up2 : '; // Sollen die Gruppen klickbar sein? Setze 'True' oder 'False' GLClickable := true; //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} end; //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} //--[ START Function XPost_and_FUp2_Information ]---------------------- Function XPost_and_FUp2_Information ( fbkResult : Boolean; Message : TStringlist; IsEmail : Boolean; var Error_Func : String) : Boolean; var FUP2, XPost, Header: boolean; i,j,CommaPos, SigLine: integer; s, Fup2Group, XPostGroups: string; MessageXPost : string; MessageFup2 : string; GLClickable : Boolean; XPG_String : TStringList; begin // Bei einer Email wird sofort abgebrochen If IsEmail = true then Exit; // Rückgabewert entsprechend vorheriger Scriptprobleme setzen Result := fbkResult; // 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 *** XPost_and_FUp2_Information *** wurde nicht mehr ausgefuehrt' ,4); WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4); WriteToLog ('==== ENDE =========================================' ,4); Exit; end; Init_XPost_and_FUp2_Information ( MessageXPost, MessageFup2, GLClickable ); FUP2:=false; XPost:=false; Header:=true; SigLine:=0; Try XPG_String := TStringlist.Create; for i:=0 to Message.count-1 do begin s:= message.strings[i]; if s='' then header:=false; if header=true then begin; if Pos('Followup-To:',s)>0 then begin FUP2:=true; if copy(s,14,length(s)-13) <> 'poster' then if GLClickable = True then Fup2Group := '<news:' + copy(s,14,length(s)-13) + '>' else Fup2Group := copy(s,14,length(s)-13) else Fup2Group := 'poster'; end; // if if Pos('Newsgroups:',s)>0 then if Pos(',',s)>0 then begin XPost:=true; XPostGroups:=copy(s,13,length(s)-12); if ansipos ( ',', XPostGroups) = 0 then begin if GLClickable = True then XPG_String.Add ('<news:' + XPostGroups + '>') else XPG_String.Add (XPostGroups); end else begin CommaPos := 0; for j := 1 to length (XPostGroups) do begin If XPostGroups[j] = ',' then begin if GLClickable = True then XPG_String.Add ('<news:' + copy (XPostGroups, CommaPos + 1 , j - ( CommaPos + 1 )) + '>,') else XPG_String.Add (copy (XPostGroups, CommaPos + 1 , j - ( CommaPos + 1 )) + ','); CommaPos := j; end; if j = length (XPostGroups) then if GLClickable = True then XPG_String.Add ('<news:' + copy (XPostGroups, CommaPos + 1 , j - CommaPos ) + '>') else XPG_String.Add (copy (XPostGroups, CommaPos + 1 , j - CommaPos )) end; // for end; // else end; //if end else if s='-- ' then SigLine:=i; end; //for XPostGroups := ''; For j := 0 to XPG_String.Count - 1 do begin XPostGroups := XPostGroups + XPG_String.Strings[j]; end; //for if FUP2=true then if Sigline=0 then Message.Add(MessageFup2+Fup2Group) else Message.Insert(Sigline,MessageFup2+Fup2Group); if XPost=true then if Sigline=0 then Message.Add(MessageXPost+XPostGroups) else Message.Insert(Sigline,MessageXPost+XPostGroups); if (FUP2=true) or (XPost=true) then if Sigline=0 then Message.Add('') else Message.Insert(SigLine,''); Except // Bei Problemen das Senden der Nachricht unterbinden begin WriteToLog ('FEHLER im Script *** XPost_and_FUp2_Information ***' ,5); Error_Func := '*** XPost_and_FUp2_Information ***'; Result := false; end; // Except Finally XPG_String.free; end; // Try ... Except ... Finally end; // Function //--[ ENDE Function XPost_and_FUp2_Information ]-----------------------