邮件解码之一

(* //
  标题:邮件解码之一
  说明:Quoted Printable
  设计:Zswang
  日期:2002-02-19
  支持:wjhu111@21cn.com
  // *)
/// ////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