Pascal-Script

//*********************************************************************
//*                UTF7_to_UTF8_Functions 2021-10-24                  *
//*                   >> OnBeforeSendingMessage <<                    *
//*                                                                   *
//*         DIESES SCRIPT ENTHAELT WESENTLICHE FUNKTIONEN DES         *
//*                      UTF7_to_UTF8_CONVERTERS                      *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum     : 06.08.2020  (Corona-Zeit)                             *
//* Stand     : 24.10.2021                                            *
//* Author    : Thomas Barghahn                                       *
//*                                                                   *
//* DateiName : _i_OBSendM_UTF7_to_UTF8_Functions.ds                  *
//* Einbindung: {$I _i_OBSendM_UTF7_to_UTF8_Functions.ds}             *
//* Aufruf    : nur die Einbindung als Include-File ist erforderlich! *
//*                                                                   *
//*********************************************************************

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


Function Power(Base, Exponent: Integer): LongInt;
    
var Temp_Result : LongInt;
    i : Integer;
    
begin
   if Exponent = 0 then
      Temp_Result := 1
   else if (Base = 0) AND (Exponent > 0) then
      Temp_Result := 0
   else if Exponent = 1 then
      Temp_Result := Base
   else if Exponent = 2 then
      Temp_Result := Base * Base
   else begin
      Temp_Result := Base;
      For i := 2 TO Exponent DO
         Temp_Result := Temp_Result * Base; 
   end; //if
   Result := Temp_Result;
end;

PROCEDURE Str (X : Extended; VAR S : String);
 
VAR DotPos : Integer;
 
BEGIN
   S := FloatToStr (X);
   DotPos := Pos ('.',S);
   IF DotPos > 0 THEN
      S := copy (S,1,DotPos - 1);
END;

Function Math_BinaryToDec(Str_Bin_In : String; Debug_Reports : Byte) : LongInt;

// IN  : 101001
// OUT : 41

var Inti : LongInt;
var Inthelp : LongInt;
var Len_Str_Bin_In : LongInt;

begin
   Result := 0;
   Len_Str_Bin_In := length(Str_Bin_In);
   Inti := 0;
   For IntHelp := Len_Str_Bin_In downto 1 do begin
      Result := Result + StrToInt(Str_Bin_In[Inthelp]) * Power(2,Inti);
      Inti := Inti + 1;
   end; // For
End; // Function

function Math_Bin_To_UTF7 (Bin_In : String; Debug_Reports : Byte) : String;

// IN  : 000000001110010000
// OUT : +AOQ- = Umlaut "a"									

var Inti     : Integer;
    Bin_Temp : string;
    Dec_Temp : LongInt;
begin
   Dec_Temp := 0;
   Bin_Temp := '';
   Inti := 1;
   Result := '';
   If length (Bin_In) > 0 then begin
      while Inti < length (Bin_In) do begin
         Bin_Temp := copy (Bin_In, Inti, 6);
         Dec_Temp := Math_BinaryToDec (Bin_Temp, Debug_Reports);
         // WriteToLog ('Dec_Temp : ' + IntToStr(Dec_Temp), Debug_Reports);
         If Dec_Temp <= 25 then
            Result := Result + chr(Dec_Temp + 65);
         If (Dec_Temp >= 26) and (Dec_Temp <= 51) then
            Result := Result + chr(Dec_Temp + 71);
         If (Dec_Temp >= 52) and (Dec_Temp <= 61) then
            Result := Result + chr(Dec_Temp - 4);
         If Dec_Temp = 63 then
            Result := Result + chr(Dec_Temp - 16);
         Inti := Inti + 6;
         // WriteToLog ('Result : ' + Result, Debug_Reports);
      end; // while
   end; // If   
   Result := '+' + Result + '-';   
end;

function UTF8_Code_to_dec (Str_In : String) : LongInt;

// IN  : E281B4
// OUT : 8308   = "4" hochgestellt 

var Str_In_Length : Integer;
var Intk : Integer;
var Inti : Integer;
var Str_Bin : String;

begin
   Str_In_Length := length (Str_In);
   Str_Bin := '';
   Result := 0;
   For Intk := 1 To Str_In_Length do begin
      Case copy (Str_In, Intk, 1) of
         '0' : Str_Bin := Str_Bin + '0000';
         '1' : Str_Bin := Str_Bin + '0001';
         '2' : Str_Bin := Str_Bin + '0010';
         '3' : Str_Bin := Str_Bin + '0011';
         '4' : Str_Bin := Str_Bin + '0100';
         '5' : Str_Bin := Str_Bin + '0101';
         '6' : Str_Bin := Str_Bin + '0110';
         '7' : Str_Bin := Str_Bin + '0111';   
         '8' : Str_Bin := Str_Bin + '1000';
         '9' : Str_Bin := Str_Bin + '1001';
         'A' : Str_Bin := Str_Bin + '1010';
         'B' : Str_Bin := Str_Bin + '1011';
         'C' : Str_Bin := Str_Bin + '1100';
         'D' : Str_Bin := Str_Bin + '1101';
         'E' : Str_Bin := Str_Bin + '1110';
         'F' : Str_Bin := Str_Bin + '1111';
      End; // of case
   end; // For;   
   Case Str_In_Length of 
      2 : begin
      	     Inti := 7;
      	     For Intk := 1 to 8 do begin
      	     	  If copy (Str_Bin, Intk, 1) = '1' then begin
      	           Result := Result + Power (2, Inti);
      	        end;   
      	        Inti := Inti - 1;
      	     end;
      	  end;
      4 : begin
             Str_Bin := copy (Str_Bin, 4, 5) + copy (Str_Bin, 11, 6);
      	     Inti := 10;
      	     For Intk := 1 to 11 do begin
      	     	  If copy (Str_Bin, Intk, 1) = '1' then begin
      	           Result := Result + Power (2, Inti);
      	        end;   
      	        Inti := Inti - 1;
      	     end;      	
      	  end;
      6 : begin
             Str_Bin := copy (Str_Bin,  5, 4) + copy (Str_Bin, 11, 6) + 
                        copy (Str_Bin, 19, 6);
      	     Inti := 15;
      	     For Intk := 1 to 16 do begin
      	     	  If copy (Str_Bin, Intk, 1) = '1' then begin
      	           Result := Result + Power (2, Inti);
      	        end;   
      	        Inti := Inti - 1;
      	     end;      	      	  
      	  end;
      8 : begin
             Str_Bin := copy (Str_Bin,  6, 3) + copy (Str_Bin, 11, 6) + 
                        copy (Str_Bin, 19, 6) + copy (Str_Bin, 27, 6);
      	     Inti := 20;
      	     For Intk := 1 to 21 do begin
      	     	  If copy (Str_Bin, Intk, 1) = '1' then begin
      	           Result := Result + Power (2, Inti);
      	        end;   
      	        Inti := Inti - 1;
      	     end;      	      	        	
      	  end;
   end; // of case   	  	  
end; // Function

FUNCTION Math_DecToBin(Digit : LongInt; ByteGroup : Byte) : String;

VAR
   DecDigit : Extended;
   TempStr : String;
   Temp : String;
   i : Integer; 

BEGIN
   TempStr := '';
   DecDigit := Digit;
   FOR i := (ByteGroup - 1) DOWNTO 0 DO BEGIN
      Str(Int(DecDigit / Power(2,i)),Temp);
      TempStr := TempStr + Temp;
      DecDigit := Int(DecDigit - (Int(DecDigit / Power(2,i)) * Power(2,i)));
   END;
   Result := TempStr;
END;


Function Math_BinarytoHex(BinaryToHex_Number : String; Output_length : Byte) : String;
// In: 
//   strNumber:
//       Binary number as a String
// Out:
//   Return Value:
//       The Hex number as a String
 
var StrTemp : String;
var StrHelp : String;
var Inti : Integer;
var IntLen : Integer;

begin
 
   // First, pad the value to the left, with "0".
   // To do this, find the length of the string
   // rounded to the next highest multiple of 4.
   IntLen := Length(BinaryToHex_Number);
   If IntLen = 0 then begin
      Exit; // Function
   end;   
   WriteToLog ('Math_BinarytoHex Eingang : ' + BinaryToHex_Number, 3);
   // Find the next higher multiple of 4:
   // äö = 0000 0000 1110 0100 0000 0000 1111 0110
   IntLen := Trunc((IntLen - 1) / 4 + 1) * 4;
   While Length(BinaryToHex_Number) < IntLen do begin
      BinaryToHex_Number := '0' + BinaryToHex_Number;
   end; // while
   Inti := 1;
   while Inti < IntLen do begin
      StrTemp := '';
      Case copy(BinaryToHex_Number, Inti, 4) of
         '0000' : StrTemp := '0';
         '0001' : StrTemp := '1';
         '0010' : StrTemp := '2';
         '0011' : StrTemp := '3';
         '0100' : StrTemp := '4';
         '0101' : StrTemp := '5';
         '0110' : StrTemp := '6';
         '0111' : StrTemp := '7';
         '1000' : StrTemp := '8';
         '1001' : StrTemp := '9';
         '1010' : StrTemp := 'A';
         '1011' : StrTemp := 'B';
         '1100' : StrTemp := 'C';
         '1101' : StrTemp := 'D';
         '1110' : StrTemp := 'E';
         '1111' : StrTemp := 'F';
      End; // case
      StrHelp := StrHelp + StrTemp;
         WriteToLog ('Math_BinarytoHex StrHelp in der Case-Schleife : ' + StrHelp, 3);
      Inti := Inti + 4;
   end; // while        
   WriteToLog ('Math_BinarytoHex Ausgang : ' + StrHelp, 3);
   Result := StrHelp;
End; // Function

Function Math_DecToUTF8 (LngDigit : LongInt) : String;

var Str_Temp : String;

