//*********************************************************************
//*        _i_OBSendM_Add_KeywordsHeaderInTestGroups 2020-04-26       *
//*                   >> OnBeforeSendingMessage <<                    *
//*                                                                   *
//* Dieses Script setzt in Test-Gruppen den Header                    *
//* Keywords: ignore - no reply                                       *
//*                                                                   *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum        : 08.05.2014                                         *
//* Autoren      : Dietmar Vollmeier                                  *
//* Erweiterung  : Thomas Barghahn, 26.04.2020 (Corona-Zeit)          *
//* DateiName    : _i_OBSendM_NoReflectorsInTestGroups.ds             *
//* Einbindung   : {$I _i_OBSendM_NoReflectorsInTestGroups.ds}        *
//* Aufruf       :                                                    *
//*    Result := Add_KeywordsHeaderInTestGroups(Result, Message,      *
//*                                             IsEmail, Error_Func); *
//*********************************************************************

//{===================================================================}
//{           !!!  Ab hier bitte nichts mehr ändern  !!!              }
//{===================================================================}

//--[ START Function Add_KeywordsHeaderInTestGroups ]------------------

Function Add_KeywordsHeaderInTestGroups(fbkResult  : Boolean;
                                        Msg        : TStringList;
                                        IsMail     : Boolean;
                                        Error_Func : String) : Boolean;

Var i            : Integer;
    SubjectLine  : Integer;
    IsIgnore     : Boolean;
    IsTest       : Boolean;
    IsReferences : Boolean;

Begin
   // 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 *** Add_KeywordsHeaderInTestGroups *** wurde nicht mehr ausgefuehrt' ,4);
      WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4);
      WriteToLog ('==== ENDE =========================================' ,4);     
      Exit;
   end;   
  
  IsIgnore := False;
  IsTest := False;
  IsReferences := False;
  
  // Bei Mails wird sofort beendet

  If IsMail Then Begin
    Result := True;
    Exit;
  End;
  
  // Nach dem Newsgroups-Header suchen und nachsehen, ob das Posting
  // in eine Testgruppe gesendet wird
  // Nach dem Subject-Header suchen und nachsehen, ob dort ein
  // 'no reply' oder ein 'ignore' vorhanden ist
  // Nach dem References-Header suchen; ist es ein Erstposting?
  Try
  For i := 0 To Msg.IndexOf('') Do
  Begin
    If AnsiPos('Newsgroups: ', Msg[i]) = 1 Then Begin
      If (AnsiPos('.test.', Msg[i]) > 0) or
         (AnsiPos('.test,', Msg[i]) > 0) or
         (copy (Msg[i], 13, 5) = 'test.') or
         (copy (Msg[i], length (Msg[i]) - 4, 5) = '.test') then Begin
            IsTest := true;
      End; // If  
    End; // If 
    If AnsiPos('Subject: ', Msg[i]) = 1 Then Begin
      SubjectLine := i;
      If (AnsiPos('ignore', Msg[i]) > 0) or
         (AnsiPos('no reply', Msg[i]) > 0) then Begin
            IsIgnore := true;
      End; // If  
    End; // If
    If AnsiPos('References: ', Msg[i]) = 1 then Begin
       IsReferences := True;
    End; // If
  End; // For

  // In Testgruppen den Zusatz ' - ignore' im Subject setzen
  // Erstposting

  If (IsTest) and (not IsIgnore) and (not IsReferences) then begin 
     Msg[SubjectLine] := Msg[SubjectLine] + ' - ignore';
  end; // If   
 
  // In Testgruppen den Keywords-Header setzen

  If (IsTest) and (not IsIgnore) and (IsReferences) then begin
     Msg.Insert(Msg.IndexOf(''), 'Keywords: ignore - no reply');
  end; // If    
  Except
     // Bei Problemen das Senden der Nachricht unterbinden
     begin
        WriteToLog ('FEHLER im Script *** AddKeywordsHeaderInTestGroups ***' ,5);
        Error_Func := '*** Add_KeywordsHeaderInTestGroups ***';    
        Result := false;
      end; // Except
  end; // Try ... Except
End; // Function