怎么对所收到的EMail标题进行解码???

Question

怎么对所收到的EMail文件标题进行解码???
本人用的是D6,曾试过用Indy的那套控件进行解码,但
由于水平太差,没有成功,BASE64的解码程序本人已经
有了,但是也解不开.
不知道大家有没有好办法或方法??

Answer 1

转贴：(*//
标题:邮件解码之一
说明:Quoted Printable
设计:Zswang
日期:2002-02-19
支持:[email protected]
//*)///////Begin Source
function QuotedPrintableEncode(mSource: string): string;
var
  I, J: Integer;
begin
  Result := '';
  J := 0;
  for I := 1 to Length(mSource) do begin
    if mSource[I] in [#32..#127, #13, #10] - ['='] then begin
      Result := Result + mSource[I];
      Inc(J);
    end else begin
      Result := Result + '=' + IntToHex(Ord(mSource[I]), 2);
      Inc(J, 3);
    end;
    if mSource[I] in [#13, #10] then J := 0;
    if J >= 70 then begin
      Result := Result + #13#10;
      J := 0;
    end;
  end;
end; { QuotedPrintableEncode }function QuotedPrintableDecode(mCode: string): string;
var
  I, J, L: Integer;
begin
  Result := '';
  J := 0;
  mCode := AdjustLineBreaks(mCode);
  L := Length(mCode);
  I := 1;
  while I <= L do begin
    if mCode[I] = '=' then begin
      Result := Result + Chr(StrToIntDef('$' + Copy(mCode, I + 1, 2), 0));
      Inc(J, 3);
      Inc(I, 3);
    end else if mCode[I] in [#13, #10] then begin
      if J < 70 then Result := Result + mCode[I];
      if mCode[I] = #10 then J := 0;
      Inc(I);
    end else begin
      Result := Result + mCode[I];
      Inc(J);
      Inc(I);
    end;
  end;
end; { QuotedPrintableDecode }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.Text := QuotedPrintableEncode(Memo1.Text);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Text := QuotedPrintableDecode(Memo2.Text);
end;
///////End Demo
(*//
标题:邮件解码之二
说明:Base64
设计:Zswang
日期:2002-02-21
支持:[email protected]
//*)///////Begin Source
const
  cBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';function Base64Encode(mSource: string; mAddLine: Boolean = True): string;
var
  I, J: Integer;
  S: string;
begin
  Result := '';
  J := 0;
  for I := 0 to Length(mSource) div 3 - 1 do begin
    S := Copy(mSource, I * 3 + 1, 3);
    Result := Result + cBase64[Ord(S[1]) shr 2 + 1];
    Result := Result + cBase64[((Ord(S[1]) and $03) shl 4) + (Ord(S[2]) shr 4) + 1];
    Result := Result + cBase64[((Ord(S[2]) and $0F) shl 2) + (Ord(S[3]) shr 6) + 1];
    Result := Result + cBase64[Ord(S[3]) and $3F + 1];
    if mAddLine then begin
      Inc(J, 4);
      if J >= 76 then begin
        Result := Result + #13#10;
        J := 0;
      end;
    end;
  end;
  I := Length(mSource) div 3;
  S := Copy(mSource, I * 3 + 1, 3);
  case Length(S) of
    1: begin
      Result := Result + cBase64[Ord(S[1]) shr 2 + 1];
      Result := Result + cBase64[(Ord(S[1]) and $03) shl 4 + 1];
      Result := Result + cBase64[65];
      Result := Result + cBase64[65];
    end;
    2: begin
      Result := Result + cBase64[Ord(S[1]) shr 2 + 1];
      Result := Result + cBase64[((Ord(S[1]) and $03) shl 4) + (Ord(S[2]) shr 4) + 1];
      Result := Result + cBase64[(Ord(S[2]) and $0F) shl 2 + 1];
      Result := Result + cBase64[65];
    end;
  end;
end; { Base64Encode }function Base64Decode(mCode: string): string;
var
  I, L: Integer;
  S: string;
begin
  Result := '';
  L := Length(mCode);
  I := 1;
  while I <= L do begin
    if Pos(mCode[I], cBase64) > 0 then begin
      S := Copy(mCode, I, 4);
      if (Length(S) = 4) then begin
        Result := Result + Chr((Pos(S[1], cBase64) - 1) shl 2 +
          (Pos(S[2], cBase64) - 1) shr 4);
        if S[3] <> cBase64[65] then begin
          Result := Result + Chr(((Pos(S[2], cBase64) - 1) and $0F) shl 4 +
            (Pos(S[3], cBase64) - 1) shr 2);
          if S[4] <> cBase64[65] then
            Result := Result + Chr(((Pos(S[3], cBase64) - 1) and $03) shl 6 +
              (Pos(S[4], cBase64) - 1));
        end;
      end;
      Inc(I, 4);
    end else Inc(I);
  end;
end; { Base64Decode }
///////End Source///////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo2.Text := Base64Encode(Memo1.Text);
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Text := Base64Decode(Memo2.Text);
end;
///////End Demo

Answer 2

其实邮件的标题编码无非是同样的编码，只不过，还需要经过一下处理才能进行解码的。
Function QuotedPrintableEncode(mSource: String): String;
Var
  I, J: Integer;
Begin
  Result := '';
  J := 0;
  For I := 1 To Length(mSource) Do Begin
      If mSource[I] In [#32..#127, #13, #10] - ['='] Then Begin
          Result := Result + mSource[I];
          Inc(J);
        End Else Begin
          Result := Result + '=' + IntToHex(Ord(mSource[I]), 2);
          Inc(J, 3);
        End;
      If mSource[I] In [#13, #10] Then J := 0;
      If J >= 70 Then Begin
          Result := Result + #13#10;
          J := 0;
        End;
    End;
End; { QuotedPrintableEncode }Function QuotedPrintableDecode(mCode: String): String;
Var
  I, J, L: Integer;
Begin
  Result := '';
  J := 0;
  mCode := AdjustLineBreaks(mCode);
  L := Length(mCode);
  I := 1;
  While I <= L Do Begin
      If mCode[I] = '=' Then Begin
          Result := Result + Chr(StrToIntDef('$' + Copy(mCode, I + 1, 2), 0));
          Inc(J, 3);
          Inc(I, 3);
        End Else If mCode[I] In [#13, #10] Then Begin
          If J < 70 Then Result := Result + mCode[I];
          If mCode[I] = #10 Then J := 0;
          Inc(I);
        End Else Begin
          Result := Result + mCode[I];
          Inc(J);
          Inc(I);
        End;
    End;
End; { QuotedPrintableDecode }
Function Base64Encode(mSource: String; mAddLine: Boolean = True): String;
Var
  I, J: Integer;
  S: String;
Begin
  Result := '';
  J := 0;
  For I := 0 To Length(mSource) Div 3 - 1 Do Begin
      S := Copy(mSource, I * 3 + 1, 3);
      Result := Result + cBase64[Ord(S[1]) Shr 2 + 1];
      Result := Result + cBase64[((Ord(S[1]) And $03) Shl 4) + (Ord(S[2]) Shr 4) + 1];
      Result := Result + cBase64[((Ord(S[2]) And $0F) Shl 2) + (Ord(S[3]) Shr 6) + 1];
      Result := Result + cBase64[Ord(S[3]) And $3F + 1];
      If mAddLine Then Begin
          Inc(J, 4);
          If J >= 76 Then Begin
              Result := Result + #13#10;
              J := 0;
            End;
        End;
    End;
  I := Length(mSource) Div 3;
  S := Copy(mSource, I * 3 + 1, 3);
  Case Length(S) Of
    1: Begin
        Result := Result + cBase64[Ord(S[1]) Shr 2 + 1];
        Result := Result + cBase64[(Ord(S[1]) And $03) Shl 4 + 1];
        Result := Result + cBase64[65];
        Result := Result + cBase64[65];
      End;
    2: Begin
        Result := Result + cBase64[Ord(S[1]) Shr 2 + 1];
        Result := Result + cBase64[((Ord(S[1]) And $03) Shl 4) + (Ord(S[2]) Shr 4) + 1];
        Result := Result + cBase64[(Ord(S[2]) And $0F) Shl 2 + 1];
        Result := Result + cBase64[65];
      End;
  End;
End; { Base64Encode }Function Base64Decode(mCode: String): String;
Var
  I, L: Integer;
  S: String;
Begin
  Result := '';
  L := Length(mCode);
  I := 1;
  While I <= L Do Begin
      If Pos(mCode[I], cBase64) > 0 Then Begin
          S := Copy(mCode, I, 4);
          If (Length(S) = 4) Then Begin
              Result := Result + Chr((Pos(S[1], cBase64) - 1) Shl 2 +
                (Pos(S[2], cBase64) - 1) Shr 4);
              If S[3] <> cBase64[65] Then Begin
                  Result := Result + Chr(((Pos(S[2], cBase64) - 1) And $0F) Shl 4 +
                    (Pos(S[3], cBase64) - 1) Shr 2);
                  If S[4] <> cBase64[65] Then
                    Result := Result + Chr(((Pos(S[3], cBase64) - 1) And $03) Shl 6 +
                      (Pos(S[4], cBase64) - 1));
                End;
            End;
          Inc(I, 4);
        End Else Inc(I);
    End;
End; { Base64Decode }Function GetTitle(Const Value: String): String;
Var
  iPos: integer;
Begin
  Result := Value;
  If Copy(Value, 1, 2) <> '=?' Then
    Begin
      Result := Value;
      exit;
    End;
  //'?B?'前面的都要去掉
  iPos := Pos('?B?', Value);
  If iPos = 0 Then
    Begin
      iPos := Pos('?Q?', Value);
      If iPos = 0 Then
        Begin
          Result := Value;
          exit;
        End;
      Inc(iPos, 3);
  //最后的'?='也要去掉
      Result := Copy(Value, iPos, Length(Value) - iPos - 1);
      Result := QuotedPrintableDecode(Result);
    End
  Else
    Begin
      Inc(iPos, 3);
  //最后的'?='也要去掉
      Result := Copy(Value, iPos, Length(Value) - iPos - 1);
      Result := Base64Decode(Result);
    End;End;