begin
   If LngDigit > 65535 Then begin
      Str_Temp := Math_DecToBin (LngDigit, 21);
      // Ist die Laenge von Str_Temp < 21 Zeichen?
      While Length(Str_Temp) < 21 do begin
         Str_Temp := '0' + Str_Temp;
      end; // while
      // Ist die Laenge von Str_Temp > 21 Zeichen?
      If length(Str_Temp) > 21 then 
         Str_Temp := copy(Str_Temp, length(Str_Temp) - 21 + 1, 21);
      Str_Temp := '11110' + copy(Str_Temp,  1, 3) + '10' + copy(Str_Temp,  4, 6) +
                     '10' + copy(Str_Temp, 10, 6) + '10' + copy(Str_Temp, 16, 6);
      Str_Temp := '=' + Math_BinarytoHex(copy(Str_Temp,  1, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp,  5, 4), 1) + '=' +
                        Math_BinarytoHex(copy(Str_Temp,  9, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 13, 4), 1) + '=' +
                        Math_BinarytoHex(copy(Str_Temp, 17, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 21, 4), 1) + '=' +
                        Math_BinarytoHex(copy(Str_Temp, 25, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 29, 4), 1);
   end; // If                     
   If (LngDigit >= 2048) and (LngDigit <= 65535) Then begin
      Str_Temp := Math_DecToBin (LngDigit, 16);
      // Ist die Laenge von Str_Temp < 16 Zeichen?
      While Length(Str_Temp) < 16 do begin
         Str_Temp := '0' + Str_Temp;
      end; // while
      // Ist die Laenge von Str_Temp > 16 Zeichen?
      If length(Str_Temp) > 16 then 
         Str_Temp := copy(Str_Temp, length(Str_Temp) - 16 + 1, 16);
      Str_Temp := '1110' + copy(Str_Temp,  1, 4) + '10' + copy(Str_Temp, 5, 6) +
                    '10' + copy(Str_Temp, 11, 6);
      Str_Temp := '=' + Math_BinarytoHex(copy(Str_Temp,  1, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp,  5, 4), 1) + '=' +
                        Math_BinarytoHex(copy(Str_Temp,  9, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 13, 4), 1) + '=' +
                        Math_BinarytoHex(copy(Str_Temp, 17, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 21, 4), 1);
   end; // If
   If (LngDigit >= 128) and (LngDigit <= 2047) Then begin
      Str_Temp := Math_DecToBin (LngDigit, 11);
      // Ist die Laenge von Str_Temp < 11 Zeichen?
      While Length(Str_Temp) < 11 do begin
         Str_Temp := '0' + Str_Temp;
      end; // while
      // Ist die Laenge von Str_Temp > 11 Zeichen?
      If length(Str_Temp) > 11 then 
         Str_Temp := copy(Str_Temp, length(Str_Temp) - 11 + 1, 11);
      Str_Temp := '110' + copy(Str_Temp, 1, 5) + '10' + copy(Str_Temp, 6, 6);
      Str_Temp := '=' + Math_BinarytoHex(copy(Str_Temp,  1, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp,  5, 4), 1) + '=' +
                        Math_BinarytoHex(copy(Str_Temp,  9, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 13, 4), 1);
   end; // If
   If (LngDigit >= 0) and (LngDigit <= 127) Then begin
      Str_Temp := Math_DecToBin (LngDigit, 7);
      // Ist die Laenge von Str_Temp < 7 Zeichen?
      While Length(Str_Temp) < 7 do begin
         Str_Temp := '0' + Str_Temp;
      end; // while
      // Ist die Laenge von Str_Temp > 7 Zeichen?
      If length(Str_Temp) > 7 then 
         Str_Temp := copy(Str_Temp, length(Str_Temp) - 7 + 1, 7);
      Str_Temp := '0' + copy(Str_Temp, 1, 7);
      Str_Temp := '=' + Math_BinarytoHex(copy(Str_Temp, 1, 4), 1) +
                        Math_BinarytoHex(copy(Str_Temp, 5, 4), 1);
   end; // If                      

   Result := Str_Temp;

end; // Function

function Math_HexToDec(Str_Hex : string): LongInt;
var
  i, M: Integer;
begin
  Result := 0;
  M := 1;
  Str_Hex := AnsiUpperCase(Str_Hex);
  for i := Length(Str_Hex) downto 1 do
  begin
    case Str_Hex[i] of
      '1', '2', '3', '4', '5', '6', '7', '8', '9' : Result := Result + (Ord(Str_Hex[i]) - Ord('0')) * M;
                     'A', 'B', 'C', 'D', 'E', 'F' : Result := Result + (Ord(Str_Hex[i]) - Ord('A') + 10) * M;
    end;
    M := M shl 4;
  end;
end;

Function Clean_UTF8_CharSet (Str_HexSet : String; Debug_Reports : Byte) : String;

// Beispiel:
// chr($E2)+chr($82)+chr($AC) ==> =E2=82=AC

var Intj : Integer;
var IntLenHexStr : Integer;
var Str_Clean_CharSet_Temp : String;

begin
   Str_Clean_CharSet_Temp := '';
   Intj := 6;
   IntLenHexStr := length (Str_HexSet);
   While Intj <= (IntLenHexStr - 2) do Begin
      Str_Clean_CharSet_Temp :=  Str_Clean_CharSet_Temp + '=' + copy(Str_HexSet, Intj, 2);    
      Intj := Intj + 9;
   end; // while
   Result := Str_Clean_CharSet_Temp;
   WriteToLog ( '** Funtion Clean_GetUTF8_CharSet Result ** : ' + Result, Debug_Reports);
end; // Function   


Function GetUTF8_CharSet (Str_HexStr : String; Debug_Reports : Byte) : String;

// Beispiel:
// UTF8_CharSet :=  chr(Math_HextoDec(copy(Str_UTF8, 6, 2))) + 
//                  chr(Math_HextoDec(copy(Str_UTF8, 15, 2))) +
//                  chr(Math_HextoDec(copy(Str_UTF8, 24, 2))) + 
//                  chr(Math_HextoDec(copy(Str_UTF8, 33, 2)));

var Intj : Integer;
var IntLenHexStr : Integer;
var Str_CharSet_Temp : String;

begin
   Str_CharSet_Temp := '';
   Intj := 6;
   IntLenHexStr := length (Str_HexStr);
   While Intj <= (IntLenHexStr - 2) do Begin
      Str_CharSet_Temp :=  Str_CharSet_Temp + chr(Math_HextoDec(copy(Str_HexStr, Intj, 2)));    
      Intj := Intj + 9;
   end; // while
   Result := Str_CharSet_Temp;
   WriteToLog ( '** Funtion GetUTF8_CharSet Result ** : ' + Result, Debug_Reports);
end; // Function   


Function dhBinarytoHex(BinaryToHex_Number : String; Debug_Reports : Byte) : String;
// In: 
//   BinaryToHex_Number:
//       Binary number as a String
// Out:
//   Return Value:
//       The Hex number as a String
 
var StrTemp : String;
var StrHelp : String;
var Inti : Integer;
var IntLen : Integer;
var StrOut : String;

begin
 
    // First, pad the value to the left, with "0".
    // To do this, find the length of the string
    // rounded to the next highest multiple of 4.
    IntLen := Length(BinaryToHex_Number);
    WriteToLog ('***BinaryToHex*** IntLen OBEN : ' + IntToStr(IntLen), Debug_Reports);
    If IntLen = 0 then begin
       Exit;
    end;   
    // Find the next higher multiple of 4:
    IntLen := Trunc((IntLen - 1) / 4 + 1) * 4;
    WriteToLog ('***BinaryToHex*** IntLen UNTEN : ' + IntToStr(IntLen), Debug_Reports);
    WriteToLog ('***BinaryToHex*** BinaryToHex_Number zuvor : ' + BinaryToHex_Number, Debug_Reports);
   //    strNumber := Right$(String(IntLen, '0') + strNumber, IntLen);
    While Length(BinaryToHex_Number) < IntLen do begin
       BinaryToHex_Number := '0' + BinaryToHex_Number;
    end; // while
    WriteToLog ('***BinaryToHex*** BinaryToHex_Number danach : ' + BinaryToHex_Number, Debug_Reports);
    For Inti := 1 To IntLen do begin
        StrTemp := '';
        Case copy(BinaryToHex_Number, Inti, 4) of
           '0000' : StrTemp := '0';
           '0001' : StrTemp := '1';
           '0010' : StrTemp := '2';
           '0011' : StrTemp := '3';
           '0100' : StrTemp := '4';
           '0101' : StrTemp := '5';
           '0110' : StrTemp := '6';
           '0111' : StrTemp := '7';
           '1000' : StrTemp := '8';
           '1001' : StrTemp := '9';
           '1010' : StrTemp := 'A';
           '1011' : StrTemp := 'B';
           '1100' : StrTemp := 'C';
           '1101' : StrTemp := 'D';
           '1110' : StrTemp := 'E';
           '1111' : StrTemp := 'F';
        End; // case
        StrHelp := StrHelp + StrTemp;
        WriteToLog ('dhBinarytoHex Strhelp : ' + StrHelp, Debug_Reports);
    End; // For
    StrOut := StrHelp;
    WriteToLog ('dhBinarytoHex strOut : ' + StrOut, Debug_Reports);
    Result := StrOut;
End; // Function

Function dhHexToBinary (HexToBinaryNumber : String; var HexToBinaryNumber_Out : String; Cut : Boolean; Debug_Reports : Byte) : String;
 
var dbli : Double;
var Inti : Integer;

begin
   WriteToLog ('** Function HexToBinary ** Eingang HexToBinaryNumber : ' + HexToBinaryNumber, Debug_Reports);
   WriteToLog ('** Function HexToBinary ** Laenge HexToBinaryNumber : ' + IntToStr(length(HexToBinaryNumber)), Debug_Reports);
   HexToBinaryNumber_Out := '';
   dbli := 1;    
   For Inti := Trunc(dbli) To Length(HexToBinaryNumber) do
   begin
      Case copy (HexToBinaryNumber, Inti, 1) of
         '0' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0000';
         '1' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0001';
         '2' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0010';
         '3' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0011';
         '4' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0100';
         '5' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0101';
         '6' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0110';
         '7' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '0111';   
         '8' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1000';
         '9' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1001';
         'A' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1010';
         'B' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1011';
         'C' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1100';
         'D' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1101';
         'E' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1110';
         'F' : HexToBinaryNumber_Out := HexToBinaryNumber_Out + '1111';
      End; // of case
   WriteToLog ('** Function HexToBinary ** Inti und HexToBinaryNumber_Out in der For-Schleife: ' + IntToStr(Inti) + ' ' + HexToBinaryNumber_Out, Debug_Reports);
   End; //For

   If Cut = True Then begin
      If length (HexToBinaryNumber_Out) > 6 Then begin
         HexToBinaryNumber_Out := copy (HexToBinaryNumber_Out, 3, 6);
         WriteToLog ('** Function HexToBinary ** !! ***ES WURDE ABGESCHNITTEN*** !! Ausgang HexToBinary_Number : ' + HexToBinaryNumber_Out, Debug_Reports);
      end; //if
   end; // if     

   WriteToLog ('** Function HexToBinary ** Ausgang HexToBinaryNumber_Out : ' + HexToBinaryNumber_Out, Debug_Reports);
   Result := HexToBinaryNumber_Out;
End; // Function


Function dhDecToBinary (Int64Number : Int64;  var DecToBinary_Out : String; Cut : Boolean; Debug_Reports : Byte) : String;

