//*********************************************************************
//*                CESU8_to_UTF8_Converter 2020-07-29                 *
//*                   >> OnBeforeSendingMessage <<                    *
//*                                                                   *
//* Dieses Script wandelt CESU8 in UTF8 und verschickt das Posting in *
//* UTF8! DIALOG selbst beherrscht UTF8 nur bis U+FFFF! Danach        *
//* produziert dieses Programm nur noch "komische Zeichen" (CESU-8),  *
//* welche bzw. welches nur DIALOG entschlüsseln kann!                *
//*                                                                   *
//*       !! DIESES SCRIPT BEHEBT DIESEN GRAVIERENDEN FEHLER !!       *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum     : 29.07.2020  (Corona-Zeit)                             *
//* Autor     : Thomas Barghahn                                       *
//*                                                                   *
//* DateiName : _i_OBSendM_CESU8_to_UTF8_Converter.ds                 *
//* Einbindung: {$I _i_OBSendM_CESU8_to_UTF8_Converter.ds}            *
//* Aufruf    :                                                       *
//*   Result := Convert_CESU8_to_UTF8 (Result, Message, Error_Func);  *
//*********************************************************************

//{-------------------------------------------------------------------}
//{          KONFIGURATIONSBEISPIEL (OnBeforSendingMessage)           }
//{-------------------------------------------------------------------}

// Dieses Beispiel zeigt eine Minimalkonfiguration für den
// "CESU-8 to UTF-8 Converter.
//
// Dieses Script benötigt die Include_Files:
// Dialog_Functions.ds, _i_OBSendM_UTF7_To_UTF8_Functions.ds
// Letzteres ist Bestandzeil des "UTF7 to UTF8 Converters"!

// Aenderungen in der Konfiguration von Dialog muessen nicht
// vorgenommen werden, *wenn* folgende Situation gegeben ist:
// Einstellungen --> Allgemeine Eistellungen --> Zeichensaetze -->
// Geeignetesten Zeichensatz waehlen aus:
// ----------------
// | usascii       | 
// | iso-8859-1    | 
// | iso-8859-15   | 
// | UTF8          | <-- UTF8 KANN AUCH UNTER usascii platziert sein,
// | ...           |     dann wird auch bei Umlauten in UTF8 gesendet!
// | UTF7          | <-- UTF7 muss hier am Schluss stehen!!
// ----------------

// BEISPIEL:

// --- SNIP ----------------------------------------------------------

// program OnBeforeSendingMessage;

// uses TextFile;

//  {$I Dialog_Functions.ds}
//  {$I _i_OBSendM_UTF7_To_UTF8_Functions.ds}
//  {$I _i_OBSendM_CESU8_to_UTF8_Converter.ds}

// Function OnBeforeSendingMessage( var      Message : TStringlist; 
//                                  const Servername : string; 
//                                  const    IsEmail : boolean) 
// : boolean;
//               
// var Error_Func : String;
//
// begin
//
//    Result := True;
//    Error_Func := '';
//   
//    Result := Convert_CESU8_to_UTF8 (Result, Message, Error_Func);
// end; // Function

// --- SNIP ----------------------------------------------------------

//{-------------------------------------------------------------------}
//{                 Anwenderspezifische Einstellungen                 }
//{-------------------------------------------------------------------}

// KEINE! :-)

//{-------------------------------------------------------------------}
//{                       Ende der Einstellungen                      }
//{-------------------------------------------------------------------}

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


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

