mail2000.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

        Texto := Copy(Result, nPos1+1, nPos2-nPos1-1);

        if (Length(Texto) >= 2) and (Texto[2] = '?') and (UpCase(Texto[1]) in ['B', 'Q', 'U']) then
        begin

          Encoding := UpCase(Texto[1]);
        end
        else
        begin

          Encoding := 'Q';
        end;

        Texto := Copy(Texto, 3, Length(Texto)-2);
        
        case Encoding of

          'B':
          begin

            GetMem(Buffer, Length(Texto));
            Size := DecodeLineBASE64(Texto, Buffer);
            Buffer[Size] := #0;
            Texto := String(Buffer);
          end;

          'Q':
          begin

            while Pos('_', Texto) > 0 do
              Texto[Pos('_', Texto)] := #32;

            Texto := DecodeQuotedPrintable(Texto);
          end;

          'U':
          begin

            GetMem(Buffer, Length(Texto));
            Size := DecodeLineUUCODE(Texto, Buffer);
            Buffer[Size] := #0;
            Texto := String(Buffer);
          end;
        end;

        Result := Copy(Result, 1, nPos0-1)+Texto+Copy(Result,nPos2+2,Length(Result));
        Found := True;
      end;
    end;

  until not Found;
end;

// Encode an ISO8859-1 encoded line e.g. =?iso-8859-1?x?xxxxxx=?=

function EncodeLine7Bit(Texto, Charset: String): String;
var
  Loop: Integer;
  Encode: Boolean;
begin

  Encode := False;

  for Loop := 1 to Length(Texto) do
    if (Ord(Texto[Loop]) > 127) or (Ord(Texto[Loop]) < 32) then
    begin

      Encode := True;
      Break;
    end;

  if Encode then
    Result := '=?'+Charset+'?Q?'+EncodeQuotedPrintable(Texto, True)+'?='
  else
    Result := Texto;
end;

// Decode a quoted-printable encoded string

function DecodeQuotedPrintable(Texto: String): String;
var
  nPos: Integer;
  nLastPos: Integer;
  lFound: Boolean;

