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;
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.