我用TNMPOP3接收邮件时,

Question

引自 http://www.delphibbs.com/delphibbs/dispq.asp?lid=211348这主要是由于Outlook将邮件信息进行了编码的缘故，本人去年刚刚做过此类程序，将两种反编码提供给你，估计可解决一些问题。
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;

Answer 1

将memo1的IME(input method editor)改为imechinese模式,再试试.
我听说这是因为SMTP在传输中,不会对邮件的中文编码自动解码,需要自己手动解码,
如果上面还不能解决的话,还有一种方法,就是先将收到的编码以二进制形式写入文件,再以ascii码的形式将其读出,就可以解决了procedure Tfrm_Get_Mail.NMPOP31Connect(Sender: TObject);
var
  S: String;
  M: Integer;
begin
  frm_Get_Mail.Caption:='已经连接到 '+ADOQuery1['Mail_UserName']+' 在 '+ADOQuery1['Mail_POP3_Host']+'上';
  if NMPOP31.MailCount > 0 then
  begin
    Label1.Caption:='有 '+IntToStr(NMPOP31.MailCount)+' 封信在你的信箱里。';
    if InputQuery('输入一个编号', '接收哪条? (1-'+IntToStr(NMPOP31.MailCount)+')', S) then
    begin
      M := StrToIntDef(S, -1);
      If (M < 0) or (M > NMPOP31.MailCount) then
        ShowMessage('无效的编号')
      else
        ProgressBar1.Max:=100;
        ProgressBar1.Min:=0;
          NMPOP31.GetMailMessage(M);
    end;
    end
  else
    Label1.Caption:='没有邮件.';
end;procedure Tfrm_Get_Mail.NMPOP31DecodeStart(var FileName: String);
var
  S: String;
begin
  S := FileName;
  if InputQuery('保存附件', '文件名?', S) then
    FileName := S;
end;procedure Tfrm_Get_Mail.NMPOP31RetrieveEnd(Sender: TObject);
begin
Memo1.Text := NMPOP31.MailMessage.Body.Text;
  Memo1.lines.add( NMPOP31.MailMessage.Subject);
  Memo1.Lines.Add(NMPOP31.MailMessage.From);
  Label1.Caption:='接收完毕';
end;

Answer 2

to lastlove():
你的 CheckTxt函数是如何使用的，是把Memo中的内容用CheckTxt格式化一下，还是...?

Answer 3

outlook用了一个base64的的编码方式你只要用函数来解码就可以了
代码如下
const
  //BaseTable&Icirc;&ordf;BASE64&Acirc;&euml;±í
  BaseTable:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';function TMailClient.FindInTable(CSource:char):integer;
begin
  result:=Pos(string(CSource),BaseTable)-1;
end;function TMailClient.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±à&Acirc;&euml;·&frac12;·¨
function TMailClient.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;

Answer 4

用户在OutLook里是使用Unicode(utf-8) 字体是Times New Roman, 这样的话，用Base64这个解码函数使得邮件内容出现乱码！不知针对上述情况有什么好的解次方法?