indy中IdPOP3接收邮件标题和内容乱码问题

Question

我在接收邮件的时候，发现标题怎么是乱码，怎么才能解码成正常格式？
我写了EncodeBase64函数也不行！谢谢！

Answer 1

我用的邮件解码函数
function CheckTxt(const src: string): string;
var
  i,pos1,pos2,pos3:integer;
  post:string;
  srclist:TStringList;  function Decoder(const s:string):string;
  var
    s1,s2,s3: integer;
    t,v: string;
    Encoding: char;
    hex,step: integer;
    a1: array[1..4] of byte;
    b1: array[1..3] of byte;
    j:  integer;
    byte_ptr,real_bytes: integer;
    tempedit:TEdit;
  begin
    s1:=Pos('=?',s);
    s2:= 1 ;
    hex:= 0 ;
    if s1>0 then
       for s2:=Length(s)-1 downto 1 do
         if Copy(s,s2,2)='?=' then Break;
    if (s1=0) or (s2=1) then
       begin
         Result:=s;
         Exit;
       end;
    t:=Copy(s,s1+2,s2-2-s1);
    s3:=Pos('?',t);
    Delete(t,1,s3);
    if(t='')then
      begin
        Result:= s;
        Exit ;
      end ;
    Encoding:=t[1];
    Delete(t,1,2);
    v:='';
    step:=0;
    case Encoding of
     'Q':
      while t<>'' do
        begin
          case step of
            0:
             begin
               case t[1] of
                 '_': v:=v+' ';
                 '=': step:=1;
               else v:=v+t[1];
               end;
             end;
          1:
            begin
              if t[1]<='9' then hex:=(Ord(t[1])-Ord('0'))*16
              else hex:=(Ord(t[1])-55)*16;
              step:=2;
            end;
          2:
            begin
              if t[1]<='9' then hex:=hex+(Ord(t[1])-Ord('0'))
              else hex:=hex+Ord(t[1])-55;
              v:=v+Chr(hex);
              step:=0;
            end;
          end;
          Delete(t,1,1);
        end;
     'B':
      begin
        byte_ptr:=0;
        for j:=1 to Length(t) do
          begin
            Inc(byte_ptr);
            case t[j] of
              'A'..'Z': a1[byte_ptr]:=Ord(t[j])-65;
              'a'..'z': a1[byte_ptr]:=Ord(t[j])-71;
              '0'..'9': a1[byte_ptr]:=Ord(t[j])+4;
              '+': a1[byte_ptr]:=62;
              '/': a1[byte_ptr]:=63;
              '=': a1[byte_ptr]:=64;
            end;
            if byte_ptr=4 then
               begin
                 byte_ptr:=0;
                 real_bytes:=3;
                 if a1[1]=64 then real_bytes:=0;
                 if a1[3]=64 then
                    begin
                      a1[3]:=0;
                      a1[4]:=0;
                      real_bytes:=1;
                    end;
                 if a1[4]=64 then
                    begin
                      a1[4]:=0;
                      real_bytes:=2;
                    end;
                 b1[1]:=a1[1]*4+(a1[2] div 16);
                 b1[2]:=(a1[2] mod 16)*16+(a1[3]div 4);
                 b1[3]:=(a1[3] mod 4)*64 +a1[4];
                 if (real_bytes>0) then
                    v:= v + chr(b1[1]) ;
                 if (real_bytes>1) then
                    v:= v + chr(b1[2]) ;
                 if (real_bytes>2) then
                    v:= v + chr(b1[3]) ;
               end;
          end;
      end;
    end;
    Result:=Copy(s,1,s1-1)+v+Copy(s,s2+2,999);    tempedit:=TEdit.Create(nil);
    try
      tempedit.Width:=0;
      tempedit.Height:=0;
      tempedit.Visible:=True;
      tempedit.Text:=Result;
      Result:=tempedit.Text;
    finally
      FreeAndNil(tempedit);
    end;
    if Pos('***SPAM***',Result)>0 then
       result:=copy(result,pos('-',result)+1,length(result)-pos('-',result));
  end;
