MAILS AVEC INDY10, RÉSOLUTION DU PROBLÈME LORSQUE CHARSET = UTF-8

Voici la 1ere fonction à remplacer dans l' unité IdCoderHeader.pas : 
Mes changements sont marqués par "// RHR" en commentaire pour que vous sachiez ce que j' ai fait!!!

function DecodeHeader(Header: string):string;  
const
  WhiteSpace = [LF, CR, CHAR32, TAB];
var
  i, l: Integer;
  HeaderEncoding,
  HeaderCharSet,
  s: string;
  a3: array [1..3] of byte;
  a4: array [1..4] of byte;
  LEncodingStartPos,encodingendpos:Integer;
  LPreviousEncodingStartPos: integer;
  substring: string;
  EncodingFound: Boolean;
  OnlyWhitespace: boolean;
  EncodingBeforeEnd: integer;
begin
  // Get the Charset part.
  EncodingBeforeEnd := -1;
  LEncodingStartPos := PosIdx('=?ISO', UpperCase(Header), 1); {do not localize}
  if LEncodingStartPos = 0 then begin
    LEncodingStartPos := PosIdx('=?WINDOWS', UpperCase(Header), 1); {do not localize}
  end;
  if LEncodingStartPos = 0 then begin
    LEncodingStartPos := PosIdx('=?KOI8', UpperCase(Header), 1); {do not localize}
  end;
  // RHR BEGIN
  if LEncodingStartPos = 0 then begin
    LEncodingStartPos := PosIdx('=?UTF-8', UpperCase(Header), 1); {do not localize}
  end;
  // RHR END

  while LEncodingStartPos > 0 do begin
    // Assume we will find the encoding
    EncodingFound := True;

    //we need 3 more question marks first and after that a '?='    {Do not Localize}
    //to find the end of the substring, we can't just search for '?=',    {Do not Localize}
    //example: '=?ISO-8859-1?Q?=E4?='    {Do not Localize}
    encodingendpos := PosIdx('?', UpperCase(Header),LEncodingStartPos+5);  {Do not Localize}
    if encodingendpos = 0 then begin
      EncodingFound := False;
    end else begin
      // valid encoded words can not contain spaces
      // if the user types something *almost* like an encoded word,
      // and its sent as-is, we need to find this!!
      for i := LEncodingStartPos to encodingendpos-1 do begin
        if CharIsInSet(Header, i, Whitespace) then begin
          EncodingFound := false;
          break;
        end;
      end;
    end;

    if EncodingFound then
    begin
      encodingendpos:=PosIdx('?', UpperCase(Header),encodingendpos+1);  {Do not Localize}
      if encodingendpos=0 then
      begin
        EncodingFound := false;
      end else begin
        for i := LEncodingStartPos to encodingendpos-1 do begin
          if CharIsInSet(Header, i, Whitespace) then begin
            EncodingFound := false;
            break;
          end;
        end;
      end;
    end;

    if EncodingFound then
    begin
      encodingendpos:=PosIdx('?=', UpperCase(Header),encodingendpos+1);  {Do not Localize}
      if encodingendpos > 0 then
      begin
        for i := LEncodingStartPos to encodingendpos-1 do begin
          if CharIsInSet(Header, i, Whitespace) then begin
            EncodingFound := false;
            break;
          end;
        end;

        if EncodingFound then begin
          substring:=Copy(Header,LEncodingStartPos,encodingendpos-LEncodingStartPos+2);
          //now decode the substring
          for i := 1 to 3 do
          begin
            l := Pos('?', substring);   {Do not Localize}
            substring := Copy(substring, l+1, Length(substring) - l + 1 );
            if i = 1 then
            begin
              HeaderCharSet := Copy(substring, 1, Pos('?', substring)-1)  {Do not Localize}
            end else if i = 2 then
            begin
              HeaderEncoding := copy(substring,1,1);
            end;
          end;

          //now Substring needs to end with '?=' otherwise give up!    {Do not Localize}
          if Copy(substring,Length(substring)-1,2)<>'?=' then    {Do not Localize}
          begin
            EncodingFound := false;
          end;
        end;

        if (EncodingBeforeEnd>=0) and EncodingFound and (LEncodingStartPos > 0) then begin
          OnlyWhitespace := true;
          for i:=EncodingBeforeEnd to LEncodingStartPos-1 do begin
            if not (CharIsInSet(Header, i, WhiteSpace)) then begin
              OnlyWhitespace := false;
              break;
            end;
          end;
          if OnlyWhitespace then begin
            Delete(Header, EncodingBeforeEnd, LEncodingStartPos-EncodingBeforeEnd);
            encodingendpos := encodingendpos - (LEncodingStartPos-encodingbeforeend);
            LEncodingStartPos := EncodingBeforeEnd;
          end;
        end;

        // Get the HeaderEncoding
        if TextIsSame(HeaderEncoding, 'Q') {Do not Localize}
        and EncodingFound then begin
          i := 1;
          s := '';        {Do not Localize}
          repeat // substring can be accessed by index here, because we know that it ends with '?='    {Do not Localize}
            if substring[i] = '_' then  {Do not Localize}
            begin
              s := s + ' ';    {Do not Localize}
            end else if (substring[i] = '=') and (Length(substring)>=i+2+2) then //make sure we can access i+2 and '?=' is still beyond    {Do not Localize}
            begin
              s := s + chr(StrToInt('$' + substring[i+1] + substring[i+2]));   {Do not Localize}
              inc(i,2);
            end else
            begin
              s := s + substring[i];
            end;
            inc(i);
          until (substring[i]='?') and (substring[i+1]='=')   {Do not Localize}
        end else if EncodingFound then
        begin
          while Length(substring) >= 4 do
          begin
            a4[1] := b64(substring[1]);
            a4[2] := b64(substring[2]);
            a4[3] := b64(substring[3]);
            a4[4] := b64(substring[4]);
            a3[1] := Byte((a4[1] shl 2) or (a4[2] shr 4));
            a3[2] := Byte((a4[2] shl 4) or (a4[3] shr 2));
            a3[3] := Byte((a4[3] shl 6) or (a4[4] shr 0));
            substring := Copy(substring, 5, Length(substring));
            s := s + CHR(a3[1]) + CHR(a3[2]) + CHR(a3[3]);
          end;
        end;

        if EncodingFound then
        begin
          if TextIsSame(HeaderCharSet, 'ISO-2022-JP') then  {Do not Localize}
          begin
            substring := Decode2022JP(s);
          end
          else
            // RHR BEGIN
            if TextIsSame(HeaderCharSet, 'utf-8')
            then begin
              SubString := Utf8ToAnsi(s);
            end
            // RHR END 
            else begin
              substring := s;
            end;

          //replace old substring in header with decoded one:
          header := Copy(header, 1, LEncodingStartPos - 1)
            + substring + Copy(header, encodingendpos + 2, Length(Header));
          encodingendpos := length(substring);
          substring := '';   {Do not Localize}
        end;

      end;
    end;
    encodingendpos := LEncodingStartPos + encodingendpos;
    {CC: Bug fix - changed LEncodingStartPos to LPreviousEncodingStartPos because
     LEncodingStartPos gets overwritten by return value from PosIdx.}

    LPreviousEncodingStartPos := LEncodingStartPos;
    LEncodingStartPos := PosIdx('=?ISO', UpperCase(Header), LPreviousEncodingStartPos + 1); {do not localize}
    if LEncodingStartPos = 0 then begin
      LEncodingStartPos := PosIdx('=?WINDOWS', UpperCase(Header), LPreviousEncodingStartPos + 1); {do not localize}
    end;
    if LEncodingStartPos = 0 then begin
      LEncodingStartPos := PosIdx('=?KOI8', UpperCase(Header), LPreviousEncodingStartPos + 1); {do not localize}
    end;
    // BEGIN RHR //
    if LEncodingStartPos = 0 then begin
      LEncodingStartPos := PosIdx('=?UTF-8', UpperCase(Header), LPreviousEncodingStartPos + 1); {do not localize}
    end;
    // END RHR //

    // delete whitespace between adjacent encoded words, but only
    // if we had an encoding before
    if EncodingFound then begin
      EncodingBeforeEnd := encodingendpos;
    end else begin
      EncodingBeforeEnd := -1;
    end;
  end;
  //There might be #0's in header when this it b64 encoded, e.g with:
  //decodeheader('"Fernando Corti=?ISO-8859-1?B?8Q==?=a" <fernando@nowhere.com>');
  while Pos(#0, header) > 0 do begin
    Delete(header, Pos(#0, header), 1);
  end;
  Result := Header;
end;





Voici la 2eme fonction à remplacer dans l' unité IdMessageClient.pas : 
Mes changements sont marqués par "// RHR" pour que vous sachiez ce que j' ai fait!!!
La fonction est une sous-fonction de la fonction suivante: 
procedure TIdMessageClient.ReceiveBody(AMsg: TIdMessage; const ADelim: string = '.');  {do not localize}

  function ProcessTextPart(ADecoder: TIdMessageDecoder; AUseBodyAsTarget: Boolean = False): TIdMessageDecoder;
  {Only set AUseBodyAsTarget to True if you want the input stream stored in TIdMessage.Body
  instead of TIdText.Body: this happens with some single-part messages.}
  var
    LDestStream: TIdStreamVCL;
    LStringStream: TStringStream;
    i, l: integer;
    LTxt : TIdText;
  begin
    LStringStream := TIdStringStream.Create('');
    try
      LDestStream := TIdStreamVCL.Create(LStringStream);
      try
        LParentPart := AMsg.MIMEBoundary.ParentPart;
        Result := ADecoder.ReadBody(LDestStream, LMsgEnd);
        if AUseBodyAsTarget then begin
          // RHR BEGIN
          if TextIsSame(AMsg.CharSet, 'utf-8') and TextIsSame(AMsg.ContentType, 'text/plain')
          then begin  
            AMsg.Body.Text := LStringStream.DataString; // Utf8ToAnsi(LStringStream.DataString) ne marche pas si le body est trop grand !!!

            for l := 0 to AMsg.Body.Count-1 do
              AMsg.Body[l] := Utf8ToAnsi(AMsg.Body[l]);
          end
          else
          // RHR END
          AMsg.Body.Text := LStringStream.DataString;
        end else begin
          LTxt := TIdText.Create(AMsg.MessageParts);
          LTxt.Body.Text := LStringStream.DataString;
          RemoveLastBlankLine(LTxt.Body);
          if AMsg.IsMsgSinglePartMime then begin
            LTxt.ContentType := LTxt.ResolveContentType(AMsg.Headers.Values[SContentType]);
            LTxt.Headers.Add('Content-Type: '+AMsg.Headers.Values[SContentType]);  {do not localize}
            LTxt.CharSet := LTxt.GetCharSet(AMsg.Headers.Values['Content-Type']);  {do not localize}
            LTxt.ContentTransfer := AMsg.Headers.Values['Content-Transfer-Encoding']; {do not localize}
            LTxt.Headers.Add('Content-Transfer-Encoding: '+AMsg.Headers.Values['Content-Transfer-Encoding']);  {do not localize}
            LTxt.ContentID := AMsg.Headers.Values['Content-ID'];  {do not localize}
            LTxt.ContentLocation := AMsg.Headers.Values['Content-Location'];  {do not localize}
          end else begin
            LTxt.ContentType := LTxt.ResolveContentType(ADecoder.Headers.Values[SContentType]);
            LTxt.Headers.Add('Content-Type: '+ADecoder.Headers.Values[SContentType]);          {do not localize}
            LTxt.CharSet := LTxt.GetCharSet(ADecoder.Headers.Values['Content-Type']);          {do not localize}
            LTxt.ContentTransfer := ADecoder.Headers.Values['Content-Transfer-Encoding']; {do not localize}
            LTxt.Headers.Add('Content-Transfer-Encoding: '+ADecoder.Headers.Values['Content-Transfer-Encoding']);  {do not localize}
            LTxt.ContentID := ADecoder.Headers.Values['Content-ID'];  {do not localize}
            LTxt.ContentLocation := ADecoder.Headers.Values['Content-Location'];  {do not localize}
            LTxt.ExtraHeaders.NameValueSeparator := '=';                          {do not localize}
            for i := 0 to ADecoder.Headers.Count-1 do begin
              if LTxt.Headers.IndexOfName(ADecoder.Headers.Names[i]) < 0 then begin
                LTxt.ExtraHeaders.Add(ADecoder.Headers.Strings[i]);
              end;
            end;
          end;
          if TextIsSame(Copy(LTxt.ContentType, 1, 10), 'multipart/') then begin {do not localize}
            LTxt.ParentPart := LPreviousParentPart;
          end else begin
            LTxt.ParentPart := LParentPart;
          end;

          // RHR BEGIN
          if TextIsSame(LTxt.CharSet, 'utf-8') and TextIsSame(LTxt.ContentType, 'text/plain')   // Sauter si au format HTML ou autre ...
          then
            for l := 0 to Ltxt.Body.Count-1 do
              LTxt.Body[l] := Utf8ToAnsi(LTxt.Body[l]);
          // RHR END
        end;
        ADecoder.Free;
      finally FreeAndNil(LDestStream); end;
    finally FreeAndNil(LStringStream); end;
  end;

31 juillet 2007 15:05:36 :

Optimisation/Correction de la fonction

31 juillet 2007 16:24:23 :

Prise en compte du Body au format UTF-8 ...

01 août 2007 14:55:37 :

Optimisation utilisant la fonction TextIsSame()