mail2000.pas

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

    Result := LabelValue(FHeader[Loop]);
end;

// Return de value of a parameter of a value from the header

function TMailPart.GetLabelParamValue(cLabel, Param: String): String;
var
  Loop: Integer;

begin

  Result := '';
  Loop := SearchStringList(FHeader, cLabel+':');

  if Loop >= 0 then
    Result := TrimSpace(LabelParamValue(FHeader[Loop], Param));
end;

// Set the value of a label

procedure TMailPart.SetLabelValue(cLabel, cValue: String);
var
  Loop: Integer;

begin

  Loop := SearchStringList(FHeader, cLabel+':');

  if cValue <> '' then
  begin

    if Loop < 0 then
    begin

      FHeader.Add(cLabel+': ');
      Loop := FHeader.Count-1;
    end;

    FHeader[Loop] := WriteLabelValue(FHeader[Loop], cValue);
  end
  else
  begin

    if Loop >= 0 then
    begin

      FHeader.Delete(Loop);
    end;
  end;
end;

// Set the value of a label parameter

procedure TMailPart.SetLabelParamValue(cLabel, cParam, cValue: String);
var
  Loop: Integer;

begin

  Loop := SearchStringList(FHeader, cLabel+':');

  if Loop < 0 then
  begin

    FHeader.Add(cLabel+': ');
    Loop := FHeader.Count-1;
  end;

  FHeader[Loop] := WriteLabelParamValue(FHeader[Loop], cParam, cValue);
end;

// Look for a label in the header

function TMailPart.LabelExists(cLabel: String): Boolean;
begin

  Result := SearchStringList(FHeader, cLabel+':') >= 0;
end;

// Look for a parameter in a label in the header

function TMailPart.LabelParamExists(cLabel, Param: String): Boolean;
var
  Loop: Integer;

begin

  Result := False;
  Loop := SearchStringList(FHeader, cLabel+':');

  if Loop >= 0 then
    Result := TrimSpace(LabelParamValue(FHeader[Loop], Param)) <> '';
end;

// Divide header and body; normalize header;

