Форум: "Основная";
Текущий архив: 2011.07.10;
Скачать: [xml.tar.bz2];

Вниз

чтение писем из eml формата..   Найти похожие ветки 

← →
istok20 ©   (2009-11-25 13:34) [0]

какие компоненты умеют читать содержимое.eml с пониманием кодировки utf-8 и вытаскиванием from\to\subject\body\attachments и тд?   пробовал mail2000, но он кодировки не понимает...

---

← →
Игорь Шевченко ©   (2009-11-25 14:07) [1]

> пробовал mail2000, но он кодировки не понимает...


а я себе подправил. там несложно

---

← →
Игорь Шевченко ©   (2009-11-25 14:12) [2]

Где-то так:

// Get the subject

function TMailMessage2000.GetSubject: String;
begin
//See changelog.txt
 Result := DecodeLine7BitEx(GetLabelValue("Subject"));
end;

// Get file name of attachment

function TMailPart.GetFileName: String;
var
 Name: String;
begin
 Name := "";
 if LabelParamExists(_C_T, "name") then
   Name := GetLabelParamValue(_C_T, "name")
 else if LabelParamExists(_C_D, "filename") then
   Name := GetLabelParamValue(_C_D, "filename")
 else if LabelExists(_C_ID) then
   Name := GetLabelValue(_C_ID)
 else if LabelExists(_C_T) then
   Name := GetLabelValue(_C_T)+GetMimeExtension(GetLabelValue(_C_T))
 else
   Name := "unknown";
 Name := DecodeLine7BitEx(Name); //see changelog.txt
 if Pos(".", Name) = 0 then
   Name := Name + GetMimeExtension(GetLabelValue(_C_T));
 Result := ValidFileName(Name);
end;

function DecodeLine7BitEx(const Text: string): string;
//текстом является строка, окруженная разделителями =? и ?=
var
 Worker: string;
 I, J, Q: Integer;
begin
 Result := "";
 Worker := Text;
 while true do
 begin
   I := Pos("=?", Worker);
   if I = 0 then
   begin
   { Строка не содержит закодированного текста }
     Result := Result + DecodeLine7Bit(Worker);
     Exit;
   end;
   Result := Result + Copy(Worker, 1, I-1); //Незакодированная часть
   Worker := Copy(Worker, I, Length(Text));
   J := Pos("?=",Worker); //Ищем окончание кодированной части
   Q := Pos("?Q?=", Worker); //Если имя файла закодировано в Quoted-printable,
                             // то окончание кодированного текста следует
                             // искать после кодировки
   if Q > 0 then
   begin
     J := Pos("?=", Copy(Worker, Q+4, Length(Worker)));
     if J > 0 then
       Inc(J, Q+3);
   end;
   if J > 0 then
   begin
     Result := Result + DecodeLine7Bit(Copy(Worker, 1, J+1));
     Worker := Copy(Worker, J+2, Length(Worker));
   end;
 end;
end;

function DecodeString (const SourceCharset, DestCharSet, Source: string): string;
var
 Worker: string;
begin
 Result := Source;
 if SameText(DestCharSet, "windows-1251") then
 begin
   // Для Windows-1251 ничего не делаем
   if SameText(SourceCharset, "windows-1251") or (SourceCharset = "") then
   begin
     //Do nothing
   end
   // Для ISO-8859-1 ничего не делаем
   else if SameText(SourceCharset, "ISO-8859-1") then
   begin
     //Do nothing
   end
   // Для utf-8
   else if SameText(SourceCharset, "utf-8") then
   begin
     Result := Utf8ToAnsi(Result);
   end
   // Для koi8-r пытаемся перевести в Windows-1251
   else if SameText(SourceCharset, "koi8-r") then
     Result := Koi_WinConvert(Result)
   // Для koi8-u пытаемся перевести в Windows-1251
   else if SameText(SourceCharset, "koi8-u") then
     Result := Koi8u_WinConvert(Result)
   else if Assigned(CharsetDecoder) then
   begin
     Worker := CharsetDecoder(SourceCharset, DestCharSet, Result);
     if (Length(Worker) > 0) or (Length(Result) = 0)  then
       Result := Worker
     else
       raise Exception.CreateFmt("Unknown source encoding %s", [SourceCharset]);
   end
   else
     raise Exception.CreateFmt("Unknown source encoding %s", [SourceCharset]);
 end
 else
   if Assigned(CharsetDecoder) then
   begin
     Worker := CharsetDecoder(SourceCharset, DestCharSet, Result);
     if (Length(Worker) > 0) or (Length(Result) = 0)  then
       Result := Worker
     else
       raise Exception.CreateFmt("Unknown source encoding %s", [SourceCharset]);
   end;
