mail2000.pas

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

      if (cLabel[Loop] = ':') and (not Value) then
      begin

        Value := True;
        Ins := False;
      end
      else
      begin

        if (cLabel[Loop] = ';') and Value then
        begin

          Break;
        end;
      end;
    end;

    if Ins and Value then
    begin

      Result := Result + cLabel[Loop];
    end;
  end;

  Result := TrimSpace(Result);

  if (Copy(Result, 1, 1) = '"') and (Copy(Result, Length(Result), 1) = '"') then
    Result := Copy(Result, 2, Length(Result)-2);
end;

// Set the value of a label;

function WriteLabelValue(cLabel, Value: String): String;
var
  Loop: Integer;
  Quote: Boolean;
  ValPos, ValLen: Integer;

begin

  Quote := False;
  ValPos := 0;
  ValLen := -1;

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

    if cLabel[Loop] = '"' then
    begin

      Quote := not Quote;
    end;

    if not Quote then
    begin

      if (cLabel[Loop] = ':') and (ValPos = 0) then
      begin

        ValPos := Loop+1;
      end
      else
      begin

        if (cLabel[Loop] = ';') and (ValPos > 0) then
        begin

          ValLen := Loop - ValPos;
          Break;
        end;
      end;
    end;
  end;

  Result := cLabel;

  if (ValLen < 0) and (ValPos > 0) then
    ValLen := Length(cLabel) - ValPos + 1;

  if ValPos > 0 then
  begin

    Delete(Result, ValPos, ValLen);
    Insert(' '+TrimSpace(Value), Result, ValPos);
  end;
end;

// Return the value of a label parameter; e.g. Label: xxx; param=value

function LabelParamValue(cLabel, cParam: String): String;
var
  Loop: Integer;
  Quote: Boolean;
  Value: Boolean;
  Params: Boolean;
  ParamValue: Boolean;
  Ins: Boolean;
  Param: String;

begin

  Quote := False;
  Value := False;
  Params := False;
  ParamValue := False;

  Param := '';
  Result := '';

  cLabel := TrimSpace(cLabel);

  if Copy(cLabel, Length(cLabel), 1) <> ';' then cLabel := cLabel + ';';

  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

      if (cLabel[Loop] = ':') and (not Value) and (not Params) then
      begin

        Value := True;
        Params := False;
        ParamValue := False;
        Ins := False;
      end
      else
      begin

        if (cLabel[Loop] = ';') and (Value or Params) then
        begin

          Params := True;
          Value := False;
          ParamValue := False;
          Param := '';
          Ins := False;
        end
        else
        begin

          if (cLabel[Loop] = '=') and Params then
          begin

            ParamValue := UpperCase(TrimSpace(Param)) = UpperCase(TrimSpace(cParam));
            Ins := False;
            Param := '';
          end;
        end;
      end;
    end;

    if Ins and ParamValue then
    begin

      Result := Result + cLabel[Loop];
    end;

    if Ins and (not ParamValue) and Params then
    begin

      Param := Param + cLabel[Loop];
    end;
  end;

  Result := TrimSpace(Result);

  if (Copy(Result, 1, 1) = '"') and (Copy(Result, Length(Result), 1) = '"') then
    Result := Copy(Result, 2, Length(Result)-2);
end;

// Set the value of a label parameter;

function WriteLabelParamValue(cLabel, cParam, Value: String): String;
var
  Loop: Integer;
  Quote: Boolean;
  LabelValue: Boolean;
  Params: Boolean;
  ValPos, ValLen: Integer;
  Ins: Boolean;
  Param: String;

begin

  Quote := False;
  LabelValue := False;
  Params := False;
  ValPos := 0;
  ValLen := -1;

  Param := '';
  Result := '';

  cLabel := TrimSpace(cLabel);

  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

      if (cLabel[Loop] = ':') and (not LabelValue) and (not Params) then
      begin

        LabelValue := True;
        Params := False;
        ValPos := 0;
        ValLen := 0;
        Ins := False;
      end
      else
      begin

        if (cLabel[Loop] = ';') and (LabelValue or Params) then
        begin

          if Params and (ValPos > 0) then
          begin

            ValLen := Loop - ValPos;
            Break;
          end;

          Params := True;
          LabelValue := False;
          Param := '';
          Ins := False;
        end
        else
        begin

          if (cLabel[Loop] = '=') and Params then
          begin

            if UpperCase(TrimSpace(Param)) = UpperCase(TrimSpace(cParam)) then
            begin

              ValPos := Loop+1;
              ValLen := 0;
            end;

            Ins := False;
            Param := '';
          end;
        end;
      end;
    end;

    if Ins and (ValPos = 0) and Params then
    begin

      Param := Param + cLabel[Loop];
    end;
  end;

  Result := cLabel;

  if ValPos = 0 then
  begin

    Result := TrimSpace(Result) + '; ' + TrimSpace(cParam) + '=' + TrimSpace(Value);
  end
  else
  begin

    if (ValLen < 0) and (ValPos > 0) then
      ValLen := Length(cLabel) - ValPos + 1;

    Delete(Result, ValPos, ValLen);
    Insert(TrimSpace(Value), Result, ValPos);

    if Result[Length(Result)] = ';' then
      Delete(Result, Length(Result), 1);
  end;