procedure TMailPart.Fill(Data: PChar; HasHeader: Boolean);
const
  CRLF: array[0..2] of Char = (#13, #10, #0);

var
  Loop: Integer;
  BoundStart: array[0..99] of Char;
  BoundEnd: array[0..99] of Char;
  InBound: Boolean;
  IsBoundStart: Boolean;
  IsBoundEnd: Boolean;
  BoundStartLen: Integer;
  BoundEndLen: Integer;
  PartText: PChar;
  DataEnd: Boolean;
  MultPart: Boolean;
  NoParts: Boolean;
  InUUCode: Boolean;
  UUFile, UUBound: String;
  Part: TMailPart;
  nPos: Integer;
  nLen: Integer;
  nTL: Integer;
  nSPos: Integer;
  Line: PChar;
  SChar: Char;

begin

  if FOwnerMessage = nil then
    Exception.Create('MailPart must be owned by a MailMessage');

  for Loop := 0 to FSubPartList.Count-1 do
    FSubPartList.Items[Loop].Destroy;

  FHeader.Clear;
  FBody.Clear;
  FDecoded.Clear;
  FSubPartList.Clear;
  FOwnerMessage.FNeedRebuild := True;
  FIsDecoded := False;

  nPos := -1;
  DataEnd := False;
  nTL := StrLen(Data);
  nSPos := nTL+1;

  if (Self is TMailMessage2000) and Assigned(FOwnerMessage.FOnProgress) then
  begin

    FOwnerMessage.FOnProgress(Self, nTL, 0);
    Application.ProcessMessages;
  end;

  if HasHeader then
  begin

    // Get Header

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

    while not DataEnd do
    begin

      if nLen = 0 then
      begin

        Break;
      end
      else
      begin

        if (Line[0] in [#9, #32]) and (FHeader.Count > 0) then
        begin

          FHeader[FHeader.Count-1] := FHeader[FHeader.Count-1] + #32 + String(PChar(@Line[1]));
        end
        else
        begin

          FHeader.Add(String(Line));
        end;
      end;

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

      if (Self is TMailMessage2000) and Assigned(FOwnerMessage.FOnProgress) then
      begin

        FOwnerMessage.FOnProgress(Self, nTL, nPos+1);
        Application.ProcessMessages;
      end;
    end;

    for Loop := 0 to FHeader.Count-1 do
      FHeader[Loop] := NormalizeLabel(FHeader[Loop]);
  end;

  MultPart := Copy(GetLabelValue(_C_T), 1, 10) = 'multipart/';
  InBound := False;
  IsBoundStart := False;
  IsBoundEnd := False;
  UUBound := '';

  if MultPart then
  begin

    StrPCopy(BoundStart, '--'+GetLabelParamValue(_C_T, 'boundary'));
    StrPCopy(BoundEnd, '--'+GetLabelParamValue(_C_T, 'boundary')+'--');
    BoundStartLen := StrLen(BoundStart);
    BoundEndLen := StrLen(BoundEnd);
    NoParts := False;
  end
  else
  begin

    if LabelExists(_C_T) then
    begin

      NoParts := True;
      BoundStartLen := 0;
      BoundEndLen := 0;
    end
    else
    begin

      StrPCopy(BoundStart, 'begin 6');
      StrPCopy(BoundEnd, 'end');
      BoundStartLen := StrLen(BoundStart);
      BoundEndLen := StrLen(BoundEnd);
      NoParts := False;
    end;
  end;

  PartText := nil;

  // Get Body

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

  while (not DataEnd) and (not InBound) do
  begin

    if (not NoParts) and (((Line[0] = '-') and (Line[1] = '-')) or ((Line[0] = 'b') and (Line[1] = 'e'))) then
    begin

      IsBoundStart := StrLComp(Line, BoundStart, BoundStartLen) = 0;
    end;

    if NoParts or (not IsBoundStart) then
    begin

      if PartText = nil then
      begin

        PartText := Line;
        nSPos := nPos;
      end;

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

      if (Self is TMailMessage2000) and Assigned(FOwnerMessage.FOnProgress) then
      begin

        FOwnerMessage.FOnProgress(Self, nTL, nPos+1);
        Application.ProcessMessages;
      end;
    end
    else
    begin

      InBound := True;
    end;
  end;

  if nPos > nSPos then
  begin

    SChar := Data[nPos];
    Data[nPos] := #0;
    FBody.Write(PartText[0], nPos-nSPos);
    Data[nPos] := SChar;
  end;

  if not NoParts then
  begin

    PartText := nil;

    if MultPart then
    begin

      // Get Mime parts

      while not DataEnd do
      begin

        if IsBoundStart or IsBoundEnd then
        begin

          if (PartText <> nil) and (PartText[0] <> #0) then
          begin

            Part := TMailPart.Create(Self);
            Part.FOwnerPart := Self;
            Part.FOwnerMessage := Self.FOwnerMessage;

            SChar := Data[nPos-2];
            Data[nPos-2] := #0;
            Part.Fill(PartText, True);
            Data[nPos-2] := SChar;

            Part.FBoundary := GetLabelParamValue(_C_T, 'boundary');
            FSubPartList.Add(Part);
            PartText := nil;
          end;

          if IsBoundEnd then
          begin

            Break;
          end;

          IsBoundStart := False;
          IsBoundEnd := False;
        end
        else
        begin

          if PartText = nil then
          begin

            PartText := Line;
          end;
        end;

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

        if (Self is TMailMessage2000) and Assigned(FOwnerMessage.FOnProgress) then
        begin

          FOwnerMessage.FOnProgress(Self, nTL, nPos+1);
          Application.ProcessMessages;
        end;

        if not DataEnd then
        begin

          if (Line[0] = '-') and (Line[1] = '-') then
          begin

            IsBoundStart := StrLComp(Line, BoundStart, BoundStartLen) = 0;

            if not IsBoundStart then
            begin

              IsBoundEnd := StrLComp(Line, BoundEnd, BoundEndLen) = 0;
            end;
          end;
        end;
      end;
    end
    else
    begin

      // Get UUCode parts

      InUUCode := IsBoundStart;

      while not DataEnd do
      begin

        if IsBoundStart then
        begin

          if UUBound = '' then
          begin

            GetMem(PartText, FBody.Size+1);
            UUBound := GenerateBoundary;
            StrLCopy(PartText, FBody.Memory, FBody.Size);
            PartText[FBody.Size] := #0;

            Part := TMailPart.Create(Self);
            Part.FOwnerPart := Self;
            Part.FOwnerMessage := Self.FOwnerMessage;
            Part.Fill(PChar(EncodeQuotedPrintable(String(PartText), False)), False);
            Part.FBoundary := UUBound;
            Part.SetLabelValue(_C_T, 'text/plain');
            Part.SetLabelParamValue(_C_T, 'charset', '"'+FOwnerMessage.FCharset+'"');
            Part.SetLabelValue(_C_TE, 'quoted-printable');

            FSubPartList.Add(Part);
            SetLabelValue(_C_T, '');
            SetLabelValue(_C_T, 'multipart/mixed');
            SetLabelParamValue(_C_T, 'boundary', '"'+UUBound+'"');

            FreeMem(PartText);
          end;

          PartText := nil;
          IsBoundStart := False;
          UUFile := TrimSpace(Copy(String(Line), 11, 999));
        end
        else
        begin

          if IsBoundEnd then
          begin

            Part := TMailPart.Create(Self);
            Part.FOwnerPart := Self;
            Part.FOwnerMessage := Self.FOwnerMessage;

            SChar := Data[nPos-2];
            Data[nPos-2] := #0;
            DecodeUUCODE(PartText, Part.FDecoded);
            Data[nPos-2] := SChar;

            Part.EncodeBinary;
            Part.FBoundary := UUBound;
            Part.SetLabelValue(_C_T, GetMimeType(UUFile));
            Part.SetLabelValue(_C_TE, 'base64');
            Part.SetLabelValue(_C_D, 'attachment');
            Part.SetLabelParamValue(_C_T, 'name', '"'+UUFile+'"');
            Part.SetLabelParamValue(_C_D, 'filename', '"'+UUFile+'"');

            FSubPartList.Add(Part);
            PartText := nil;
            IsBoundEnd := False;
          end
          else
          begin

            if PartText = nil then
            begin

              PartText := Line;
            end;
          end;
        end;

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

        if (Self is TMailMessage2000) and Assigned(FOwnerMessage.FOnProgress) then
        begin

          FOwnerMessage.FOnProgress(Self, nTL, nPos+1);
          Application.ProcessMessages;
        end;

        if not DataEnd then
        begin

          if (Line[0] = 'b') and (Line[1] = 'e') then
          begin

            IsBoundStart := StrLComp(Line, BoundStart, BoundStartLen) = 0;
            InUUCode := True;
          end;

          if (not IsBoundStart) and InUUCode then
          begin

            if (Line[0] = 'e') and (Line[1] = 'n') and (Line[2] = 'd') then
            begin

              IsBoundEnd := True;
              InUUCode := False;
            end;
          end;
        end;
      end;
    end;
  end;

  if Self = FOwnerMessage then
  begin

    if not LabelExists(_C_T) then
    begin

      SetLabelValue(_C_T, 'text/plain');
    end;

    FOwnerMessage.PutText('', nil, '');
    FOwnerMessage.GetAttachList;
  end;
end;

// Remove mailpart from its owner

procedure TMailPart.Remove;
begin

  FOwnerPart.FSubPartList.Delete(FOwnerPart.FSubPartList.IndexOf(Self));
  FOwnerMessage.FNeedRebuild := True;
  Free;
end;

// Fill part with a file contents

procedure TMailPart.LoadFromFile(FileName: String);
var
  SL: TStringList;

begin

  SL := TStringList.Create;
  SL.LoadFromFile(FileName)