Mails avec indy10, résolution du problème lorsque charset = utf-8

Commenter

Contenu du snippet

Indy10 est après moultes tests, (pour moi) le meilleur package de compos orienté communications réseau/internet.

Mais voilà, il subsiste un bug car la gestion des mails au format UTF-8 lors de la réception n' est pas gérée.
Ce que je vous propose, c' est de remplacer 2 fonctions pour gérer le charset UTF-8 :) pour convertir correctement le "Subject" du mail ainsi que le body lorsque celui-ci est de type text/plain .

Source / Exemple : 


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;

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_MAURICIO)