end;

// Decode an encoded field e.g. =?iso-8859-1?x?xxxxxx=?=

//Шевченко. FIX FIX FIX
// Боремся с кодировкой имен файлов для русских имен
// Полагаем, что если указана кодировка Windows-1251, то после перекодировки
// из base64 или Quoted-Printable у нас уже хорошее русское имя.
// Если указана кодировка KOI-8, то русское имя у нас неправильное
// и его надо преобразовать

function DecodeLine7Bit(Texto: String): String;
var
 Buffer: PChar;
 Encoding: Char;
 Size: Integer;
 nPos0: Integer;
 nPos1: Integer;
 nPos2: Integer;
 nPos3: Integer;
 nPosEndCharset: Integer;
 Found: Boolean;
 Charset: string;
begin
 Result := TrimSpace(Texto);
 repeat
   Charset := "";
   nPos0 := Pos("=?", Result);
   Found := False;
   if nPos0 > 0 then
   begin
     nPosEndCharSet := Pos("?", Copy(Result, nPos0+2, Length(Result)));
     if nPosEndCharset > 0 then
       Charset := Copy(Result, nPos0+2, nPosEndCharset-nPos0);
     nPos1 := Pos("?", Copy(Result, nPos0+2, Length(Result)))+nPos0+1;
     nPos2 := Pos("?=", Copy(Result, nPos1+1, Length(Result)))+nPos1;
     nPos3 := Pos("?", Copy(Result, nPos2+1, Length(Result)))+nPos2;
     if nPos3 > nPos2 then
       if Length(Result) > nPos3 then
         if Result[nPos3+1] = "=" then
           nPos2 := nPos3;
     if (nPos1 > nPos0) and (nPos2 > nPos1) then
     begin
       Texto := Copy(Result, nPos1+1, nPos2-nPos1-1);
       if (Length(Texto) >= 2) and (Texto[2] = "?") and (UpCase(Texto[1]) in ["B", "Q", "U"]) then
         Encoding := UpCase(Texto[1])
       else
         Encoding := "Q";
       Texto := Copy(Texto, 3, Length(Texto)-2);
       case Encoding of
       "B":
         begin
           GetMem(Buffer, Length(Texto));
           Size := DecodeLineBASE64(Texto, Buffer);
           Buffer[Size] := #0;
           Texto := String(Buffer);
         end;
       "Q":
         begin
           while Pos("_", Texto) > 0 do
             Texto[Pos("_", Texto)] := #32;
           Texto := DecodeQuotedPrintable(Texto);
         end;
       "U":
         begin
           GetMem(Buffer, Length(Texto));
           Size := DecodeLineUUCODE(Texto, Buffer);
           Buffer[Size] := #0;
           Texto := String(Buffer);
         end;
       end;
       Result := Copy(Result, 1, nPos0-1)+Texto+Copy(Result,nPos2+2,Length(Result));
       Found := True;
       //
       Result := DecodeString(CharSet, DefaultDecodeCharset, Result);
     end;
   end;
 until not Found;
end;

---

← →
istok20 ©   (2009-11-25 14:26) [3]

ой, боольшое спасибо!

---

← →
istok20 ©   (2009-11-25 15:08) [4]

