关于TNMPOP3 中的汉字编码问题,在NMPOP31.MailMessage.Body.Text中无法显示汉字???

Question

真是难兄难弟
以下是我接收到的邮件主题:
=?ISO-8859-1?Q?Fw: Fw: =B4=FA=C0=ED=C8=ED=BC=FE?=
=?GB2312?Q?=B4=BA=BD=DA?=
都是乱码.但把它们变成汉字也很简单.首先,我们要找到我们需要的数据.
举例来说:第二个主题我们需要的是:B4=BA=BD=DA
这是什么呢?其中B4就是第一个汉字的高4位(二进制就是:10110100,十进制180)
BA就是第一个汉字的低4位(二进制10111010,十进制186)
接下来只需要chr(180)+chr(186)就等于我们的汉字:春
同样BDDA就是我们的汉字:节.

Answer 1

这是quoted-printable编码，很多E-mail Client都用的。它把一个汉字拆成两个字节，中间用等号隔开。要解码很简单，把等号去掉，把前后两个字节合并成一个汉字即可。

Answer 2

找BASE64 quoted-printable编码的資料....

Answer 3

现在什么免费邮箱还有SMTP啊，为什么我发送邮件都发不了啊，用Foxmail也发不了

Answer 4

我告诉你吧，我刚用过
charset:='gb2312'

Answer 5

sinocat(sinoherolast:我知道是编码问题,关键是要设谁的charset呢?

Answer 6

这儿有个笨办法,我试出来的，
主题用CheckTxt解码
正文用DecodeBase64解码，不过你的先找到正文中经过编码的部分
函数在下面：
const
  BaseTable:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
......
function  FindInTable(CSource:char):integer; 
begin  
    result:=Pos(string(CSource),BaseTable)-1;  
end; 
 
function  DecodeBase64(Source:string):string; 
var  
    SrcLen,Times,i:integer;  
    x1,x2,x3,x4,xt:byte;  
begin  
    result:='';  
    SrcLen:=Length(Source);  
    Times:=SrcLen  div  4;  
    for  i:=0  to  Times-1  do  
    begin  
        x1:=FindInTable(Source[1+i*4]);  
        x2:=FindInTable(Source[2+i*4]);  
        x3:=FindInTable(Source[3+i*4]);  
        x4:=FindInTable(Source[4+i*4]);  
        x1:=x1  shl  2;  
        xt:=x2  shr  4;  
        x1:=x1  or  xt;  
        x2:=x2  shl  4;  
        result:=result+chr(x1);  
        if  x3=  64  then  break;  
        xt:=x3  shr  2;    
        x2:=x2  or  xt;  
        x3:=x3  shl  6;  
        result:=result+chr(x2);  
        if  x4=64  then  break;  
        x3:=x3  or  x4;  
        result:=result+chr(x3);  
    end;  
end;  
//Base64±àÂë·½·¨  
function  EncodeBase64(Source:string):string;  
var    
    Times,LenSrc,i:integer;    
    x1,x2,x3,x4:char;    
    xt:byte;  
begin    
    result:='';    
    LenSrc:=length(Source);    
    if  LenSrc  mod  3  =0  then  Times:=LenSrc  div  3    
    else  Times:=LenSrc  div  3  +  1;    
    for  i:=0  to  times-1  do    
    begin    
        if  LenSrc  >=  (3+i*3)  then  
        begin    
            x1:=BaseTable[(ord(Source[1+i*3])  shr  2)+1];  
            xt:=(ord(Source[1+i*3])  shl  4)  and  48;    
            xt:=xt  or  (ord(Source[2+i*3])  shr  4);    
            x2:=BaseTable[xt+1];    
            xt:=(Ord(Source[2+i*3])  shl  2)  and  60;    
            xt:=xt  or  (ord(Source[3+i*3])  shr  6);    
            x3:=BaseTable[xt+1];    
            xt:=(ord(Source[3+i*3])  and  63);    
            x4:=BaseTable[xt+1];    
        end    
        else  if  LenSrc>=(2+i*3)  then    
        begin    
            x1:=BaseTable[(ord(Source[1+i*3])  shr  2)+1];    
            xt:=(ord(Source[1+i*3])  shl  4)  and  48;  
            xt:=xt  or  (ord(Source[2+i*3])  shr  4);    
            x2:=BaseTable[xt+1];    
            xt:=(ord(Source[2+i*3])  shl  2)  and  60;    
            x3:=BaseTable[xt+1];    
            x4:='=';    
        end  else    
        begin    
            x1:=BaseTable[(ord(Source[1+i*3])  shr  2)+1];    
            xt:=(ord(Source[1+i*3])  shl  4)  and  48;    
            x2:=BaseTable[xt+1];    
            x3:='=';    
            x4:='=';    
        end;    
        result:=result+x1+x2+x3+x4;    
    end;    
end;function CheckTxt(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;
begin
  s1:=Pos('=?',s);
  s2:= 1 ;
  hex:= 0 ;
  if s1>0 then
  begin
    for s2:=Length(s)-1 downto 1 do
    begin
      if Copy(s,s2,2)='?=' then Break;
    end;
  end;
  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);
end;