begin 
   DecToBinary_Out := '';
   WriteToLog ('** Function DecToBinary ** : IntToStr (Int64Number): ' + IntToStr(Int64Number), Debug_Reports);
   DecToBinary_Out := Int64ToHex(Int64Number, 0);
   WriteToLog ('** Function DecToBinary ** : DecToBinary_Out vor ** Function HexToBinary **: ' + DecToBinary_Out, Debug_Reports);
   DecToBinary_Out := dhHexToBinary(DecToBinary_Out, DecToBinary_Out, Cut, Debug_Reports);
   WriteToLog ('** Function DecToBinary ** : DecToBinary_Out nach ** Function HexToBinary **: ' + DecToBinary_Out, Debug_Reports);
//     Rip off leading '0's.
   WriteToLog ('** Function DecToBinary ** : DecToBinary_Out *vor* der While-Schleife: ' + DecToBinary_Out, Debug_Reports);
   // While Pos ('0', DecToBinary_Out) = 1 do  begin
   //    DecToBinary_Out := copy(DecToBinary_Out, 2, 1);
   // end; // while
   WriteToLog ('** Function DecToBinary ** : DecToBinary_Out *nach* der While-Schleife: ' + DecToBinary_Out, Debug_Reports);
   WriteToLog ('** Function DezToBinary ** : Result und DecToBinary_Out am Ende: ' + Result + ' ' + DecToBinary_Out, Debug_Reports);
   Result := DecToBinary_Out;
End; // Function


Function MyConvertBinGroupToHexGroup(MyString : String; var StrOut_BinGrToHexGr : String; Debug_Reports : Byte) : String;

var Intk : Integer;
var IntLen : Integer;
// var StrOut : String;
var StrTemp : String;

begin
   WriteToLog ('MyConvertBinGroupToHexGroup ANFANG Ich bin GANZ OBEN!', Debug_Reports);
   IntLen := Length(MyString);
   WriteToLog ('MyConvertBinGroupToHexGroup: ' + MyString, Debug_Reports);
   WriteToLog ('MyConvertBinGroupToHexGroup: ' + IntToStr(IntLen), Debug_Reports);
   WriteToLog ('MyConvertBinGroupToHexGroup: ' + StrTemp, Debug_Reports);
   If IntLen = 0 then Exit;
   For Intk := 1 To IntLen do begin
      StrTemp := dhBinarytoHex(copy(MyString, Intk, 4), Debug_Reports);
      StrOut_BinGrToHexGr := StrOut_BinGrToHexGr + StrTemp;
      // WriteToLog ('MyConvertBinToHexGroup StrOut: ' + StrOut, Debug_Reports);
      Intk := Intk + 3;
   end; // For
      WriteToLog ('MyConvertBinToHexGroup ENDE StrOut: ' + StrOut_BinGrToHexGr, Debug_Reports);
      WriteToLog ('==================================: ', Debug_Reports);
   Result := StrOut_BinGrToHexGr;
End; // Function

Function MyAscToBin(MyString : String; var My_StrOut : String; Debug_Reports : Byte) : String;

var Intk : Integer;
var dblk : Double;
var IntLen : Integer;
var My_StrTemp : String;
var My_IntAscWert : LongInt;
var My_dbl16Bit_Groups : Double;
var StrTemp16 : String;
var StrTemp32 : String;
var Int64Value : Int64;
var StrBinTemp : String;
var StrReplace : String;