end;

// Return the Timezone adjust in days

function GetTimeZoneBias: Double;
var
  TzInfo: TTimeZoneInformation;

begin

  case GetTimeZoneInformation(TzInfo) of

    1: Result := - (TzInfo.StandardBias + TzInfo.Bias) / (24*60);

    2: Result := - (TzInfo.DaylightBias + TzInfo.Bias) / (24*60);

    else Result := 0;
  end;
end;

// Fills left of string with char

function PadL(Str: String; Tam: Integer; PadStr: String): String;
var
  TempStr: String;

begin

  TempStr := TrimLeftSpace(Str);

  if Length(TempStr) <= Tam then
  begin

    while Length(TempStr) < Tam do
      TempStr := PadStr + TempStr;
  end
  else
  begin

    TempStr := Copy(TempStr, Length(TempStr) - Tam + 1, Tam);
  end;

  Result := TempStr;
end;

// Get mime type of a file extension

function GetMimeType(FileName: String): String;
var
  Key: string;

begin

  Result := '';

  with TRegistry.Create do
    try

      RootKey := HKEY_CLASSES_ROOT;
      Key := ExtractFileExt(FileName);

      if KeyExists(Key) then
      begin

        OpenKey(Key,false);
        Result := ReadString('Content Type');
        CloseKey;
      end;

    finally

      if Result = '' then
        Result := 'application/octet-stream';

      Free;
    end;
end;

// Get file extension of a mime type

function GetMimeExtension(MimeType: String): String;
var
  Key: string;

begin

  Result := '';

  with TRegistry.Create do
    try

      RootKey := HKEY_CLASSES_ROOT;

      if OpenKey('MIME\Database\Content Type', False) then
      begin

        Key := MimeType;

        if KeyExists(Key) then
        begin

          OpenKey(Key,false);
          Result := ReadString('Extension');
          CloseKey;
        end;
      end;

    finally

      if Result = '' then
        Result := '.txt';

      Free;
    end;
end;

// Generate a random boundary

function GenerateBoundary: String;
begin

  Result := 'boundary'+PadL(Format('%8x', [Random($FFFFFFFF)]), 8, '0');
end;

// Encode in base64

function EncodeBASE64(Encoded: TMemoryStream {TMailText}; Decoded: TMemoryStream): Integer;
const
  _Code64: String[64] =
    ('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/');
var
  I: LongInt;
  B: array[0..2279] of Byte;
  J, K, L, M, Quads: Integer;
  Stream: string[76];
  EncLine: String;

begin

  Encoded.Clear;

  Stream := '';
  Quads := 0;
  J := Decoded.Size div 2280;

  Decoded.Position := 0;

  for I := 1 to J do
  begin

    Decoded.Read(B, 2280);

    for M := 0 to 39 do
    begin

      for K := 0 to 18 do
      begin

        L:= 57*M + 3*K;

        Stream[Quads+1] := _Code64[(B[L] div 4)+1];
        Stream[Quads+2] := _Code64[(B[L] mod 4)*16 + (B[L+1] div 16)+1];
        Stream[Quads+3] := _Code64[(B[L+1] mod 16)*4 + (B[L+2] div 64)+1];
        Stream[Quads+4] := _Code64[B[L+2] mod 64+1];

        Inc(Quads, 4);

        if Quads = 76 then
        begin

          Stream[0] := #76;
          EncLine := Stream+#13#10;
          Encoded.Write(EncLine[1], Length(EncLine));
          Quads := 0;
        end;
      end;
    end;
  end;

  J := (Decoded.Size mod 2280) div 3;

  for I := 1 to J do
  begin

    Decoded.Read(B, 3);

    Stream[Quads+1] := _Code64[(B[0] div 4)+1];
    Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
    Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + (B[2] div 64)+1];
    Stream[Quads+4] := _Code64[B[2] mod 64+1];

    Inc(Quads, 4);

    if Quads = 76 then
    begin

      Stream[0] := #76;
      EncLine := Stream+#13#10;
      Encoded.Write(EncLine[1], Length(EncLine));
      Quads := 0;
    end;
  end;

  if (Decoded.Size mod 3) = 2 then
  begin

    Decoded.Read(B, 2);

    Stream[Quads+1] := _Code64[(B[0] div 4)+1];
    Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1];
    Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + 1];
    Stream[Quads+4] := '=';