Показать сообщение отдельно
  #9  
Старый 08.07.2013, 07:05
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,015
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Цитата:
Сообщение от RobinStone
вот я получаю текст письма
Код:
Form1.TIdPOP.Retrieve(f,Form1.IdMessage2);
str:=  Form1.IdMessage2.Subject;

Боролся как-то с этим.
Для начала проверь у TIdMessage свойство автоматической декодировки (не помню как называется, мне не сильно помогло, так что забил). Что-то, может и автоматом декодирует.
Потом просто сделал себе функцию (меня интересовал только utf-8, но можно туда добавить кодировок) (Тапками за код не кидать, писалось давно, недавно только чуть-чуть правилось. Если есть желающие прикрутить различные кодировки, код отдается под GPL ):
Код:
unit EmlStrUtils;

interface

uses
  Windows, SysUtils, Classes, StrUtils;

function DecodeEmailString(S : String) : String;

implementation

uses
  IdCoder, IdCoder3to4, IdCoderMIME, IdCoderQuotedPrintable;

function Base64Decode(const EncodedText: string): String;
var
  Decoder: TIdDecoderMIME;
begin
  Result := EncodedText;
  Decoder := TIdDecoderMIME.Create(nil);
  try
    Result := Decoder.DecodeString(EncodedText);
  finally
    Decoder.Free;
  end;
end;

function QuotedPrintableDecode(const EncodedText: string): String;
var
  Decoder: TIdDecoderQuotedPrintable;
begin
  Result := EncodedText;
  Decoder := TIdDecoderQuotedPrintable.Create(nil);
  try
    Result := Decoder.DecodeString(EncodedText);
  finally
    Decoder.Free;
  end;
end;

function DecodeTocken(S : String) : String;
var
  SecondQuestIdx : Integer;
  ThirdQuestIdx : Integer;
  Txt : String;
begin
  // =?charset?encoding?encoded text?=
  // =?utf-8?B?<text>?=
  // =?utf-8?Q?=D0=A5=D0=B0=D0=B9=D0=B9_...=21=21=21=29_?=

  Result := S;
  If Pos('=?',S) = 1 Then
    Begin
      SecondQuestIdx := PosEx('?',S,3);
      ThirdQuestIdx := PosEx('?',S,SecondQuestIdx+1);
      Txt := Copy(S,ThirdQuestIdx+1,Length(S)-ThirdQuestIdx-2);

      Case S[SecondQuestIdx+1] Of
        'B', 'b' :
          Begin
            Result := Base64Decode(Txt);
            If CompareText('utf-8',Copy(S,3,SecondQuestIdx-1-2)) = 0
              Then Result := Utf8ToAnsi(Result);
          End;
        'Q', 'q' :
          Begin
            Result := QuotedPrintableDecode(Txt);
          End;
      End;
    End;
end;

procedure SplitTockens(S : String; var AList : TStringList);
var
  Idx1, Idx2, Idx3 : Integer;
begin
  While S <> '' Do
    Begin
      Idx1 := Pos('=?',S);
      If Idx1 = 0
        Then
          Begin
            AList.Add(S);
            S := '';
          End
        Else
          If Idx1 > 1
            Then
              Begin
                AList.Add(Copy(S,1,Idx1-1));
                S := Copy(S,Idx1,Length(S));
              End
            Else
              Begin
                Idx2 := PosEx('?',S,3);
                Idx3 := PosEx('?',S,Idx2+1);
                AList.Add(Copy(S,1,PosEx('?=',S,Idx3+1)+1));
                S := Copy(S,PosEx('?=',S,Idx3+1)+2,Length(S));
              End;
    End;
end;

function DecodeEmailString(S : String) : String;
var
  I : Integer;
  AList : TStringList;
begin
  // =?charset?encoding?encoded text?=
  // =?utf-8?B?<text>?=
  // =?utf-8?Q?=D0=A5=D0=B0=D0=B9=D0=B9_...=21=21=21=29_?=

  Result := S;
  If Pos('=?',S) <> 0 Then
    Begin
      Result := '';
      AList := TStringList.Create;
      Try
        // Split tockens
        SplitTockens(S,AList);

        // Decode
        For I := 0 To AList.Count-1 Do
          AList[i] := DecodeTocken(AList[i]);

        // Join result
        For I := 0 To AList.Count-1 Do
          Result := Result + AList[i];
      Finally
        AList.Free;
      End;
    End;
end;

end.

ЗЫ. Да, Indy у меня не родная Дельфевая, а более новая, скаченная с сайта индей...
Ответить с цитированием