| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

чтение писем из eml формата.. [D7, WinXP]

istok20 ©   (2009-11-25 13:34:00) 

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

---

Игорь Шевченко   (2009-11-25 15:24:00) [1]

initialization
 DefaultDecodeCharset := 'windows-1251';

---

Игорь Шевченко   (2009-11-25 15:23:00) [2]

> проще будет скинуть 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;



---

istok20   (2009-11-25 15:08:00) [3]

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

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

спасибо!

---

istok20   (2009-11-25 14:26:00) [4]

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

---

Игорь Шевченко   (2009-11-25 14:12:00) [5]

Где-то так:

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

---

Игорь Шевченко   (2009-11-25 14:07:00) [6]

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


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

---

Наверх