idcoderheader.pas

Indy控件的使用源代码

    if AnsiSameText(HeaderCharSet, 'ISO-2022-JP') then   
      result := Decode2022JP(s)
    else
      Result := s;
  end
  else
    Result := Header;
end;
}
{ convert Shift_JIS to ISO-2022-JP (RFC 1468) }
function Decode2022JP(const S: string): string;
var
  T : string;
  I, L : integer;
  isK : Boolean;
  K1, K2 : byte;
  K3 : byte;
begin
  T := '';    {Do not Localize}
  isK := False;
  L := length(S);
  I := 1;
  while I <= L do
  begin
    if S[I] = #27 then
    begin
      Inc(I);
      if I+1 <= L then
      begin
        if Copy(S, I, 2) = '$B' then   {Do not Localize}
        begin
          isK := True;
        end
        else
        begin
          if Copy(S, I, 2) = '(B' then    {Do not Localize}
          begin
            isK := False; 
          end;
        end;
        Inc(I, 2);   { TODO -oTArisawa : Check RFC 1468}
      end;
    end
    else
    begin
      if isK then
      begin
        if I+1 <= L then
        begin
          K1 := byte(S[I]);
          K2 := byte(S[I + 1]);

          K3:= (K1 - 1) shr 1;
          if K1 < 95 then
            K3:= K3 + 113
          else
            K3 := K3 + 177;

          if (K1 mod 2) = 1 then
          begin
            if K2 < 96 Then
              K2 := K2 + 31
            else
              K2 := K2 + 32
          end
          else
            K2 := K2 + 126;

          T := T + char(K3) + char(k2);
          Inc(I,2);
        end
        else
          Inc(I); { invalid DBCS }
      end
      else
      begin
        T := T + S[I];
        Inc(I);
      end;
    end;
  end;
  Result := T;
end;

procedure InitializeISO(var TransferHeader: TTransfer; var HeaderEncoding: char;
  var CharSet: string);

begin
  TransferHeader := bit8;    { header part conversion type }
  HeaderEncoding := 'B';     { base64 / quoted-printable }    {Do not Localize}

  case GetSystemLocale of
    csGB2312: CharSet := 'GB2312'; {Do not Localize}
    csBig5: CharSet := 'Big5';    {Do not Localize}
    csIso2022jp:
      begin
        CharSet := 'ISO-2022-JP';  {Do not Localize}
        TransferHeader := iso2022jp { header needs conversion }
      end;
    csEUCKR: CharSet := 'EUC-KR';  {Do not Localize}
    else
      CharSet := 'ISO-8859-1';   {Do not Localize}
    HeaderEncoding := 'Q';    {Do not Localize}
  end;
end;

Procedure DecodeAddress(EMailAddr : TIdEmailAddressItem);
begin
  EMailAddr.Name := DecodeHeader(EMailAddr.Name);
end;

Procedure DecodeAddresses(AEMails : String; EMailAddr : TIdEmailAddressList);
var idx : Integer;
begin
  idx := 0;
  EMailAddr.EMailAddresses := AEMails;
  while idx < EMailAddr.Count do
  begin
    DecodeAddress(EMailAddr[idx]);
    inc(idx);
  end;
end;

function EncodeAddress(EmailAddr:TIdEMailAddressList; const HeaderEncoding: Char;
  TransferHeader: TTransfer; MimeCharSet: string): string;
var idx : Integer;
begin
  Result := '';      {Do not Localize}
  idx := 0;
  while ( idx < EmailAddr.Count ) do
  begin
    Result := Result + ', ' + EncodeAddressItem(EMailAddr[idx], HeaderEncoding, TransferHeader, MimeCharSet);  {Do not Localize}
    Inc ( idx );
  end; // while ( idx < EncodeAddress.Count ) do
  {Remove the first comma and the following space ', ' }    {Do not Localize}
  System.Delete ( Result, 1, 2 );
end;

{ convert Shift_JIS to ISO-2022-JP (RFC 1468) }
function Encode2022JP(const S: string): string;
const
  desig_asc = #27'(B';  {Do not Localize}
  desig_jis = #27'$B';   {Do not Localize}
var
  T: string;
  I, L: Integer;
  isK: Boolean;
  K1: Byte;
  K2, K3: Word;
begin
  T := '';    {Do not Localize}
  isK := False;
  L := Length(S);
  I := 1;
  while I <= L do
  begin
    if S[I] < #128 then  {Do not Localize}
    begin
      if isK then
      begin
        T := T + desig_asc;
        isK := False;
      end;
      T := T + S[I];
      INC(I);
    end else begin
      K1 := sj1_tbl[S[I]];
      case K1 of
      0: INC(I);    { invalid SBCS }
      2: INC(I, 2); { invalid DBCS }
      1:
        begin { halfwidth katakana }
          if not isK then begin
            T := T + desig_jis;
            isK := True;
          end;
          { simple SBCS -> DBCS conversion                         }
          K2 := kana_tbl[S[I]];
          if (I < L) and (Ord(S[I+1]) AND $FE = $DE) then
          begin  { convert kana + voiced mark to voiced kana }
            K3 := vkana_tbl[S[I]];
            case S[I+1] of
            #$DE:  { voiced }
              if K3 <> 0 then
              begin
                K2 := K3;
                INC(I);
              end;
            #$DF:  { semivoiced }
              if (K3 >= $2550) and (K3 <= $255C) then
              begin
                K2 := K3 + 1;
                INC(I);
              end;
            end;
          end;
          T := T + Chr(K2 SHR 8) + Chr(K2 AND $FF);
          INC(I);
        end;
      else { DBCS }
        if (I < L) then begin
          K2 := sj2_tbl[S[I + 1]];
          if K2 <> 0 then
          begin
            if not isK then begin
              T := T + desig_jis;
              isK := True;
            end;
            T := T + Chr(K1 + K2 SHR 8) + Chr(K2 AND $FF);
          end;
        end;
        INC(I, 2);
      end;
    end;
  end;
  if isK then
    T := T + desig_asc;
  Result := T;
