[lmikle]

Есть такое дело. Indy не умеет расшифровывать такого вида кодировки автоматически. Вот я для себя писал такую штуку:

Код:

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.