var Intz         : Integer;  // allgemeiner Zeilen_Zaehler
    Ints         : Integer;  // allgemeiner Spalten_Zaehler
    Inti         : Integer;  // allgemeiner Zaehler
    Str_Cesu     : String;   // CESU-8 String
    Str_Bin_UTF8 : String;   // binaerer UTF-8 String
    Str_Hex_Temp : String;   // temporaerer Hex String
    Str_Replace  : String;   // tauscht CESU-8 gegen UTF-8
    
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 *** CESU8_to_UTF8_Converter *** wurde nicht mehr ausgefuehrt' ,4);
      WriteToLog ('Script ' + Error_Func + ' hat diesen Fehler verursacht!' ,4);
      WriteToLog ('==== ENDE =========================================' ,4);     
      Exit;
   end;   

   Intz := Msg.IndexOf('') + 1;
   Ints := 1;
   Try
      while Intz < Msg.Count do begin
      	  while Ints < length (Msg.Strings[Intz]) do begin
      	   	 If ord(Msg.Strings[Intz][Ints]) = 237 then begin
      	  	    If (ord(Msg.Strings[Intz][Ints + 1]) >= 160) and 
      	  	       (ord(Msg.Strings[Intz][Ints + 1]) <= 191) then begin
      	  	 	   	 Str_Cesu := Math_DecToBin (ord(Msg.Strings[Intz][Ints]), 8) +                          
                               Math_DecToBin (ord(Msg.Strings[Intz][Ints + 1]), 8) +                           
      	  	 	   	             Math_DecToBin (ord(Msg.Strings[Intz][Ints + 2]), 8) +                          
      	  	 	   	             Math_DecToBin (ord(Msg.Strings[Intz][Ints + 3]), 8) +                           
      	  	 	   	             Math_DecToBin (ord(Msg.Strings[Intz][Ints + 4]), 8) +                           
      	  	 	   	             Math_DecToBin (ord(Msg.Strings[Intz][Ints + 5]), 8);                           
                   Str_Cesu := copy (Str_Cesu, 13,  4) + copy (Str_Cesu, 19,  6) +
                               copy (Str_Cesu, 37,  4) + copy (Str_Cesu, 43,  6);
                   Str_Cesu := Math_DecToBin (Math_BinaryToDec (Str_Cesu, 3) + 65536, 21);
                   Str_Bin_UTF8 := '11110' + copy(Str_Cesu, 1, 3) + '10' + copy(Str_Cesu, 4, 6) +
                                  '10' + copy(Str_Cesu, 10, 6) + '10' + copy(Str_Cesu, 16, 6);
                   Str_Hex_Temp := 'chr($' + Math_BinarytoHex(copy(Str_Bin_UTF8, 1, 4),2) +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 5, 4),2) + ')+chr($' +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 9, 4),2) +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 13, 4),2) + ')+chr($' +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 17, 4),2) +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 21, 4),2) + ')+chr($' +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 25, 4),2) +
                                             Math_BinarytoHex(copy(Str_Bin_UTF8, 29, 4),2) + ')+';
                   Str_Replace := GetUTF8_CharSet (Str_Hex_Temp, 3);                        
                   Msg.Strings[Intz] := StringReplace(Msg[Intz], copy(Msg[Intz], Ints, 6), Str_Replace, [rfIgnoreCase]);
     	  	 	   	   Ints := Ints + 3;
      	  	 	  end;
      	  	 end;
            Ints := Ints + 1;	     	                          
      	  end; // while
      	  Intz := Intz + 1;
      	  Ints := 1;
      end; // while
      Inti := GetHeaderLine ('Content-Type:',Msg);
      If (Inti > -1) and (Ansipos('utf-8',Getheader('Content-Type:', Msg)) > 0) then begin
         Msg := RemoveHeader ('Content-Type:', Msg );
         Msg.insert (Inti, 'Content-Type: text/plain; charset=' + '"' + 'utf-8' + '"; format=fixed');
      end; // If   
      If GetHeader ('User-Agent:', Msg) <> '' Then begin
         Inti := GetHeaderLine ('User-Agent:',Msg);
         Msg[Inti] := Msg[Inti] + ' CU_Conv/20.07.29';
      end; // If   
   Except
      // Bei Problemen das Senden der Nachricht unterbinden
      begin
         WriteToLog ('FEHLER im Script *** Convert_CESU8_to_UTF8 ***' ,5);
         Error_Func := '*** CESU8_UTF8_Converter ***';    
         Result := false;
      end; // Except
   Finally
      // FreeMem;
   end; // Try ... Except ... Finally
end; // function