не нашел реализации DefaultDecodeCharset

может, проще будет скинуть Mail2000.pas на email  (alex_for_chat@mail.ru)  ?

спасибо!

---

← →
Игорь Шевченко ©   (2009-11-25 15:23) [5]

> проще будет скинуть Mail2000.pas на email  


Нет, не проще. Там изменений больше и часть из них является коммерческим секретом.

type
 TCharsetDecoder = function (const SourceCharSet, DestCharSet,
   Source: string): string;
var
 DefaultDecodeCharset: string;
 CharsetDecoder: TCharsetDecoder;

type
 TConvertChars = array [ #128..#255] of char;

const
 Win_KoiChars: TConvertChars = (
 #128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#060,#139,#140,#141,#142,#143,
 #144,#145,#146,#147,#148,#169,#150,#151,#152,#153,#154,#062,#176,#157,#183,#159,
 #160,#246,#247,#074,#164,#231,#166,#167,#179,#169,#180,#060,#172,#173,#174,#183,
 #156,#177,#073,#105,#199,#181,#182,#158,#163,#191,#164,#062,#106,#189,#190,#167,
 #225,#226,#247,#231,#228,#229,#246,#250,#233,#234,#235,#236,#237,#238,#239,#240,
 #242,#243,#244,#245,#230,#232,#227,#254,#251,#253,#154,#249,#248,#252,#224,#241,
 #193,#194,#215,#199,#196,#197,#214,#218,#201,#202,#203,#204,#205,#206,#207,#208,
 #210,#211,#212,#213,#198,#200,#195,#222,#219,#221,#223,#217,#216,#220,#192,#209) ;

 Koi_WinChars: TConvertChars = (
 #128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#138,#139,#140,#141,#142,#143,
 #144,#145,#146,#147,#148,#149,#150,#151,#152,#153,#218,#155,#176,#157,#183,#159,
 #160,#161,#162,#184,#186,#165,#166,#191,#168,#169,#170,#171,#172,#173,#174,#175,
 #156,#177,#178,#168,#170,#181,#182,#175,#184,#185,#186,#187,#188,#189,#190,#185,
 #254,#224,#225,#246,#228,#229,#244,#227,#245,#232,#233,#234,#235,#236,#237,#238,
 #239,#255,#240,#241,#242,#243,#230,#226,#252,#251,#231,#248,#253,#249,#247,#250,
 #222,#192,#193,#214,#196,#197,#212,#195,#213,#200,#201,#202,#203,#204,#205,#206,
 #207,#223,#208,#209,#210,#211,#198,#194,#220,#219,#199,#216,#221,#217,#215,#218) ;

 koi8u_Winchars: TConvertChars = (
 #128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#138,#139,#140,#141,#142,#143,
#144,#145,#146,#147,#148,#149,#150,#151,#152,#153,#154,#155,#156,#157,#158,#159,
#160,#161,#162,"ё" ,"є" ,#165,"_" ,"ї" ,#168,#169,#170,#171,#172,#173,#174,#175,
#176,#177,#178,"Ё" ,"Є" ,#181,"_" ,"Ї" ,#184,#185,#186,#187,#188,#189,#190,#191,
"ю" ,"а" ,"б" ,"ц" ,"д" ,"е" ,"ф" ,"г" ,"х" ,"и" ,"й" ,"к" ,"л" ,"м" ,"н" ,"о" ,
"п" ,"я" ,"р" ,"с" ,"т" ,"у" ,"ж" ,"в" ,"ь" ,"ы" ,"з" ,"ш" ,"э" ,"щ" ,"ч" ,"ъ" ,
"Ю" ,"А" ,"Б" ,"Ц" ,"Д" ,"Е" ,"Ф" ,"Г" ,"Х" ,"И" ,"Й" ,"К" ,"Л" ,"М" ,"Н" ,"О" ,
"П" ,"Я" ,"Р" ,"С" ,"Т" ,"У" ,"Ж" ,"В" ,"Ь" ,"Ы" ,"З" ,"Ш" ,"Э" ,"Щ" ,"Ч" ,"Ъ"
 );

 iso88595_winchars: TConvertChars = (
 #128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#138,#139,#140,#141,#142,#143,
#144,#145,#146,#147,#148,#149,#150,#151,#152,#153,#154,#155,#156,#157,#158,#159,
#160,"Ё" ,#162,#163,"Є" ,#165,"_" ,"Ї" ,#168,#169,#170,#171,#172,#173,#174,#175,
"А" ,"Б" ,"В" ,"Г" ,"Д" ,"Е" ,"Ж" ,"З" ,"И" ,"Й" ,"К" ,"Л" ,"М" ,"Н" ,"О" ,"П" ,
"Р" ,"С" ,"Т" ,"У" ,"Ф" ,"Х" ,"Ц" ,"Ч" ,"Ш" ,"Щ" ,"Ъ" ,"Ы" ,"Ь" ,"Э" ,"Ю" ,"Я" ,
"а" ,"б" ,"в" ,"г" ,"д" ,"е" ,"ж" ,"з" ,"и" ,"й" ,"к" ,"л" ,"м" ,"н" ,"о" ,"п" ,
"р" ,"с" ,"т" ,"у" ,"ф" ,"х" ,"ц" ,"ч" ,"ш" ,"щ" ,"ъ" ,"ы" ,"ь" ,"э" ,"ю" ,"я" ,
#240,"ё" ,#242,#243,"є" ,#245,"_" ,"ї" ,#248,#249,#250,#251,#252,#253,#254,#255
);

function Win_KoiConvert(const St: string): string;
var
 i: integer;
begin
 Result:=St;
 for i:=1 to Length(St) do
   if St[i]>#127 then
     Result[i]:=Win_KoiChars[St[i]];
end;

function Koi_WinConvert(const St: string): string;
var
 i: integer;
begin
 Result:=St;
 for i:=1 to Length(St) do
   if St[i]>#127 then
     Result[i]:=Koi_WinChars[St[i]];
end;

function Koi8u_WinConvert(const St: string): string;
var
 i: integer;
begin
 Result:=St;
 for i:=1 to Length(St) do
   if St[i]>#127 then
     Result[i]:=koi8u_Winchars[St[i]];
end;

function DecodeQuotedPrintable(const Texto: string): string;
var
 P, Q: PChar;
 B: Byte;
begin
 SetLength(Result, Length(Texto));
 P := PChar(Texto);
 Q := PChar(Result);
 if (P^ = #13) and ((P + 1)^ = #10) then
   Inc(P, 2); // Bugfix for incorrect detection of the body beginning
 while P^ <> #0 do
 begin
   if P^ = "=" then
   begin
     Inc(P);
     if P^ = #13 then
     begin
       Inc(P);
       if P^ = #10 then
         Inc(P);
     end
     else if P^ = #10 then
     begin
       Inc(P);
       if P^ = #13 then
         Inc(P);
     end
     else if (P^ in ["0".."9", "A".."F"]) and ((P + 1)^ in ["0".."9", "A".."F"]) then
     begin
       if (P^ >= "0") and (P^ <= "9") then
         B := (Ord(P^) - Ord("0")) * 16
       else
         B := (Ord(P^) - Ord("A") + 10) * 16;
       if ((P + 1)^ >= "0") and ((P + 1)^ <= "9") then
         B := B + (Ord((P + 1)^) - Ord("0"))
       else
         B := B + (Ord((P + 1)^) - Ord("A") + 10);
       Inc(P, 2);
       Q^ := Chr(B);
       Inc(Q);
     end;
   end
   else
   begin
     Q^ := P^;
     Inc(P);
     Inc(Q);
   end
 end;
 SetLength(Result, Q - PChar(Result));
end;



---

← →
Игорь Шевченко ©   (2009-11-25 15:24) [6]

initialization
 DefaultDecodeCharset := "windows-1251";

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2011.07.10;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.002 c