begin
	 If MyString[Length (MyString)] = '-' then
      MyString := copy (MyString, 2, Length (MyString) - 2) // "+" und "-" abschneiden
   else
      MyString := copy (MyString, 2, Length (MyString) - 1); // "+" abscheiden   
   IntLen := Length(MyString);
   WriteToLog ('Ich bin ganz oben: ' + MyString, Debug_Reports);
   My_StrOut := '';

   For Intk := 1 To IntLen do begin
      My_IntAscWert := ord (MyString[Intk]);
      WriteToLog ('** Function MyAscToBin ** MyString[Intk]: ' + MyString[Intk], Debug_Reports);
      WriteToLog ('** Function MyAscToBin ** My_IntAscWert: ' + IntToStr(My_IntAscWert), Debug_Reports);
      If (My_IntAscWert >= 66) and (My_IntAscWert <= 90) Then begin
         My_StrTemp := dhDecToBinary(My_IntAscWert - 65, My_StrTemp, True, Debug_Reports);
         WriteToLog ('** Function MyAscToBin ** 66..90 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 66 ... 90
      If (My_IntAscWert >= 97) and (My_IntAscWert <= 122) Then begin
         My_StrTemp := dhDecToBinary(My_IntAscWert - 71, My_StrTemp, True, Debug_Reports);
         WriteToLog ('** Function MyAscToBin ** 97..122 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 97 ... 122
      If (My_IntAscWert >= 48) and (My_IntAscWert <= 57) Then begin
         My_StrTemp := dhDecToBinary(My_IntAscWert + 4, My_StrTemp, True, Debug_Reports);
         WriteToLog ('** Function MyAscToBin ** 48..57 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 48 ... 57
      If (My_IntAscWert = 65) Then begin
         My_StrTemp := '000000';
         WriteToLog ('** Function MyAscToBin ** 65 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 65
      If (My_IntAscWert = 43) Then begin
         My_StrTemp := dhDecToBinary(My_IntAscWert + 19, My_StrTemp, True, Debug_Reports);
         WriteToLog ('** Function MyAscToBin ** 43 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 43
      If (My_IntAscWert = 45) Then begin
         My_StrTemp := dhDecToBinary(My_IntAscWert + 10, My_StrTemp, True, Debug_Reports);
         WriteToLog ('** Function MyAscToBin ** 45 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 45
      If (My_IntAscWert = 47) Then begin
         My_StrTemp := dhDecToBinary(My_IntAscWert + 16, My_StrTemp, True, Debug_Reports);
         WriteToLog ('** Function MyAscToBin ** 45 und My_StrTemp: ' + My_StrTemp, Debug_Reports);
      end; // If 47
      WriteToLog ('** Function MyAscToBin ** vor Abfrage "My_StrTemp) < 6": ' + My_StrTemp, Debug_Reports);
      If Length (My_StrTemp) < 6 Then begin
         If Length (My_StrTemp) = 1 Then My_StrTemp := '00000' + My_StrTemp;
         If Length (My_StrTemp) = 2 Then My_StrTemp := '0000' + My_StrTemp;
         If Length (My_StrTemp) = 3 Then My_StrTemp := '000' + My_StrTemp;
         If Length (My_StrTemp) = 4 Then My_StrTemp := '00' + My_StrTemp;
         If Length (My_StrTemp) = 5 Then My_StrTemp := '0' + My_StrTemp;
      End; // If
      WriteToLog ('** Function MyAscToBin ** nach Abfrage "My_StrTemp) < 6": ' + My_StrTemp, Debug_Reports);
      My_StrOut := My_StrOut + My_StrTemp;
      WriteToLog ('** Function MyAscToBin ** In der Schleife, My_StrOut: ' + IntToStr(Intk) + ' ' + My_StrOut, Debug_Reports);
   end; // For
   WriteToLog ('** Function MyAscToBin ** My_StrOut nach der For-Schleife: ' + My_StrOut, Debug_Reports);
   My_dbl16Bit_Groups := Int(Length(My_StrOut) / 16);
   If My_dbl16Bit_Groups > 0 Then begin
      dblk := Int (My_dbl16Bit_Groups  * 16);
      WriteToLog ('** Function MyAscToBin ** dbl16Bit_Groups und dblk vor dem Abschneiden: ' + FloatToStr(My_dbl16Bit_Groups) + ' ' + FloatToStr(dblk), Debug_Reports);
      // Ueberfluessige Bits abschneiden 
      My_StrOut := copy (My_StrOut, 1, trunc( My_dbl16Bit_Groups) * 16);
      WriteToLog ('** Function MyAscToBin ** My_StrOut nach dem Abschneiden: ' + My_StrOut + ' ', Debug_Reports);
   End; // If
   
   If copy (My_StrOut, 1, 6) = '110110' Then begin
      WriteToLog ('** Function MyAscToBin ** Es wurde der String 110110 gefunden: ' + My_StrOut, Debug_Reports);

      Int64Value := 65536 + Math_BinaryToDec(copy(My_StrOut, 7, 10) + copy(My_StrOut, 23, 10), Debug_Reports);
      StrBinTemp := dhDecToBinary(Int64Value, StrBinTemp, False, Debug_Reports);
      WriteToLog (' ========================= ', Debug_Reports);
      WriteToLog ('****** Int64Value ****** : ' + IntToStr(Int64Value), Debug_Reports);
      WriteToLog ('*** StrBinTemp BINÄR *** : ' + StrBinTemp, Debug_Reports);
      While Length (StrBinTemp) < 20 do begin
         StrBinTemp := '0' + StrBinTemp;
      end; // while

      // My_StrOut  : 1101 1000 0101 0011 1101 1111 0101 1100
      // StrBinTemp :        00 1001 0011        11 0101 1100
      //                        ^^ das sind die entscheidenden Bits!

      WriteToLog ('*StrBinTemp aufgefuellt* : ' + StrBinTemp, Debug_Reports);
      StrReplace := copy(StrBinTemp, 3, 2);
      WriteToLog (' **** StrOut zuvor ****  : ' + My_StrOut, Debug_Reports);
      My_StrOut := copy(My_StrOut, 1, 8) + StrReplace + copy(My_StrOut, 11, Length(My_StrOut) - 10);
      WriteToLog (' ***** StrReplace *****  :         ' + StrReplace, Debug_Reports);
      WriteToLog (' **** StrOut jetzt ****  : ' + My_StrOut, Debug_Reports);
      WriteToLog (' ========================= ', Debug_Reports);

      StrTemp16 := copy(My_StrOut, 1, 16);
      StrTemp32 := copy(My_StrOut, 17, Length(My_StrOut) - 16);

             WriteToLog ('** Function MyAscToBin ** My_StrOut vor dem Ausschneiden von 110110     : ' + My_StrOut, Debug_Reports);
      // WriteToLog ('** Function MyAscToBin ** My_StrOut vor dem Ausschneiden von 110110 SOLL: 11011000011101001101110100011110', Debug_Reports);
      StrTemp16 := StringReplace (StrTemp16, '110110', '', [rfIgnoreCase]);
      // WriteToLog ('** Function MyAscToBin ** My_StrOut nach dem Ausschneiden von 110110: ' + My_StrOut, Debug_Reports);
      // WriteToLog ('** Function MyAscToBin ** My_StrOut nach dem Ausschneiden von 110110 SOLL: 00011101001101110100011110', Debug_Reports);
      StrTemp32 := StringReplace (StrTemp32, '110111', '', [rfIgnoreCase]);
      // WriteToLog ('** Function MyAscToBin ** My_StrOut nach dem Ausschneiden von 110111 SOLL: 00011101000100011110', Debug_Reports);
      My_StrOut := StrTemp16 + StrTemp32;

   End; // If
   WriteToLog ('** Function MyAscToBin ** IST ! ' + My_StrOut, Debug_Reports);
   Result := MyString;
End; // Function

Function My_UTF16BE_ToBin(MyString : String; var StrOut_Bin : String; Debug_Reports : Byte) : String;

var Intk : Integer;
var IntLen : Integer;
// var StrOut : String;
var StrTemp : String;
var StrTemp16 : String;
var StrTemp32 : String;
var Int64Value : Int64;
var StrBinTemp : String;
var StrReplace : String;

begin

   WriteToLog ('My_UTF16BE_ToBin : Ich bin GANZ OBEN ****************', Debug_Reports);
   StrOut_Bin := '';
   If copy(MyString, 1, 1) = '+' Then begin
      MyString := copy(MyString, 2, Length(MyString) - 2);
   end; // If
   IntLen := Length(MyString);
   WriteToLog ('My_UTF16BE_ToBin MySring: ' + MyString, Debug_Reports);

   For Intk := 1 To IntLen do begin
       StrTemp := copy(MyString, Intk, 1);
       StrTemp := dhHexToBinary(StrTemp, StrTemp, True, Debug_Reports);
       WriteToLog ('My_UTF16BE_ToBin StrTemp: ' + StrTemp, Debug_Reports);
       If Length(StrTemp) < 4 Then begin
          Case Length(StrTemp) of
             1 : StrTemp := '000' + StrTemp;
             2 : StrTemp := '00' + StrTemp;
             3 : StrTemp := '0' + StrTemp;
          End; // case
       end; // If
       StrOut_Bin := StrOut_Bin + StrTemp;
       WriteToLog ('My_UTF16BE_ToBin StrOut : ' + StrOut_Bin, Debug_Reports);
   end; // For
   If copy(StrOut_Bin, 1, 6) = '110110' Then begin

      Int64Value := 65536 + Math_BinaryToDec(copy(StrOut_Bin, 7, 10) + copy(StrOut_Bin, 23, 10), Debug_Reports);
      StrBinTemp := dhDecToBinary(Int64Value, StrBinTemp, False, Debug_Reports);
      WriteToLog (' ========================= ', Debug_Reports);
      WriteToLog ('****** Int64Value ******      : ' + IntToStr(Int64Value), Debug_Reports);
      WriteToLog ('*** StrBinTemp BINÄR ***      : ' + StrBinTemp, Debug_Reports);

      While Length (StrBinTemp) < 20 do begin
         StrBinTemp := '0' + StrBinTemp;
      end; // while

      // StrOut_Bin  : 1101 1000 0101 0011 1101 1111 0101 1100
      // StrBinTemp   :        00 1001 0011        11 0101 1100
      //                          ^^ das sind die entscheidenden Bits!

      WriteToLog ('*StrBinTemp aufgefuellt*      : ' + StrBinTemp, Debug_Reports);
      StrReplace := copy(StrBinTemp, 3, 2);
      WriteToLog (' **** StrOut zuvor ****       : ' + StrOut_Bin, Debug_Reports);
      StrOut_Bin := copy(StrOut_Bin, 1, 8) + StrReplace + copy(StrOut_Bin, 11, Length(StrOut_Bin) - 10);
      WriteToLog (' ***** StrReplace *****       :         ' + StrReplace, Debug_Reports);
      WriteToLog (' **** StrOut_Bin jetzt ****   : ' + StrOut_Bin, Debug_Reports);
      WriteToLog (' ========================= ', Debug_Reports);
      

      StrTemp16 := copy(StrOut_Bin, 1, 16);
      StrTemp32 := copy(StrOut_Bin, 17, 16);
   
      WriteToLog ('My_UTF16BE_ToBin StrTemp16 vor  dem Ausschneiden von 110110: ' + StrTemp16, Debug_Reports);
      StrTemp16 := StringReplace(StrTemp16, '110110', '', [rfIgnoreCase]);
      WriteToLog ('My_UTF16BE_ToBin StrTemp16 nach dem Ausschneiden von 110110: ' + StrTemp16, Debug_Reports);
      WriteToLog ('My_UTF16BE_ToBin StrTemp32 vor  dem Ausschneiden von 110111: ' + StrTemp32, Debug_Reports);
      StrTemp32 := StringReplace(StrTemp32, '110111', '', [rfIgnoreCase]);
      WriteToLog ('My_UTF16BE_ToBinS trTemp32 nach dem Ausschneiden von 110111: ' + StrTemp32, Debug_Reports);
      StrOut_Bin := StrTemp16 + StrTemp32;
   end; // If
   Result := StrOut_Bin;
   WriteToLog ('My_UTF16BE_ToBin Fertig! ' + StrOut_Bin, Debug_Reports);
End; // Function

Function MyHexTo_UTF8(MyString : String; var StrOut_MyHexTo_UTF8 : String; Debug_Reports : Byte) : String;

// IN  : 20AC daraus wird
//     :      0010    000010    101100	daraus wird
//     : 1110 0010 10 000010 10 101100  daraus wird
// OUT : chr($E2)+chr($82)+chr(AC) = EURO-Zeichen

var Intk : Integer;
var Inthelp : Integer;
var StrTempInt : String;
var StrBinTemp : String;
var boolBMP_Out : Boolean;
var LngIntTemp : LongInt;

begin

   // Ist der String gerade oder ungerade
   If Length(MyString) Mod 2 <> 0 Then begin
      MyString := '0' + MyString;
      Inthelp := 7;
      boolBMP_Out := True;
   end   
   Else begin
      Inthelp := 5;
      boolBMP_Out := False;
   end; // If
   Intk := 1;

   While Intk <= Length(MyString) do begin

      // Die erste Zahl im String sowie alle anderen Zahlen unter <= 65535
      // sind immer hexadezimal dargestellt
      // Das ist das **BMP**
   
      // Alles darüber beginnt mit hD8..hDB
      // Hierzu benötigen wir die Funktion ** My_UTF16BE_ToBin **
   
      // Den ersten Wert berechnen, der immer hexadezimal ist

      StrBinTemp := '';
      If Intk = 1 Then begin
         WriteToLog ('MyHexTo_UTF8 LngIntTemp Ink = 1 und boolBMP_Out -> ANFANG der Schleife : ' + Int64ToStr(LngIntTemp) + ' ' + BoolToStr(boolBMP_Out, True), Debug_Reports);
         StrBinTemp := copy(MyString, Intk, Inthelp - Intk);
         LngIntTemp := Math_BinaryToDec(dhHexToBinary(StrBinTemp,StrTempInt, False, Debug_Reports), Debug_Reports);
         WriteToLog ('MyHexTo_UTF8 LngIntTemp BoolBMP : ' + Int64ToStr(LngIntTemp) + ' ' + BoolToStr(boolBMP_Out, True), Debug_Reports);
         WriteToLog ('MyHexTo_UTF8 LngIntTemp Ink = 1 und boolBMP_Out -> ENDE der Schleife : ' + Int64ToStr(LngIntTemp) + ' ' + BoolToStr(boolBMP_Out, True), Debug_Reports);
      end   
      Else begin
         StrBinTemp := copy(MyString, Intk, Inthelp - Intk);
         If boolBMP_Out = True Then begin
            LngIntTemp := Math_BinaryToDec( My_UTF16BE_ToBin(StrBinTemp, StrTempInt, Debug_Reports), Debug_Reports); // Dezimalwert des Zeichens berechnen
            WriteToLog ('MyHexTo_UTF8 LngIntTemp BoolBMP : ' + Int64ToStr(LngIntTemp) + ' ' + BoolToStr(boolBMP_Out, True), Debug_Reports);
         end
         Else begin
            LngIntTemp := Math_BinaryToDec(dhHexToBinary(StrBinTemp, StrTempInt, False, Debug_Reports), Debug_Reports);
            WriteToLog ('MyHexTo_UTF8 LngIntTemp BoolBMP : ' + Int64ToStr(LngIntTemp) + ' ' + BoolToStr(boolBMP_Out, True), Debug_Reports);
         end; // If         
      end; // If
   
      // Jetzt die LongInt-Werte in hexadezimale Zahlen wandeln - und /das/ in der Corona-Zeit ;-)
   
      If LngIntTemp >= 65536 Then begin
             WriteToLog ('MyHexTo_UTF8 LngInt ist groesser als 65536!', Debug_Reports);
         StrBinTemp := dhDecToBinary(LngIntTemp, StrBinTemp, False, Debug_Reports);
            WriteToLog ('MyHexTo_UTF8 nach decToBinary und HexToBinary LngInt ist groesser als 65536! ' + Int64ToStr(LngIntTemp) + ' ' + StrBinTemp, Debug_Reports);
            WriteToLog ('MyHexTo_UTF8 StrBinTemp vor  dem Auffuellen mit Nullen! ' + StrBinTemp, Debug_Reports);
         // Ist die Laenge von StrBinTemp < 21 Zeichen?
         While Length(StrBinTemp) < 21 do begin
            StrBinTemp := '0' + StrBinTemp;
         end; // while
         // Ist die Laenge von StrBinTemp > 21 Zeichen?
         While Length(StrBinTemp) > 21 do begin
            StrBinTemp := copy(StrBinTemp, 2, length(StrBinTemp) - 1);
         end; // while
            WriteToLog ('MyHexTo_UTF8 StrBinTemp nach dem Auffuellen mit Nullen! ' + StrBinTemp, Debug_Reports);
         StrBinTemp := '11110' + copy(StrBinTemp, 1, 3) + '10' + copy(StrBinTemp, 4, 6) +
                      '10' + copy(StrBinTemp, 10, 6) + '10' + copy(StrBinTemp, 16, 6);
            WriteToLog ('MyHexTo_UTF8 StrBinTemp nach dem Eifuegen von 1110 u.s.w. ' + StrBinTemp, Debug_Reports);
         StrBinTemp := 'chr($' + dhBinarytoHex(copy(StrBinTemp, 1, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 5, 4), Debug_Reports) + ')+chr($' +
                            dhBinarytoHex(copy(StrBinTemp, 9, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 13, 4), Debug_Reports) + ')+chr($' +
                            dhBinarytoHex(copy(StrBinTemp, 17, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 21, 4), Debug_Reports) + ')+chr($' +
                            dhBinarytoHex(copy(StrBinTemp, 25, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 29, 4), Debug_Reports) + ')+';
      end; // If

      If (LngIntTemp >= 2048) And (LngIntTemp <= 65535) Then begin
         WriteToLog ('MyHexTo_UTF8 LngInt >= 2048 und <= 65535 : ' + Int64ToStr(LngIntTemp) + ' ' + StrBinTemp, Debug_Reports);
         StrBinTemp := dhDecToBinary(LngIntTemp, StrBinTemp, False, Debug_Reports);
         // Ist die Laenge von StrBinTemp < 16 Zeichen?
         While Length(StrBinTemp) < 16 do begin
            StrBinTemp := '0' + StrBinTemp;
         end; // while
         // Ist die Laenge von StrBinTemp > 16 Zeichen?
         While Length(StrBinTemp) > 16 do begin
            StrBinTemp := copy(StrBinTemp, 2, length(StrBinTemp) - 1);
         end; // while
         StrBinTemp := '1110' + copy(StrBinTemp, 1, 4) + '10' + copy(StrBinTemp, 5, 6) +
                      '10' + copy(StrBinTemp, 11, 6);
         StrBinTemp := 'chr($' + dhBinarytoHex(copy(StrBinTemp, 1, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 5, 4), Debug_Reports) + ')+chr($' +
                            dhBinarytoHex(copy(StrBinTemp, 9, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 13, 4), Debug_Reports) + ')+chr($' +
                            dhBinarytoHex(copy(StrBinTemp, 17, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 21, 4), Debug_Reports) + ')+';
      end; // If

      If (LngIntTemp >= 128) And (LngIntTemp <= 2047) Then begin
         WriteToLog ('MyHexTo_UTF8 LngInt >= 128 und <= 2048 : ' +Int64ToStr(LngIntTemp) + ' ' + StrBinTemp, Debug_Reports);
         StrBinTemp := dhDecToBinary(LngIntTemp, StrBinTemp, False, Debug_Reports);
         // Ist die Laenge von StrBinTemp < 11 Zeichen?
         While Length(StrBinTemp) < 11 do begin
            StrBinTemp := '0' + StrBinTemp;
         end; // while
         // Ist die Laenge von StrBinTemp > 11 Zeichen?
         While Length(StrBinTemp) > 11 do begin
            StrBinTemp := copy(StrBinTemp, 2, length(StrBinTemp) - 1);
         end; // while
         StrBinTemp := '110' + copy(StrBinTemp, 1, 5) + '10' + copy(StrBinTemp, 6, 6);
         StrBinTemp := 'chr($' + dhBinarytoHex(copy(StrBinTemp, 1, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 5, 4), Debug_Reports) + ')+chr($' +
                            dhBinarytoHex(copy(StrBinTemp, 9, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 13, 4), Debug_Reports) + ')+';
      end; // If

      If (LngIntTemp >= 0) And (LngIntTemp <= 127) Then begin
         WriteToLog ('MyHexTo_UTF8 LngInt >= 0 und <= 127 : ' + Int64ToStr(LngIntTemp) + ' ' + StrBinTemp, Debug_Reports);
         StrBinTemp := dhDecToBinary(LngIntTemp, StrBinTemp, False, Debug_Reports);
         // Ist die Laenge von StrBinTemp < 7 Zeichen?
         While Length(StrBinTemp) < 7 do begin
            StrBinTemp := '0' + StrBinTemp;
         end; // while
         // Ist die Laenge von StrBinTemp > 7 Zeichen?
         While Length(StrBinTemp) > 7 do begin
            StrBinTemp := copy(StrBinTemp, 2, length(StrBinTemp) - 1);
         end; // while
         StrBinTemp := '0' + copy(StrBinTemp, 1, 7);
         StrBinTemp := 'chr($' + dhBinarytoHex(copy(StrBinTemp, 1, 4), Debug_Reports) +
                            dhBinarytoHex(copy(StrBinTemp, 5, 4), Debug_Reports) + ')+';
      end; // If

      Intk := Inthelp;
      WriteToLog ('MyHexTo_UTF8 MyString wird auf "D8 D9 DA" ... getestet :' + MyString, Debug_Reports);
      WriteToLog ('MyHexTo_UTF8 MyString wird getestet Intk :' + IntToStr(Intk), Debug_Reports);
      If (copy(MyString, Intk, 2) = 'D8') Or
         (copy(MyString, Intk, 2) = 'D9') Or
         (copy(MyString, Intk, 2) = 'DA') Or
         (copy(MyString, Intk, 2) = 'DB') Then begin
         boolBMP_Out := True;
         Inthelp := Inthelp + 8;
      end   
      Else begin
         Inthelp := Inthelp + 4;
         boolBMP_Out := False;
      End; // If
      WriteToLog ('**MyHexTo_UTF8** Test ergab boolBMP_Out: ' + BoolToStr(boolBMP_Out, True), Debug_Reports);

      WriteToLog ('MyHexTo_UTF8 StrOut_MyHexTo_UTF8 vor  dem Zusammenfügen und seine Laenge : ' + StrOut_MyHexTo_UTF8 + '  ' + IntToStr(length(StrOut_MyHexTo_UTF8)), Debug_Reports);
      StrOut_MyHexTo_UTF8 := StrOut_MyHexTo_UTF8 + StrBinTemp;
      WriteToLog ('MyHexTo_UTF8 StrOut_MyHexTo_UTF8 nach dem Zusammenfügen und seine Laenge : ' + StrOut_MyHexTo_UTF8 + '  ' + IntToStr(length(StrOut_MyHexTo_UTF8)), Debug_Reports);
   end; // while
   WriteToLog ('MyHexTo_UTF8 LngIntTemp : ' + Int64ToStr(LngIntTemp) + ' ' + StrBinTemp, Debug_Reports);
   Result := copy (StrOut_MyHexTo_UTF8, 1, length(StrOut_MyHexTo_UTF8) - 1);
End; // Function

Function Is_Header_Encoded (H : String) : Boolean;

begin
   If ((ansipos('=?', H) > 0) and (ansipos('?=', H) > 0)) and
      ((ansipos('?B?', uppercase(H)) > 0) or (ansipos('?Q?', uppercase(H)) > 0)) then
      Result := True
   Else
      Result := False;
end;

// =?iso-8859-1?q?

Function GetHeader_Encoding (H : String) : String;

begin
  If Is_Header_Encoded (H) = True then begin
     If      ansipos ('=?ISO-8859-1?Q?', uppercase(H)) > 0 then Result := '=?ISO-8859-1?Q?'
     Else If ansipos ('=?ISO-8859-1?B?', upperCase(H)) > 0 then Result := '=?ISO-8859-1?B?'
     Else If ansipos ('=?ISO-8859-15?Q?', upperCase(H)) > 0 then Result := '=?ISO-8859-15?Q?'
     Else If ansipos ('=?ISO-8859-15?B?', upperCase(H)) > 0 then Result := '=?ISO-8859-15?B?'
     Else If ansipos ('=?UTF-7?Q?', upperCase(H)) > 0 then Result := '=?UTF-7?Q?'
     Else If ansipos ('=?UTF-7?B?', upperCase(H)) > 0 then Result := '=?UTF-7?B?'
     Else If ansipos ('=?UTF-8?Q?', upperCase(H)) > 0 then Result := '=?UTF-8?Q?'
     Else If ansipos ('=?UTF-8?B?', upperCase(H)) > 0 then Result := '=?UTF-8?B?'
     Else
     Result := '';
  end;   
end;

Function Decode_UTF7_Header (Str_IN : String; Debug_Reports : Byte) : String;

// STR_IN = Inhalt des Headers
// =?utf-7?Q?=5F+AOQ-=5F+APY-=5F+APw-=5F?= - ignore
// Sigma =?utf-7?Q?=28+A6MDwwPC-_vs=2E_+A/kD/gPyA3w-=29?=

var Inti : Integer;
var Str_Replace : String;
var Ints : Integer;
var Intk : Integer;
var Intz : Integer;
var Int_SP : Integer;
var Int_EP : Integer;
var Str_UTF7 : String;
var Str_UTF8 : String;
var Str_Bin : String;
var Str_Hex : String;
var UTF8_CharSet : String;
var Char_B64 : Set of Char;

begin
	 Char_B64 := ['a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z',
                'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
                '0','1','2','3','4','5','6','7','8','9','/','+'];
   Inti := 1;
   Str_IN := StringReplace(Str_IN, #13#10 + '', '', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, '?= =?utf-7?Q?', '', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, '?= =?UTF-7?Q?', '', [rfReplaceAll]);

   Str_IN := StringReplace(Str_IN, ' =?utf-7?Q?', '_', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, ' =?UTF-7?Q?', '_', [rfReplaceAll]);

   Str_IN := StringReplace(Str_IN, '=?utf-7?Q?', '', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, '=?UTF-7?Q?', '', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, '?=', '', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, ' _', '_', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, ' =', ' =3D', [rfReplaceAll]);

   WriteToLog ('**** Decode_UTF7_Header Str_IN zum Schluss des Bereinigens: ****  ' + Str_IN, Debug_Reports);

// ====================================================================
   // Str_IN := StringReplace(Str_IN, '+-', '*~~~~*', [rfReplaceAll]);
   Intz := 1;
   {
   while Intz <= length(Str_In) do begin
	    If (Str_In[Intz] = '+') then begin
	 	     if (copy (Str_In, Intz - 8, 3) <> '+IH') and (copy (Str_In, Intz - 8, 3) <> '+AL') and
	 	        (not (Str_In[Inti + 1] in Char_B64)) then begin
	 	         Str_In := copy (Str_In, 1, Intz - 1) + '*~~~~*'	+ copy (Str_In, Intz + 2, length(Str_In) - Intz + 1);
	 	         Intz := Intz + 5;
	 	     end; // If	 
	    end; // If
	    Intz := Intz + 1;
   end; // while
   }
   WriteToLog ('**** Decode_UTF7_Header Str_IN nach dem Tausch "+/-": ****  ' + Str_IN, Debug_Reports);
   Ints := 1;
   While Ints < length(Str_IN) do begin
      If (Str_IN[Ints] = '+') and  (Str_IN[Ints + 1] <> '-') and (Str_IN[Ints + 1] <> ' ') then begin
         Int_SP := Ints;
         Intk := Int_SP + 1;
         While Intk <= length (Str_IN) do begin
            If not (Str_IN[Intk] in Char_B64) then begin
            	 Int_EP := Intk;
               // Str_UTF7 := copy (Str_IN, Int_SP, Int_EP - Int_Sp + 1)

            	 If Str_IN[Int_EP] = '-' then
                  Str_UTF7 := copy (Str_IN, Int_SP, Int_EP - Int_Sp + 1)
               Else
                  Str_UTF7 := copy (Str_IN, Int_SP, Int_EP - Int_Sp);
               Str_Bin := '';
               Str_Hex := '';
               Str_UTF8 := '';
               MyAscToBin(Str_UTF7, Str_Bin, Debug_Reports);
                  WriteToLog ('Decode_UTF7_Header Str_Bin : ' + Str_Bin, Debug_Reports);
               MyConvertBinGroupToHexGroup (Str_Bin, Str_Hex, Debug_Reports);
                  WriteToLog ('Decode_UTF7_Header Str_Hex : ' + Str_Hex, Debug_Reports);
               MyHexTo_UTF8 (Str_Hex, Str_UTF8, Debug_Reports);               
               Inti := 1; //3 orig.
               Str_Replace := '';
               UTF8_CharSet := '';
                  WriteToLog ('Decode_UTF7_Header Str_Hex vor der while-Schleife : ' + Str_Hex, Debug_Reports);
               Str_Replace := Clean_UTF8_CharSet (Str_UTF8, Debug_Reports);
               // UTF8_CharSet := GetUTF8_CharSet(Str_UTF8, Debug_Reports);
               Str_IN := StringReplace(Str_IN, Str_UTF7, Str_Replace, [rfIgnoreCase]);
                   WriteToLog ('Decode_UTF7_Header Str_Replace : ' + Str_Replace, Debug_Reports);
               Ints := Ints + length(Str_Replace) - 1; // das naechste "+" ab Spalte Ints suchen
               Break; // Die letzte while-Schleife abbrechen!
            end; // If not (Str_IN[Intk] in ...
            Intk := Intk + 1;
         end;  // while
         Intk := 0;              
      end; // If Str_IN[Ints] = '+' ...
      Ints := Ints  + 1;
   end; // While
   // HIER **WURDEN** DIE PLUSZEICHEN WIEDER EINGEFUEGT!
   // !!!ALLE '*~~~~*' GEGEN "+" AUSTAUSCHEN! DIESE WURDEN OBEN DURCH EIN '*~~~~*' ERSETZT!!!
   // Str_IN := StringReplace(Str_IN, '*~~~~*', '+', [rfReplaceAll]);
   Str_IN := StringReplace(Str_IN, '_', ' ', [rfReplaceAll]);
   // Aenderung: 13.10.2021 "+-"
   Str_IN := StringReplace(Str_IN, '+-', '+', [rfReplaceAll]);
// ====================================================================

   Result := Str_IN;
end; // Function

Function Check_Subjekt_Header (Msg : TStringlist; Debug_Reports : Byte) : TStringList;
 
var  Bool_Subj_must_be_encoded : Boolean;  // muss das Subject kodiert werden?
     Bool_EnCode_Char : Boolean;           // es wurde ein *uncodiertes* Zeichen im Header gefunden!
     Bool_Reply : Boolean;                 // die Nachricht ist ein Reply (eine Antwort)
     Bool_Decode_UTF7 : Boolean;           // wurden UTF7-Sequenzen im Header decodiert? ==> =E2=82=AC für €
     Str_Subj_QP : String;                 // Subject QP-codiert (Betreff) der Nachricht
//     Str_Subj_B64 : String;                // Subject Base64-codiert (Betreff) der Nachricht
     Str_Subj_Replace : String;            // der zu tauschende String
     Str_Subj_Fold : String;               // der gefaltete Header
     Str_Temp : String;                    // temporaerer String
     intk : Integer;                       // allgemeiner Zaehler
     inti : Integer;                       // allgemeiner Zaehler
     intz : Integer;                       // allgemeiner Zaehler
     inthelp : Integer;                    // allgemeiner Zaehler
     Bool_Is_UTF7QP : Boolean;             // Header ist UTF-7 QP codiert
     Int_MaxLen_Subj : Integer;            // maximale Laenge einer Subjectzeile

begin 
   Bool_Subj_must_be_encoded := False;
   Bool_EnCode_Char := False;
   Bool_Is_UTF7QP := False;
   Inti := GetHeaderLine ('Subject:',Msg);
   If copy (GetHeader('Subject:', Msg), 1, 3) = 'Re:' then begin
      Bool_Reply := True;
      WriteToLog (' copy(H, 1, 3) : ' + copy (GetHeader('Subject:', Msg), 1, 3), Debug_Reports);
      Str_Subj_QP := copy (GetHeader('Subject:', Msg), 5, length(GetHeader('Subject:', Msg)) - 5 + 1);
      WriteToLog ('Check_Subjekt_Header - Subject des Replys : ' + Str_Subj_QP, Debug_Reports);    
   end   
   Else begin
      Bool_Reply := False;
      Str_Subj_QP := GetHeader('Subject:', Msg);
   end; // If   
   WriteToLog ('GetHeader_Encoding : ' + GetHeader_Encoding (Str_Subj_QP), Debug_Reports);    
   If GetHeader_Encoding (Str_Subj_QP) = '=?UTF-7?Q?' then begin
      Bool_Is_UTF7QP := True;
      WriteToLog ('GetHeader_Encoding : ' + GetHeader_Encoding (Str_Subj_QP), Debug_Reports);    
   end;   
         
   // RFC 2047
   // =?iso-8859-1?q?this_is_some_text?=

   If (((ansipos('=?', Str_Subj_QP) = 0) and (ansipos('?=', Str_Subj_QP) = 0)) and
      ((ansipos('?B?', uppercase(Str_Subj_QP)) = 0) and (ansipos('?Q?', uppercase(Str_Subj_QP)) = 0))) or
      (Bool_Is_UTF7QP = True) then begin
      If Bool_Is_UTF7QP = True then begin
         WriteToLog ('Eingang in Decode_UTF7_Header : ' + Str_Subj_QP, Debug_Reports);
         Str_Temp := Str_Subj_QP;
         Str_Subj_QP := Decode_UTF7_Header (Str_Subj_QP, Debug_Reports);

         WriteToLog ('Zurück kommt : ' + Str_Subj_QP, Debug_Reports);

         If Str_Subj_QP <> Str_Temp then begin
            Bool_Decode_UTF7 := True;
            Bool_Subj_must_be_encoded := True;
            Bool_EnCode_Char := True;
         end   
         Else begin
            Bool_Decode_UTF7 := False;
         end; // If   
         // Exit; // im Testbetrieb
      end;
      For Intk := 1 to length (Str_Subj_QP) do begin
         If ord(Str_Subj_QP[Intk]) > 127 then
            Bool_Subj_must_be_encoded := True;
      end; // For
      If Bool_Subj_must_be_encoded = True then begin
         Intk := 1;
         While Intk <= length (Str_Subj_QP) do begin
            Str_Subj_Replace := '';
            If (ord(Str_Subj_QP[Intk]) > 160) and (ord(Str_Subj_QP[Intk]) < 256) or
               (ord(Str_Subj_QP[Intk]) = 34) or                                   // " Anfuehrungszeichen
               // (ord(Str_Subj_QP[Intk]) = 39) or                                   // ' Apostroph
               (ord(Str_Subj_QP[Intk]) = 40) or                                   // ( Klammer auf
               (ord(Str_Subj_QP[Intk]) = 41) or                                   // ) Klammer zu
               (ord(Str_Subj_QP[Intk]) = 44) or                                   // , Komma
               (ord(Str_Subj_QP[Intk]) = 46) or                                   // . Punkt
               // (ord(Str_Subj_QP[Intk]) = 47) or                                   // / Slash
               (ord(Str_Subj_QP[Intk]) = 58) or                                   // : Doppelpunkt
               (ord(Str_Subj_QP[Intk]) = 59) or                                   // ; Semikolon
               (ord(Str_Subj_QP[Intk]) = 60) or                                   // < kleiner
               ((ord(Str_Subj_QP[Intk]) = 61) and (not Bool_Decode_UTF7)) or      // = ist gleich
               (ord(Str_Subj_QP[Intk]) = 62) or                                   // > groesser
               (ord(Str_Subj_QP[Intk]) = 63) or                                   // ? Fragezeichen
               (ord(Str_Subj_QP[Intk]) = 64) or                                   // @ das @ Zeichen
               (ord(Str_Subj_QP[Intk]) = 91) or                                   // [ eckige Klammer auf
               (ord(Str_Subj_QP[Intk]) = 92) or                                   // \ Backslash
               (ord(Str_Subj_QP[Intk]) = 93) then begin                           // ] eckige Klammer zu
               Bool_EnCode_Char := True;
               Str_Subj_Replace := Math_DecToUTF8(ord(Str_Subj_QP[Intk]));
               WriteToLog (' Ordnungszahl fuer : ' + Str_Subj_QP[Intk] + ' ist : ' + IntToStr(ord(Str_Subj_QP[Intk])), Debug_Reports);
               Str_Subj_QP := StringReplace(Str_Subj_QP, Str_Subj_QP[Intk], Str_Subj_Replace, [rfIgnoreCase]);
               Intk := Intk + length (Str_Subj_Replace) - 1;
            end;  //  If
            Intk := Intk + 1;
         end; // while
         If Bool_EnCode_Char then begin
               WriteToLog ('**** Str_Subj_QP vor den Tags der Kodierung **** : ' + Str_Subj_QP, Debug_Reports);
            Str_Subj_QP := StringReplace(Str_Subj_QP, ' ', '_', [rfReplaceAll]);
            If Bool_Reply = True then
               Str_Subj_QP := 'Subject: Re: ' + '=?UTF-8?Q?' + Str_Subj_QP + '?='
            Else
               Str_Subj_QP := 'Subject: ' + '=?UTF-8?Q?' + Str_Subj_QP + '?=';

            If length (Str_Subj_QP) > 75 then begin
               WriteToLog ('**** Str_Subj_QP nach den Tags der Kodierung **** : ' + Str_Subj_QP, Debug_Reports);
               WriteToLog ('**** Laenge von Str_Subj_QP **** : ' + IntToStr(length (Str_Subj_QP)), Debug_Reports);

               Str_Temp := Str_Subj_QP;
               Intk := 1;
               IntHelp := 0;
               Int_MaxLen_Subj := 75;
               
               while Intk < length (Str_Temp) do begin
                  
                  Intz := 0;
                  
                  If (Str_Temp[Intk] = '_') and (Intk <= (Int_MaxLen_Subj - 2)) then begin
                        IntHelp :=  Intk;
                        Intz := 1; 
                  end;

                  // Es folgt ein 1 Byte großes Zeichen z.B.: =5C fuer das Zeichen '\'
 
                 
                  If ((Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] <> 'C')) and
                     ((Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] <> 'D')) and
                     ((Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] <> 'E')) and
                     ((Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] <> 'F')) and (Intk <= (Int_MaxLen_Subj - 2)) then begin
                        IntHelp :=  Intk;
                        Intz := 3;
                        // Intk := Intk + 2;  
                  end;


                  // Es folgt ein 2 Byte großes Zeichen z.B.: =C3=A4 fuer Umlaut 'a'
                  
                  If ((Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] = 'C') or
                      (Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] = 'D')) and (Intk <= (Int_MaxLen_Subj - 2)) then begin
                  //    (Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] = 'D')) and ((Intk + 8) < 76) then begin
                        IntHelp :=  Intk;
                        Intz := 6;
                        // Intk := Intk + 5;  
                  end;

                  // Es folgt ein 3 Byte großes Zeichen z.B.: =E2=82=AC fuer das EURO-Zeichen

                  If (Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] = 'E') and (Intk <= (Int_MaxLen_Subj - 2)) then begin
                        IntHelp :=  Intk;
                        Intz := 9;
                        // Intk := Intk + 8;  
                  end;

                  // Es folgt ein 4 Byte großes Zeichen z.B.: =F0=9D=84=9E fuer das Violin-Zeichen

                  If (Str_Temp[Intk] = '=') and (Str_Temp[Intk + 1] = 'F') and (Intk <= (Int_MaxLen_Subj - 2)) then begin
                   //     WriteToLog ('** Str_Temp[Intk] ** : ' + Str_Temp[Intk], 4);
                   //     WriteToLog ('** Str_Temp[Intk + 1] ** : ' + Str_Temp[Intk + 1], 4);
                   //     WriteToLog ('** Intk ** : ' + IntToStr(Intk), 4);
                   //     WriteToLog ('** Intk + 1 ** : ' + IntToStr(Intk + 1), 4);
                        IntHelp :=  Intk;
                        Intz := 12;
                        // Intk := Intk + 11;  
                  end;

                  If ((Str_Temp[Intk] = '_') or (Str_Temp[Intk] = '=')) and ((Intk + Intz + 2) > Int_MaxLen_Subj) then begin
                     If Str_Temp[IntHelp - 1] = '_' then IntHelp := IntHelp - 1;
                        
                     Str_Subj_Fold := Str_Subj_Fold + copy (Str_Temp, 1, Inthelp - 1) + '?=' + #13#10 + ' ';
                     Str_Temp := '=?UTF-8?Q?' + copy (Str_Temp, Inthelp, length(Str_Temp) - Inthelp + 1);
                     WriteToLog ('** Laenge Str_Temp ** : ' + IntToStr(length(Str_Temp)), Debug_Reports);
                     Intk := 0;
                     Intz := 0;
                     Int_MaxLen_Subj := 74;
                  end;
                  
                  If Intz > 0 then
                     Intk := Intk + Intz
                  Else
                     Intk := Intk + 1;   
               end; // while

               If Str_Subj_Fold <> '' then begin
                  Str_Subj_Fold := Str_Subj_Fold + Str_Temp;
                  Str_Subj_QP := Str_Subj_Fold;
               end;   
            end; // If

            Msg := RemoveHeader ('Subject:', Msg );
            Msg.insert (Inti, Str_Subj_QP);               
            WriteToLog (' NEUES SUBJECT : ' + Str_Subj_QP, Debug_Reports);
         end; // If Bool_EnCode_Char
      end; // IF Bool_Subj_must_be_encoded ...
   end; // If (ansipos('=?' ...
   Result := Msg; 
