//*********************************************************************
//*              Add_UTF8_Organization_Header 2020-04-21              *
//*                   >> OnBeforeSendingMessage <<                    *
//*                                                                   *
//* Dieses Script überschreibt bzw. setzt einen Organization-Header   *
//* durch einen UTF-8 String!                                         *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum     : 21.04.2020  (Corona-Zeit)                             *
//* Autoren   : Thomas Barghahn                                       *
//*                                                                   *
//* DateiName : _i_OBSendM_Add_UTF8_Organization_Header.ds            *
//* Einbindung: {$I _i_OBSendM_Add_UTF8_Organization_Header.ds}       *
//* Aufruf    : Result := Add_UTF8_Org_Header(Result, Message,        *
//*                                           Error_Func);            *
//*********************************************************************

Procedure Init_Add_UTF8_Org_Header(Var Org_String   : String;
                                   Var Org_Folding  : Boolean;
                                   Var Real_Name    : String);
Begin
//{-------------------------------------------------------------------}
//{                 Anwenderspezifische Einstellungen                 }
//{-------------------------------------------------------------------}

// Wenn Du interessiert bist einen besonderen Header Organization
// zu setzen, frage für Einzelheiten in der Gruppe nach.

// Gib hier deinen Organization_String ein:

   Org_String := '=?UTF-8?B?8J+QuSDw...';
 
// Soll der Organization-Header gefaltet dargestellt werden?
// Setze auf 'True' um den Header zu falten oder auf 'False'.
// True wird hier ausdruecklich **NICHT** empfohlen!

   Org_Folding := false;
   
// Hier gibst du deinen realen Namen ein, welcher auch im UseNet
// erscheint. Falls du einmal mit einer anderen Identität (Pseudonym)
// unterwegs bist, dann fällst du nicht sofort auf! :-)
// Hier ist dein Nachname ausreichend.
// Aus "Thomas Barghahn" wird also "Thomas Barghahn" oder "Barghahn". 

// Real_Name := 'Dein RealerName'
   Real_Name := 'RealerName';

//{-------------------------------------------------------------------}
//{                       Ende der Einstellungen                      }
//{-------------------------------------------------------------------}
End;

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

//--[ START Function Add_UTF8_Org_Header ]-----------------------------

Function Add_UTF8_Org_Header(fbkResult  : Boolean;
                             Msg        : TStringList;
                             Error_Func : String) : Boolean;

Var i, k, WrapAt   : Integer;
    Org_String     : String;
    Org_Header     : String;
    Org_Folding    : Boolean;
    Real_Name      : String;
    Spacer         : String;

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_UTF8_Organization_Header *** wurde nicht mehr ausgefuehrt' ,4);
      WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4);
      WriteToLog ('==== ENDE =========================================' ,4);     
      Exit;
   end;   

   Try
   Init_Add_UTF8_Org_Header(Org_String, Org_Folding, Real_Name);
   // Ein "Pseudonym" darf nicht auffallen!
   If Pos (Real_Name, Getheader ('From:', Msg)) > 0 then begin
      If Org_String <> '' then begin
         If GetHeaderLine ('Organization:',Msg) > 0 then begin
            k := GetHeaderLine ('Organization:', Msg);
            Msg := RemoveHeader ('Organization:', Msg );
         end   
         Else   
            k := Msg.IndexOf ('');
         Org_Header := 'Organization: ' + Org_String;
         Msg.insert (k, Org_Header);
      end
      Else 
      Exit; // Procedure
      If Org_Folding = True Then begin
         WrapAt := 71;
         Spacer := #13#10 + '      ';
         For i := 0 To Msg.IndexOf('') - 1 Do begin
            If AnsiPos('Organization:', Msg[i]) = 1 Then begin
               While WrapAt < Length(Org_Header) + 1 Do begin
                  Insert(Spacer, Org_Header, WrapAt);
                  WrapAt := WrapAt + 72
               End; // While
               Msg[i] := Org_Header;
               Exit; // Procedure
            End; // If
         End; // For
      End; // If Org_Folding   
   End; // If Real_Name
   Except
      // Bei Problemen das Senden der Nachricht unterbinden
      begin
         WriteToLog ('FEHLER im Script *** Add_UTF8_Organization_Header ***' ,5);
         Error_Func := '*** Add_UTF8_Organization_Header ***';    
         Result := false;
      end; // Except  
   end; // Try ... Except
End; // Function

//--[ ENDE Function Add_UTF8_Org_Header ]------------------------------