begin
  pos1:=Pos('=?',src);
  pos2:= 1 ;
  if pos1>0 then
     for pos2:=Length(src)-1 downto 1 do
       if Copy(src,pos2,2)='?=' then Break;
  if (pos1=0) or (pos2=1) then
     begin
       Result:=src;
       Exit;
     end;  post:=Copy(src,pos1+2,pos2-2-pos1);
  pos3:=Pos('?',post);
  Delete(post,1,pos3);
  if(post='')then
    begin
      Result:=src;
      Exit ;
    end ;  srclist:=TStringList.Create;
  try
    srclist.Clear;
    StrtoStrlist(' ',src,srclist);
    Result:='';
    for i:=0 to srclist.Count-1 do
      begin
        post:=srclist.Strings[i];
        Result:=Result+Decoder(post);
      end;
  finally
    srclist.Free;
  end;
end;

Answer 2

procedure StrtoStrlist(Sign: string; Str: string; var Strlist: TStringList);
var
  temp: string;
begin
  Strlist.Text:='';
  while pos(Sign, str)> 0 do
    begin
      temp:= copy(Str,1, pos(Sign, Str)-1);
      Delete(str, 1, pos(Sign, str)+length(Sign)-1);
      Strlist.Add(temp);
    end;
  if Length(Str)> 0 then
    Strlist.Add(Str);
end;

Answer 3

我也遇到这样的情况：
  我写了个程序从pop3服务器上取邮件，英文标题的都没有问题，但汉字标题的取下来都是乱码，比如标题是：“$$\结构化文档.dot”，取下来的结果是“=?gb2312?B?JCRcveG5ubuvzsS1tS5kb3Q=?=”。但用foxmail等工具取下来都是正确的，请问高手应该怎么解码？
  用的IdPop3的Retrieve函数取到IdMessage中。 

Answer 4

大富翁上提问收到的答案，试过了，成功！
function TGetEmailInfo.GetTitle(const Value: string): string;
var
  iPos: integer;
begin
  Result := Value;
  if Copy(Value, 1, 2) <> '=?' then exit;//'?B?'前面的都要去掉
  iPos := Pos('?B?', Value);
  Inc(iPos, 3);//最后的'?='也要去掉
  Result := Copy(Value, iPos, Length(Value) - iPos - 1);
  Result := Base64ToString(Result);
end;{============================
*函数名：Base64ToString*
*作者：苏彬*
*时间：2005.11.29 15.25 *
*说明：实现字符转换*
============================}
function TGetEmailInfo.Base64ToString(const Value: string): string;
var
  x, y, n, l: Integer;
  d: array[0..3] of Byte;
  Table : string;
begin
  Table :=
    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
    +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
    +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
    +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
    +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
    +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;  SetLength(Result, Length(Value));
  x := 1;
  l := 1;
  while x < Length(Value) do
  begin
    for n := 0 to 3 do
    begin
      if x > Length(Value) then
        d[n] := 64
      else
      begin
        y := Ord(Value[x]);
        if (y < 33) or (y > 127) then
          d[n] := 64
        else
          d[n] := Ord(Table[y - 32]);
      end;
      Inc(x);
    end;
    Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
    Inc(l);
    if d[2] <> 64 then
    begin
      Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
      Inc(l);
      if d[3] <> 64 then
      begin
        Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
        Inc(l);
      end;
    end;
  end;
  Dec(l);
  SetLength(Result, l);end;{============================
*函数名：StringToBase64*
*作者：苏彬*
*时间：2005.11.29 15.25 *
*说明：实现字符转换*
============================}
function TGetEmailInfo.StringToBase64(const Value: string): string;
var
  c: Byte;
  n, l: Integer;
  Count: Integer;
  DOut: array[0..3] of Byte;
  Table : string;
begin
  Table :=
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';  setlength(Result, ((Length(Value) + 2) div 3) * 4);
  l := 1;
  Count := 1;
  while Count <= Length(Value) do
  begin
    c := Ord(Value[Count]);
    Inc(Count);
    DOut[0] := (c and $FC) shr 2;
    DOut[1] := (c and $03) shl 4;
    if Count <= Length(Value) then
    begin
      c := Ord(Value[Count]);
      Inc(Count);
      DOut[1] := DOut[1] + (c and $F0) shr 4;
      DOut[2] := (c and $0F) shl 2;
      if Count <= Length(Value) then
      begin
        c := Ord(Value[Count]);
        Inc(Count);
        DOut[2] := DOut[2] + (c and $C0) shr 6;
        DOut[3] := (c and $3F);
      end
      else
      begin
        DOut[3] := $40;
      end;
    end
    else
    begin
      DOut[2] := $40;
      DOut[3] := $40;
    end;
    for n := 0 to 3 do
    begin
      Result[l] := Table[DOut[n] + 1];
      Inc(l);
    end;
  endend;  