end; // function

Function Math_HexToBin(Hex_In : String; ByteGroup : Byte) : String;

var
 DecDigit : Extended;
 TempStr : String;
 Temp : String;
 i : Integer;
 IntHelp : Integer;
 Numbers : Set of Char;
 Letters : Set of Char;

begin
	 Numbers := ['0','1','2','3','4','5','6','7','8','9'];
	 Letters := ['A','B','C','D','E','F'];
	 
   TempStr := '';
   // DecDigit := Digit;
   i := length (Hex_In);
   IntHelp := 0;
   DecDigit := 0;
   while i > 0 do begin
      Case Hex_In[i] of
         '0', '1', '2', '3', '4',
         '5', '6', '7', '8', '9'      : DecDigit := DecDigit  + StrToInt (Hex_In[i]) * Power(16,IntHelp);
         'A', 'B', 'C', 'D', 'E', 'F' : DecDigit := DecDigit  + (ord(Hex_In[i]) - 55) * Power(16,IntHelp);
      End; // of case
   i := i - 1;
   IntHelp := IntHelp + 1;
   end;  // while
   For i := (ByteGroup - 1) downto 0 do begin
      Temp := IntToStr (Trunc(DecDigit / Power(2,i)));
      TempStr := TempStr + Temp;
      DecDigit := DecDigit - (Int(DecDigit / Power(2,i)) * Power(2,i));
   end;
   Result := TempStr;
