Hello Francesco,
I found the same bug, but use this alternate fix:
=========================================================
IdMessageClient.pas
=========================================================
function ProcessTextPart(ADecoder: TIdMessageDecoder): TIdMessageDecoder;
var
LDestStream: TStringStream;
begin
// Torsten : Apply then decoded header
LDestStream := TStringStream.Create(''); try
Result := ADecoder.ReadBody(LDestStream, MsgEnd);
with TIdText.Create(AMsg.MessageParts) do begin
Body.Text := LDestStream.DataString;
Headers.AddStdValues(ADecoder.Headers);
// Torsten : Apply then MIME Boundary
if ADecoder is TIdMessageDecoderMIME then
Boundary := (ADecoder as TIdMessageDecoderMIME).MIMEBoundary;
end;
ADecoder.Free;
finally FreeAndNil(LDestStream); end;
end;
function ProcessAttachment(ADecoder: TIdMessageDecoder):
TIdMessageDecoder;
var
LDestStream: TFileStream;
LTempPathname: string;
begin
LTempPathname := MakeTempFilename;
LDestStream := TFileStream.Create(LTempPathname, fmCreate); try
Result := ADecoder.ReadBody(LDestStream, MsgEnd);
with TIdAttachment.Create(AMsg.MessageParts) do begin
Filename := ADecoder.Filename;
StoredPathname := LTempPathname;
// Torsten : Apply then decoded header
Headers.AddStdValues(ADecoder.Headers);
// Torsten : Apply then MIME Boundary
if ADecoder is TIdMessageDecoderMIME then
Boundary := (ADecoder as TIdMessageDecoderMIME).MIMEBoundary;
end;
ADecoder.Free;
finally FreeAndNil(LDestStream); end;
end;
To display the embedded images of a html mail I have to scan then boundary
string for then "CONTENT-ID" part.
Therefore I assign then decoded boundary string to the MessageParts too.
There are a couple of bugs (or design errors) in the
IdCoderHeader.EncodeHeader procedure. They only work
correct with ISO8859-1 charsets. A lot of emails from windows mail clients
use US_ASCII or WINDOWS-1252
charsets. I've replace the original procedure by the following code:
=========================================================
IdCoderHeader.pas
=========================================================
uses
...
windows,
...
function DecodeQuotedPrintable(const CodedStr : string) : string;
var i, l : integer;
begin
result := '';
i := 1; l := length(CodedStr);
while (i <= l) do begin
if CodedStr[i] = '_' then begin
result := result + ' '
end else
if CodedStr[i] = '=' then begin
result := result + chr(StrToInt('$' + CodedStr[i + 1] + CodedStr[i +
2]));
inc(i, 2);
end else
if ord(CodedStr[i]) > 32 then
result := result + CodedStr[i];
inc(i);
end;
end;
function DecodeBase64(const CodedStr : string) : string;
var
a3 : array[1..3] of byte;
a4 : array[1..4] of byte;
i,j : integer;
begin
result := '';
i := 0;
while (i < (Length(CodedStr)-4)) do begin
a4[1] := b64(CodedStr[i+1]);
a4[2] := b64(CodedStr[i+2]);
a4[3] := b64(CodedStr[i+3]);
a4[4] := b64(CodedStr[i+4]);
a3[1] := (a4[1] shl 2) or (a4[2] shr 4);
a3[2] := (a4[2] shl 4) or (a4[3] shr 2);
a3[3] := (a4[3] shl 6) or (a4[4] shr 0);
//>> Torsten : eventuell abschlie?ende #0 entfernen
for j := 1 to 3 do
if a3[j] <> 0 then result := result+chr(a3[j]);
inc(i,4);
end;
end;
function DecodeUSASCII(HeaderEncoding : char; const CodedStr : string) :
string;
begin
case HeaderEncoding of
'Q' : result := DecodeQuotedPrintable(CodedStr);
'B' : result := DecodeBase64(CodedStr);
else result := CodedStr; //Unbekannte Kodierung, undekodiert zurck
end;
OEMToChar(pChar(result),pChar(result));
end;
function DecodeISO8859(HeaderEncoding : char; const CodedStr : string) :
string;
begin
case HeaderEncoding of
'Q' : result := DecodeQuotedPrintable(CodedStr);
'B' : result := DecodeBase64(CodedStr);
else result := CodedStr; //Unbekannte Kodierung, undekodiert zurck
end;
end;
function DecodeHeader(Header: string): string;
var
k : Integer;
HeaderCharSet : string;
CodedStr : string;
HeaderEncoding : char;
begin
result := '';
if Header = '' then exit;
//>> Torsten 06.12.2000
// Codec ?
k := Pos('=?',Header);
if k = 0 then begin
// keine Codierung
Result := Header;
exit;
end;
// Sonst Dekodieren
// Nicht Kodierter Begin der Nachricht, Whitespace l?schen
result := Trim(Copy(Header,1,k-1));
System.Delete(Header,1,k+1);
// Den zu Dekodierend Bereich bestimmen
k := Pos('?=',Header);
if k = 0 then k := length(Header)+1;
CodedStr := Copy(Header,1,k-1);
// und aus dem Header entfernen
System.Delete(Header,1,k+1);
// den Characterset bestimmen
k := Pos('?',CodedStr);
if k = 0 then begin
// Fehler, uncodiert zurckliefern
result := result + CodedStr+ Header;
exit;
end;
HeaderCharSet := UpperCase(Copy(CodedStr,1,k-1));
System.Delete( CodedStr,1,k);
// Encoding bestimmen
if (length(CodedStr) < 2) or (CodedStr[2] <> '?') then begin
// Fehler, uncodiert zurckliefern
result := result + CodedStr + Header;
exit;
end;
HeaderEncoding := UpCase(CodedStr[1]);
System.Delete( CodedStr,1,2);
// Je nach Format den richtigen Decoder Aufrufen
if AnsiSameText(HeaderCharSet, 'ISO-2022-JP') then begin
result := result + Decode2022JP(CodedStr)
end else
if AnsiSameText(HeaderCharSet,'ISO-8859-1') then begin
result := result + DecodeISO8859(HeaderEncoding,CodedStr)
end else
if AnsiSameText(HeaderCharSet,'WINDOWS-1252') then begin
result := result + DecodeISO8859(HeaderEncoding,CodedStr)
end else
if AnsiSameText(HeaderCharSet,'US_ASCII') then begin
result := result + DecodeUSASCII(HeaderEncoding,CodedStr)
end else
result := result + CodedStr;
// ggf. den Rest dekodieren
result := result+DecodeHeader(Header);
end;
Torsten
"Francesco Pucino" <fpuc...@mclink.it> schrieb im Newsbeitrag
news:3c08fdb5_1@dnews...
Quote
> Hello, I have discovered and fixed some bugs in Indy 9.0.2 B.
> Please let me if my fix can generate new errors in other points !
> After the fix, headers and content-type work fine on TIdText and
> TIdAttachment.
> Thanks
> Francesco
> =========================================================
> IdMessageClient.pas
> =========================================================
> function ProcessTextPart(ADecoder: TIdMessageDecoder):
TIdMessageDecoder;
> var
> LDestStream: TStringStream;
> begin
> LDestStream := TStringStream.Create(''); try
> Result := ADecoder.ReadBody(LDestStream, MsgEnd);
> // START MODIFY 2001-12-01 by Francesco Pucino
> //ADecoder.Free;
> with TIdText.Create(AMsg.MessageParts) do begin
> Body.Text := LDestStream.DataString;
> Headers.Assign(ADecoder.Headers);
> end;
> ADecoder.Free;
> // END MODIFY 2001-12-01 by Francesco Pucino
> finally FreeAndNil(LDestStream); end;
> end;
> function ProcessAttachment(ADecoder: TIdMessageDecoder):
TIdMessageDecoder;
> var
> LDestStream: TFileStream;
> LTempPathname: string;
> begin
> LTempPathname := MakeTempFilename;
> LDestStream := TFileStream.Create(LTempPathname, fmCreate); try
> Result := ADecoder.ReadBody(LDestStream, MsgEnd);
> with TIdAttachment.Create(AMsg.MessageParts) do begin
> Filename := ADecoder.Filename;
> StoredPathname := LTempPathname;
> // START MODIFY 2001-12-01 by Francesco Pucino
> Headers.Assign(ADecoder.Headers);
> // END MODIFY 2001-12-01 by Francesco Pucino
> end;
> ADecoder.Free;
> finally FreeAndNil(LDestStream); end;
> end;
> =========================================================
> IdMessage.pas
> =========================================================
> constructor TIdMessagePart.Create(Collection: TCollection);
> begin
> if ClassType = TIdMessagePart then begin
> raise EIdCanNotCreateMessagePart.Create(RSTIdMessagePartCreate);
> end;
> inherited;
> FIsEncoded := False;
> FHeaders := TIdHeaderList.Create;
> // START MODIFY 2001-12-01 by Francesco Pucino
> FHeaders.NameValueSeparator:='=';
> // END MODIFY 2001-12-01 bt Francesco Pucino
> FExtraHeaders := TIdHeaderList.Create;
> end;