Answer 5

呵呵，有些邮件并不只是用base64来编码的，有些还是分段来编码的，用我那个解码函数就没错啦，经过实际考验的

Answer 6

to lzf1010(深宇)：  能大略讲一下这里头的原理吗？对这方面知识了解不多啊，谢谢！

Answer 7

to lzf1010(深宇)：去网上查了相关的知识知道邮件中的编码主要由以下这么多种：邮件中的编码：
         由于历史原因，E-mail只允许传送字符，而且是7位字符的E-mail网关时，毫无疑问地会出现问题。这些7位的E-mail网关把汉字内码第八位的1全变成了0，于是形成了一些不可读的文字，进形成了乱码。于是为了便于网络间的通讯，就需要对这些高8位的字符进行编码处理。因此，一个健全的邮件系统就要尽可能多的解出各种编码后的文件。目前比较流行的编码方式有：
         1。BASE64编码： 原理是将三个连续的字符（共8*3=24位），平均分成四段，形成四个新的字符，如果最后不够24位，则补零填充。对编码为000000(二进制)的字符用“=“表示，
         
         BASE64编码的判断较复杂，但它也有一个明显的特征，由于BASE64是通过“=”来实现对齐，因而假如你在一个排列非常规则（每行字符数相同，一般为63个），没有任何可识别内容的编码，且若最后一行未满并有一至三个“=”之类字符时即可确认它是BASE64编码；特别的一点是，“.”不属于BASE64编码后的字符，也就是说一个用BASE64正确编码后的字符，也就是说一个用BASE64下确编码后的信件将决不可能在信体部分有“.”出现，否则就是误码。
         
         2.QUOTED-PRINTABLE编码：这种编码是将7FH以上的ASCII字符（即汉字）用它对应的文字串表达出来，即如一个ASCII编码为0ABH的字符，将用=AB来代表它。它的典型特征是文本中有大量的这种用“=”来构成的符号，即=XX=XX=XX等，只要有这种符号，即可确认。
         
         以上的两种编码是最流行的两种。还存在的其他编码有：
         3. UUENCODE编码：一些较老的邮件服务器上这种编码使用较多，目前的Ftp Mail等服务器也是使用此编码（如MrCool下载的文件等）。UUENCODE编码的主要特征是编码首行由BeginXXX开始，结束一行为End，且通常其中的每一行开始均为“M”，只要有了以上几个特征，就能确定是UUENCODE编码。
         
         4. HZ编码：这是国外的中国人发明的一种编者按码方式，它把汉字的最高位去掉，然后用一特定符号来表明哪些编码经过了处理。这种编码也极易识别：在信的内容中通常会有这样的一组符号：“~{”和“}~”，其中的内容是不可读的（乱码），而在这一组分界符外的都是可读的英文字符。
         5. Bit7码：这并非一种编码，而是网络传输误码。它是由于网络不支持8位传输引起的，通常在局域网的接入方案中较为常见。它跟HZ编码类似，只是没有标明哪些内容是截去了最高位的。识别办法跟随HZ类似，如果一段信件中英文部分是正常的话，即为此种误码。这种误码无法解码，只能要求对方用7位编码（如以上的各种编码）重新发送。
         
         6.Bit8码：也就是带有高8为的编码，它对邮件服务器只是起到声明的作用。
你的程序实现了头两种编码的解码，对后面的编码没有对应的解码。Indy系列中应该有完整的解决方案吧，在哪里呢？

Answer 8

你列出来的编码格式indy基本上都有控件对应，不过我用我那个函数来处理解码的问题，使用了2年多了，目前还暂时没有遇到解不了码的，也就是说暂时还没有遇到其它编码格式的邮件。
indy完整的解决方案应该没有，我用indy自带的控件来解码总是出现这样或者那样的问题。
我这个函数也是改良自delphibbs里一个最流行的一个解码函数，你看我那个函数名就知道是改良自哪个解码函数了。原来的那个解码函数不能处理分段编码的问题，因为在实际中有些邮件很变态，对邮件头进行分段编码！

Answer 9

收到了，谢谢lzf1010(深宇) 啊！现在先用你的函数吧，等把手头的程序完成再仔细看看能不能把你的代码扩展一下，写一个比较完善的解码程序吧。