End;

function my_ansi_to_iso_8859_15 (Txt_In : String) : String;

// IN  : "Grüße" daraus wird
// OUT : "Grüße"

var Int_i : integer;
    Txt_temp : String;
    
begin
   Txt_Temp := Txt_In;
   Int_i := 1;
   While Int_i <= length (Txt_In) do begin
      Case Txt_in[Int_i] of
         chr($80) : Txt_temp[Int_i] := chr($A4);
         chr($8A) : Txt_temp[Int_i] := chr($A6);
         chr($8C) : Txt_temp[Int_i] := chr($BC);
         chr($8E) : Txt_temp[Int_i] := chr($B4);
         chr($9A) : Txt_temp[Int_i] := chr($A8);
         chr($9C) : Txt_temp[Int_i] := chr($BD);
         chr($9E) : Txt_temp[Int_i] := chr($BB);
         chr($9F) : Txt_temp[Int_i] := chr($BE);
      end;
      Int_i := Int_i + 1;
   end;
   If Txt_temp <> Txt_In then
      Result := Txt_temp
   else
      Result := Txt_In;
end;

function my_ansi_to_windows_1252 (Txt_In : String) : String;

// IN  : "Grüße" daraus wird
// OUT : "Grüße"

var Int_i : integer;
    Txt_temp : String;
    