begin

  Result := Texto;

  lFound := True;
  nLastPos := 0;

  while lFound do
  begin

    lFound := False;

    if nLastPos < Length(Result) then
      nPos := Pos('=', Copy(Result, nLastPos+1, Length(Result)-nLastPos))+nLastPos
    else
      nPos := 0;

    if (nPos < (Length(Result)-1)) and (nPos > nLastPos) then
    begin

      if (Result[nPos+1] in ['A'..'F', '0'..'9']) and (Result[nPos+2] in ['A'..'F', '0'..'9']) then
      begin

        Insert(Char(StrToInt('$'+Result[nPos+1]+Result[nPos+2])), Result, nPos);
        Delete(Result, nPos+1, 3);
      end
      else
      begin

        if (Result[nPos+1] = #13) and (Result[nPos+2] = #10) then
        begin

          Delete(Result, nPos, 3);
        end
        else
        begin

          if (Result[nPos+1] = #10) and (Result[nPos+2] = #13) then
          begin

            Delete(Result, nPos, 3);
          end
          else
          begin

            if (Result[nPos+1] = #13) and (Result[nPos+2] <> #10) then
            begin

              Delete(Result, nPos, 2);
            end
            else
            begin

              if (Result[nPos+1] = #10) and (Result[nPos+2] <> #13) then
              begin

                Delete(Result, nPos, 2);
              end;
            end;
          end;
        end;
      end;

      lFound := True;
      nLastPos := nPos;
    end
    else
    begin

      if nPos = Length(Result) then
      begin

        Delete(Result, nPos, 1);
      end;
    end;
  end;
end;

// Encode a string in quoted-printable format

function EncodeQuotedPrintable(Texto: String; HeaderLine: Boolean): String;
var
  nPos: Integer;
  LineLen: Integer;

begin

  Result := '';
  LineLen := 0;

  for nPos := 1 to Length(Texto) do
  begin

    if (Texto[nPos] > #127) or
       (Texto[nPos] = '=') or
       ((Texto[nPos] <= #32) and HeaderLine) or
       ((Texto[nPos] = '"') and HeaderLine) then
    begin

      Result := Result + '=' + PadL(Format('%2x', [Ord(Texto[nPos])]), 2, '0');
      Inc(LineLen, 3);
    end
    else
    begin

      Result := Result + Texto[nPos];
      Inc(LineLen);
    end;

    if Texto[nPos] = #13 then LineLen := 0;

    if (LineLen >= 70) and (not HeaderLine) then
    begin

      Result := Result + '='#13#10;
      LineLen := 0;
    end;
  end;
end;

// Decode an UUCODE encoded line

function DecodeLineUUCODE(const Buffer: String; Decoded: PChar): Integer;
const
	CHARS_PER_LINE = 45;
	Table: String = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';

var
	A24Bits: array[0..8 * CHARS_PER_LINE] of Boolean;
	i, j, k, b: Word;
	LineLen, ActualLen: Byte;

	function p_ByteFromTable(Ch: Char): Byte;
	var
		ij: Integer;
	begin

		ij := Pos(Ch, Table);

		if (ij > 64) or (ij = 0) then
		begin
			if Ch = #32 then
				Result := 0 else
				raise Exception.Create('UUCODE: Message format error');
		end else
			Result := ij - 1;
	end;

begin

  if Buffer = '' then
  begin

    Result := 0;
    Exit;
  end;

	LineLen := p_ByteFromTable(Buffer[1]);
	ActualLen := 4 * LineLen div 3;

	FillChar(A24Bits, 8 * CHARS_PER_LINE + 1, 0);
	Result := LineLen;

	if ActualLen <> (4 * CHARS_PER_LINE div 3) then
		ActualLen := Length(Buffer) - 1;

	k := 0;
	for i := 2 to ActualLen + 1 do
	begin
		b := p_ByteFromTable(Buffer[i]);
		for j := 5 downto 0 do
		begin
			A24Bits[k] := b and (1 shl j) > 0;
			Inc(k);
		end;
	end;

	k := 0;
	for i := 1 to CHARS_PER_LINE do
	begin
		b := 0;
		for j := 7 downto 0 do
		begin
			if A24Bits[k] then b := b or (1 shl j);
			Inc(k);
		end;
		Decoded[i-1] := Char(b);
	end;
end;

// Decode an UUCODE text

function DecodeUUCODE(Encoded: PChar; Decoded: TMemoryStream): Boolean;
var
  nTL, nPos, nLen: Integer;
  Line: PChar;
  LineDec: array[0..79] of Char;
  LineLen: Integer;
  DataEnd: Boolean;

begin

  Decoded.Clear;

  DataEnd := False;
  nPos := -1;
  nTL := StrLen(Encoded);

  DataLinePChar(Encoded, nTL, nPos, nLen, Line, DataEnd);

  while not DataEnd do
  begin

    if nLen > 0 then
    begin

      LineLen := DecodeLineUUCODE(String(Line), LineDec);

      if LineLen > 0 then
        Decoded.Write(LineDec[0], LineLen);
    end;

    DataLinePChar(Encoded, nTL, nPos, nLen, Line, DataEnd);
  end;

  Result := True;
end;

// Decode a BASE64 encoded line

function DecodeLineBASE64(const Buffer: String; Decoded: PChar): Integer;
var
  A1: array[1..4] of Byte;
  B1: array[1..3] of Byte;
  I, J: Integer;
  BytePtr, RealBytes: Integer;

begin

  BytePtr := 0;
  Result := 0;

  for J := 1 to Length(Buffer) do
  begin

    Inc(BytePtr);

    case Buffer[J] of

      'A'..'Z': A1[BytePtr] := Ord(Buffer[J])-65;

      'a'..'z': A1[BytePtr] := Ord(Buffer[J])-71;

      '0'..'9': A1[BytePtr] := Ord(Buffer[J])+4;

      '+': A1[BytePtr] := 62;

      '/': A1[BytePtr] := 63;

      '=': A1[BytePtr] := 64;
    end;

    if BytePtr = 4 then
    begin

      BytePtr := 0;
      RealBytes := 3;

      if A1[1] = 64 then RealBytes:=0;

      if A1[3] = 64 then
      begin

        A1[3] := 0;
        A1[4] := 0;
        RealBytes := 1;
      end;

      if A1[4] = 64 then
      begin

        A1[4] := 0;
        RealBytes := 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];

      for I := 1 to RealBytes do
      begin

        Decoded[Result+I-1] := Chr(B1[I]);
      end;

      Inc(Result, RealBytes);
    end;
  end;
end;

// Padronize header labels; remove double spaces, decode quoted text, lower the cases, indentify mail addresses

function NormalizeLabel(Texto: String): String;
const
  EncLabels: String = _C_T+':'+_C_TE+':'+_C_D+':';

var
  Quote: Boolean;
  Quoted: String;
  Loop: Integer;
  lLabel: Boolean;
  sLabel: String;
  Value: String;

begin

  Quote := False;
  lLabel := True;
  Value := '';
  sLabel := '';

  for Loop := 1 to Length(Texto) do
  begin

    if (Texto[Loop] = '"') and (not lLabel) then
    begin

      Quote := not Quote;

      if Quote then
      begin

        Quoted := '';
      end
      else
      begin

        Value := Value + Quoted;
      end;
    end;

    if not Quote then
    begin

      if lLabel then
      begin

        if (sLabel = '') or (sLabel[Length(sLabel)] = '-') then
          sLabel := sLabel + UpCase(Texto[Loop])
        else
          if (Copy(sLabel, Length(sLabel)-1, 2) = '-I') and (UpCase(Texto[Loop]) = 'D') and
             (Loop < Length(Texto)) and (Texto[Loop+1] = ':') then
            sLabel := sLabel + 'D'
          else
            sLabel := sLabel + LowerCase(Texto[Loop]);

        if Texto[Loop] = ':' then
        begin

          lLabel := False;
          Value := '';
        end;
      end
      else
      begin

        if Texto[Loop] = #32 then
        begin

          Value := TrimRightSpace(Value) + #32;
        end
        else
        begin

          if (not lLabel) and (Pos(sLabel, EncLabels) > 0) then
            Value := Value + LowerCase(Texto[Loop]);

          if (not lLabel) and (Pos(sLabel, EncLabels) = 0) then
            Value := Value + Texto[Loop];
        end;
      end;
    end
    else
    begin

      Quoted := Quoted + Texto[Loop];
    end;
  end;

  Result := TrimSpace(sLabel)+' '+TrimSpace(Value);
end;

// Return the value of a label; e.g. Label: value

function LabelValue(cLabel: String): String;
var
  Loop: Integer;
  Quote: Boolean;
  Value: Boolean;
  Ins: Boolean;

begin

  Quote := False;
  Value := False;
  Result := '';

  for Loop := 1 to Length(cLabel) do
  begin

    Ins := True;

    if cLabel[Loop] = '"' then
    begin

      Quote := not Quote;
      Ins := False;
    end;

    if not Quote then
    begin