end;

{ encode a header field if non-ASCII characters are used }
function EncodeHeader(const Header: string; specials : CSET; const HeaderEncoding: Char;
  TransferHeader: TTransfer; MimeCharSet: string): string;
const
  SPACES: set of Char = [' ', #9, #10, #13];    {Do not Localize}

var
  S, T: string;
  L, P, Q, R: Integer;
  B0, B1, B2: Integer;
  InEncode: Integer;
  NeedEncode: Boolean;
  csNeedEncode, csReqQuote: CSET;
  BeginEncode, EndEncode: string;

  procedure EncodeWord(P: Integer);
  const
    MaxEncLen = 75;
  var
    Q: Integer;
    EncLen: Integer;
    Enc1: string;
  begin
    T := T + BeginEncode;
    if L < P then P := L + 1;
    Q := InEncode;
    InEncode := 0;
    EncLen := Length(BeginEncode) + 2;

    if AnsiSameText(HeaderEncoding, 'Q') then  { quoted-printable }   {Do not Localize}
    begin
      while Q < P do
      begin
        if not (S[Q] in csReqQuote) then
        begin
          Enc1 := S[Q]
        end
        else
        begin
          if S[Q] = ' ' then  {Do not Localize}
            Enc1 := '_'   {Do not Localize}
          else
            Enc1 := '=' + IntToHex(Ord(S[Q]), 2);     {Do not Localize}
        end;
        if EncLen + Length(Enc1) > MaxEncLen then
        begin
          T := T + EndEncode + #13#10#9 + BeginEncode;
          EncLen := Length(BeginEncode) + 2;
        end;
        T := T + Enc1;
        INC(EncLen, Length(Enc1));
        INC(Q);
      end;
    end
    else
    begin { base64 }
      while Q < P do
      begin
        if EncLen + 4 > MaxEncLen then
        begin
          T := T + EndEncode + #13#10#9 + BeginEncode;
          EncLen := Length(BeginEncode) + 2;
        end;

        B0 := Ord(S[Q]);
        case P - Q of
        1: T := T + base64_tbl[B0 SHR 2] + base64_tbl[B0 AND $03 SHL 4] + '==';  {Do not Localize}
        2:
          begin
            B1 := Ord(S[Q + 1]);
            T := T             + base64_tbl[B0 SHR 2] +
              base64_tbl[B0 AND $03 SHL 4 + B1 SHR 4] +
              base64_tbl[B1 AND $0F SHL 2] + '=';  {Do not Localize}
          end;
        else
          B1 := Ord(S[Q + 1]);
          B2 := Ord(S[Q + 2]);
          T := T + base64_tbl[B0 SHR 2] +
            base64_tbl[B0 AND $03 SHL 4 + B1 SHR 4] +
            base64_tbl[B1 AND $0F SHL 2 + B2 SHR 6] +
            base64_tbl[B2 AND $3F];
        end;
        INC(EncLen, 4);
        INC(Q, 3);
      end;
    end;
    T := T + EndEncode;
  end;

begin
  case TransferHeader of
  iso2022jp:
    S := Encode2022JP(Header);
  else
    S := Header;
  end;

  {Suggested by Andrew P.Rybin for easy 8bit support}
  if HeaderEncoding='8' then begin //UpCase('8')='8'     {Do not Localize}
      Result:=S;
      EXIT;
  end;//if
  csNeedEncode := [#0..#31, #127..#255] + specials;
  csReqQuote := csNeedEncode + ['?', '=', '_'];   {Do not Localize}
  BeginEncode := '=?' + MimeCharSet + '?' + HeaderEncoding + '?';    {Do not Localize}
  EndEncode := '?=';  {Do not Localize}

  L := Length(S);
  P := 1;
  T := '';  {Do not Localize}
  InEncode := 0;
  while P <= L do
  begin
    Q := P;
    while (P <= L) and (S[P] in SPACES) do
      INC(P);
    R := P;
    NeedEncode := False;
    while (P <= L) and not (S[P] in SPACES) do
    begin
      if S[P] in csNeedEncode then
      begin
        NeedEncode := True;
      end;
      INC(P);
    end;
    if NeedEncode then
    begin
      if InEncode = 0 then
      begin
        T := T + Copy(S, Q, R - Q);
        InEncode := R;
      end;
    end
    else
    begin
      if InEncode <> 0 then
      begin
        EncodeWord(Q);
      end;
      T := T + Copy(S, Q, P - Q);
    end;
  end;
  if InEncode <> 0 then
  begin
    EncodeWord(P);
  end;
  Result := T;
end;

end.