begin
   Txt_Temp := Txt_In;
   Int_i := 1;
   While Int_i <= length (Txt_In) do begin
      Case Txt_in[Int_i] of
              '€' : Txt_temp[Int_i] := chr($80);
              'Š' : Txt_temp[Int_i] := chr($8A);
              'Œ' : Txt_temp[Int_i] := chr($8C);
              'Ž' : Txt_temp[Int_i] := chr($8E);
              'š' : Txt_temp[Int_i] := chr($9A);
              'œ' : Txt_temp[Int_i] := chr($9C);
              'ž' : Txt_temp[Int_i] := chr($9E);
              'Ÿ' : Txt_temp[Int_i] := chr($9F);
      end;
      Int_i := Int_i + 1;
   end;
   If Txt_temp <> Txt_In then
      Result := Txt_temp
   else
      Result := Txt_In;
end;

function my_ansi_to_utf7 (Txt_In : String) : String;

// IN  : "Grüße" daraus wird
// OUT : "Gr+APwA3w-e"

// UTF7_CharSet = ['(',')',',','.','/',':','?','-',' ',chr(13),chr(10),chr(9)];

var Inti         : Integer;
    Intk         : Integer;
    IntStart     : Integer;
    IntEnd       : Integer;
    Ext_Temp     : Extended;
    Bin_Temp     : string;
    Str_Bin      : String;
    Str_Replace  : String;
    Temp_Result  : String;
    Str_Temp     : String;
    HexBuffer    : String;
    U7           : Boolean; // Zeichen im CharSet?
    UTF7_CharSet : Set of Char;

begin

   UTF7_CharSet := ['a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z',
                    'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
                    '0','1','2','3','4','5','6','7','8','9','(',')',',','.','/',':','?','-',' ']; //chr(13),chr(10),chr(9)];
   Bin_Temp := '';
   Intk := 1;
   Temp_Result := Txt_In;
   while Intk <= length (Txt_In) do begin
   	  U7 := True;
   	  Str_Temp := '';
   	  Str_Bin := '';
   	  IntStart := Intk;
      IntEnd := 1;
      while not (Txt_In[Intk] in UTF7_CharSet) and (Intk <= length (Txt_In)) do begin
         HexBuffer := IntToHex(ord(Txt_In[Intk]),4);
         Case HexBuffer of
            '0080' : HexBuffer := '20AC';
            '0082' : HexBuffer := '201A';
            '0083' : HexBuffer := '0192';
            '0084' : HexBuffer := '201E';
            '0085' : HexBuffer := '2026';
            '0086' : HexBuffer := '2020';
            '0087' : HexBuffer := '2021';
            '0088' : HexBuffer := '02C6';
            '0089' : HexBuffer := '2030';
            '008A' : HexBuffer := '0160';
            '008B' : HexBuffer := '2039';
            '008C' : HexBuffer := '0152';
            '008E' : HexBuffer := '017D';
            '0091' : HexBuffer := '2018';
            '0092' : HexBuffer := '2019';
            '0093' : HexBuffer := '201C';
            '0094' : HexBuffer := '201D';
            '0095' : HexBuffer := '2022';
            '0096' : HexBuffer := '2013';
            '0097' : HexBuffer := '2014';
            '0098' : HexBuffer := '02DC';
            '0099' : HexBuffer := '2122';
            '009A' : HexBuffer := '0161';
            '009B' : HexBuffer := '203A';
            '009C' : HexBuffer := '0153';
            '009E' : HexBuffer := '017E';
            '009F' : HexBuffer := '0178';
         end; // of case
       // WriteToLog (HexBuffer,4);
         Str_Bin := Str_Bin + Math_HexToBin(HexBuffer, 16);
         Intk := Intk + 1;
         U7 := False;
         IntEnd := Intk;
      end; // while
      If not U7 then begin
         // Str_Bin auf ein Vielfaches von 6 auffuellen
         Inti := Trunc((length (Str_Bin) - 1) / 6 + 1) * 6;
         while length(Str_Bin) < Inti do
            Str_Bin := Str_Bin + '0';
         Inti := 1;
         while Inti <= length (Str_Bin) do begin
            Bin_Temp := copy (Str_Bin, Inti, 6);
            Ext_Temp := Math_BinaryToDec (Bin_Temp, 6);
            If Ext_Temp <= 25 then
               Str_Temp := Str_Temp + chr(Byte(Round(Ext_Temp)) + 65);
            If (Ext_Temp >= 26) and (Ext_Temp <= 51) then
               Str_Temp := Str_Temp + chr(Byte(Round(Ext_Temp)) + 71);
            If (Ext_Temp >= 52) and (Ext_Temp <= 61) then
               Str_Temp := Str_Temp + chr(Byte(Round(Ext_Temp)) - 4);
            If Ext_Temp = 63 then
               Str_Temp := Str_Temp + chr(Byte(Round(Ext_Temp)) - 16);
            Inti := Inti + 6;
         end; // while
         Str_Replace := copy (Txt_In, IntStart, IntEnd - IntStart);
         Str_Temp := '+' + Str_Temp + '-';
         Temp_Result := StringReplace(Temp_Result, Str_Replace, Str_Temp, [rfIgnoreCase]);
      end; // If
      Intk := Intk + 1;
   end; // while
   If Temp_Result <> Txt_In then
      Result := Temp_Result
   else
      Result := Txt_In;
end;

function my_ansi_to_utf8 (In_String: String) : String;

var Text_Input : String;
var Text_Out   : String;
var i          : LongInt;

begin

   Text_Input := In_String;
   Text_Out := '';

   i := 1;
   While i <= Length(Text_Input) do begin
      // dez 160 ... dez 191
      If (ord(Text_Input[i]) >= 160) And (ord(Text_Input[i]) <= 191) then
         Text_Out := Text_Out + Chr(194) + Chr(ord(Text_Input[i]))
      // dez 192 ... dez 255
      else
      If (ord(Text_Input[i]) >= 191) And (ord(Text_Input[i]) <= 255) then
         Text_Out := Text_Out + Chr(195) + Chr(ord(Text_Input[i]) - 64)
      // dez 128 ... dez 159
      else
      If (ord(Text_Input[i]) >= 128) And (ord(Text_Input[i]) <= 159) then
         Case ord(Text_Input[i]) of
            128 : Text_Out := Text_Out + Chr($E2) + Chr($82) + Chr($AC);
            // 129: Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($9A);
            130 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($9A);
            131 : Text_Out := Text_Out + Chr($C6) + Chr($92);
            132 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($9E);
            133 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($A6);
            134 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($A0);
            135 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($A1);
            136 : Text_Out := Text_Out + Chr($CB) + Chr($86);
            137 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($B0)
            138 : Text_Out := Text_Out + Chr($C5) + Chr($A0);
            139 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($B9);
            140 : Text_Out := Text_Out + Chr($C5) + Chr($92);
            // 141 : Text_Out := Text_Out + Chr(141);
            142 : Text_Out := Text_Out + Chr($C5) + Chr($BD);
            // 143 : Text_Out := Text_Out + Chr(143);
            // 144 : Text_Out := Text_Out + Chr(144);
            145 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($98);
            146 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($99);
            147 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($9C);
            148 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($9D);
            149 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($A2);
            150 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($93);
            151 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($94);
            152 : Text_Out := Text_Out + Chr($CB) + Chr($9C);
            153 : Text_Out := Text_Out + Chr($E2) + Chr($84) + Chr($A2);
            154 : Text_Out := Text_Out + Chr($C5) + Chr($A1);
            155 : Text_Out := Text_Out + Chr($E2) + Chr($80) + Chr($BA);
            156 : Text_Out := Text_Out + Chr($C5) + Chr($93);
            // 157 : Text_Out := Text_Out + Chr(157);
            158 : Text_Out := Text_Out + Chr($C5) + Chr($BE);
            159 : Text_Out := Text_Out + Chr($C5) + Chr($B8);
         end // of case   
      else
         Text_Out := Text_Out + Text_Input[i];
      i := i + 1;
   end; //while
   
   Result := Text_Out;

end; // function

function check_charset (Script_Name: String; In_String: String; var Msg: TStringList) : String;

var int_i                  : LongInt;
    int_z                  : LongInt;
    int_s                  : LongInt;
//    w_char                 : WideChar;
    my_charset_str         : string;
    my_current_CharSet     : integer;
    my_new_current_CharSet : integer;
    temp_str               : string;
    str_CType              : string;
    str_CTransfer          : string;
    Change_CTHeaders       : boolean;
    w1252_CharSet          : Set of Char;
    iso_8859_15_CharSet    : Set of Char;
    
begin

   w1252_CharSet := ['€', 'Š', 'š', 'Ž', 'ž', 'Œ', 'œ', 'Ÿ', '¤', '¦', '¨', '´', '¸',
                     '¼', '½', '¾', '‚', 'ƒ', '„', '…', '†', '‡', 'ˆ', '‰', '‹', '‘',
                     '’', '“', '”', '•', '–', '—', '˜', '™', '›'];
   iso_8859_15_CharSet := ['€', 'Š', 'š', 'Ž', 'ž', 'Œ', 'œ', 'Ÿ'];

   str_CType := '';
   str_CTransfer := '';
   str_CType := '';
   str_CTransfer := '';
   temp_str := In_String;
   Change_CTHeaders := false;
   // 0 = us-ascii; 1 = iso-8859-1; 2 = iso-8859-15;
   // 3 = windows-1252; 4 = utf-7; 5 = utf-8
   my_new_current_CharSet := 0;
   
   // w_char := chr($8364);
   // Int_z := ord(w_Char);
   // WriteToLog ('WideChar: ' + IntToStr(Int_z), 4);
   // WriteToLog ('WideChar: ' + w_char, 4);

   my_charset_str := GetHeader ('Content-Type:', Msg);

   If (AnsiPos ('us-ascii', my_charset_str) > 0) then
      my_current_CharSet := 0;
   If (AnsiPos ('iso-8859-1', my_charset_str) > 0) and 
      (AnsiPos ('iso-8859-15', my_charset_str) = 0) then
      my_current_CharSet := 1;
   If (AnsiPos ('iso-8859-15', my_charset_str) > 0) then
      my_current_CharSet := 2;
   If (AnsiPos ('windows-1252', my_charset_str) > 0) then
      my_current_CharSet := 3;
   If (AnsiPos ('utf-7', my_charset_str) > 0) then
      my_current_CharSet := 4;
   If (AnsiPos ('utf-8', my_charset_str) > 0) then
      my_current_CharSet := 5;

   // WriteToLog ('My_Charset_String: ' + my_charset_str, 4);
   // WriteToLog ('My_Current_CharSet: ' + IntToStr (my_current_CharSet), 4);

   For int_s := 1 to length(In_String) do begin
      If In_String[int_s] in w1252_CharSet then begin
      	 If In_String[int_s] in iso_8859_15_CharSet then
      	    My_new_Current_CharSet := 2
      	 else
      	    My_new_Current_CharSet := 3;
      end
      else begin
         // WriteToLog ('Ordinalwert: ' + IntToStr(ord(In_String[int_s])), 4);
         If (ord(In_String[int_s]) >= 160) and (ord(In_String[int_s]) <= 255) then
            My_new_Current_CharSet := 1
         else
            My_new_Current_CharSet := 0;
      end;
      If My_new_Current_CharSet > My_Current_CharSet then
         My_Current_CharSet := My_new_Current_CharSet;
   end;

   My_new_Current_CharSet := My_Current_CharSet;
   // WriteToLog ('My_new_Current_CharSet: ' + IntToStr (My_new_Current_CharSet), 4);

   If My_new_Current_CharSet = 0 then begin   
      // temp_str := my_ansi_to_utf8 (In_String);
      If (temp_str <> In_String)  then begin
         Str_CType := 'Content-Type: text/plain; charset=' + '"' + 'utf-8' + '"';
         Str_CTransfer := 'Content-Transfer-Encoding: 8bit';
         Change_CTHeaders := true;
         // WriteToLog ('Ich bin in "us-ascii"!', 4);
         // WriteToLog (Script_Name + ' hat Codierung auf UTF-8 gesetzt!', 4);
      end;
   end;
   If My_new_Current_CharSet = 1 then begin
      temp_str := my_ansi_to_windows_1252 (In_String);
      // If (temp_str <> In_String) then begin
         Str_CType := 'Content-Type: text/plain; charset=' + '"' + 'iso-8859-1' + '"';
         Str_CTransfer := 'Content-Transfer-Encoding: 8bit';
         Change_CTHeaders := true;
         // WriteToLog ('Ich bin in "iso-8859-1"!', 4);
         // WriteToLog (Script_Name + ' hat Codierung auf "iso-8859-1" gesetzt!', 4);
      // end;
   end;   
   If My_new_Current_CharSet = 2 then begin
      temp_str := my_ansi_to_iso_8859_15 (In_String);
      If (temp_str <> In_String) then begin
         Str_CType := 'Content-Type: text/plain; charset=' + '"' + 'iso-8859-15' + '"';
         Str_CTransfer := 'Content-Transfer-Encoding: 8bit';
         Change_CTHeaders := true;
         // WriteToLog ('Ich bin in "iso-8859-15"!', 4);
         // WriteToLog (Script_Name + ' hat Codierung auf "iso-8859-15" gesetzt!', 4);
      end;
   end;   
   If My_new_Current_CharSet = 3 then begin
      temp_str := my_ansi_to_windows_1252 (In_String);
      // If (temp_str <> In_String) then begin
         Str_CType := 'Content-Type: text/plain; charset=' + '"' + 'windows-1252' + '"';
         Str_CTransfer := 'Content-Transfer-Encoding: 8bit';
         Change_CTHeaders := true;
         // WriteToLog ('Ich bin in "windows-1252"!', 4);
         // WriteToLog (Script_Name + ' hat Codierung auf "windows-1252" gesetzt!', 4);
      // end;
   end;   
   If My_new_Current_CharSet = 4 then begin
      temp_str := trimright(my_ansi_to_utf7 (In_String + ' '));
      If temp_str <> In_String then begin
         // WriteToLog ('Ich bin in "utf-7"!', 4);
         // WriteToLog (Script_Name + ' hat Codierung auf UTF-7 gesetzt!', 4);
      end;
   end;   
   If My_new_Current_CharSet = 5 then begin   
      temp_str := my_ansi_to_utf8 (In_String);
      If temp_str <> In_String then begin
         // Str_CType := 'Content-Type: text/plain; charset=' + '"' + 'utf-8' + '"';
         // Str_CTransfer := 'Content-Transfer-Encoding: 8bit';
         // WriteToLog ('Ich bin in "utf-8"!', 4);
         // WriteToLog (Script_Name + ' hat Codierung auf UTF-8 gesetzt!', 4);
      end;
   end;

   // if ((temp_str <> In_String) and (Change_CTHeaders = true)) or (w1252 = true) then begin
   if Change_CTHeaders = true then begin
   	  int_z := Msg.IndexOf ('');
      int_i := GetHeaderLine ('Content-Type:',Msg);
      if int_i > -1 then begin
      	 // WriteToLog ('Position Content-Type-Header: ' + IntToStr(Int_i), 4 );
         Msg := RemoveHeader ('Content-Type:', Msg );
         Msg.insert (int_i, Str_CType);
      end else begin
         Msg.insert (int_z, Str_CType);
      end;
      int_i := GetHeaderLine ('Content-Transfer-Encoding:', Msg);
      if int_i > -1 then begin
      	 // WriteToLog ('Position Content-Transfer-Encoding-Header: ' + IntToStr(Int_i), 4 );
         Msg := RemoveHeader ('Content-Transfer-Encoding:', Msg );
         Msg.insert (int_i, Str_CTransfer);
      end else begin
         Msg.insert (int_z, Str_CTransfer);
      end;
   end;
   Result := temp_str;
end;