idmessageclient.pas

photo.163.com 相册下载器 多线程下载

    LStream: TIdStreamVCL;
    LDestStream: TStream;
    i: integer;
    LAttachment: TIdAttachment;
  begin
    Result := nil; // suppress warnings
    LParentPart := AMsg.MIMEBoundary.ParentPart;
    AMsg.DoCreateAttachment(ADecoder.Headers, LAttachment);
    Assert(Assigned(LAttachment), 'Attachment must not be unassigned here!'); {Do not localize}
    with LAttachment do begin
      try
        LDestStream := PrepareTempStream; try
          LStream := TIdStreamVCL.Create(LDestStream); try
            Result := ADecoder.ReadBody(LStream, LMsgEnd);
          finally FreeAndNil(LStream); end;
          if AMsg.IsMsgSinglePartMime then begin
            ContentType := ResolveContentType(AMsg.Headers.Values['Content-Type']);  {do not localize}
            Headers.Add('Content-Type: '+AMsg.Headers.Values[SContentType]);         {do not localize}
            CharSet := GetCharSet(AMsg.Headers.Values['Content-Type']);              {do not localize}
            //Watch out for BinHex 4.0 encoding: no ContentTransfer is specified
            //in the header, but we need to set it to something meaningful for us...
            if TextIsSame(Copy(ContentType, 1, 24), 'application/mac-binhex40') then begin {do not localize}
              ContentTransfer := 'binhex40';                                               {do not localize}
              Headers.Add('Content-Transfer-Encoding: binhex40');                          {do not localize}
            end else begin
              ContentTransfer := AMsg.Headers.Values['Content-Transfer-Encoding'];  {do not localize}
              Headers.Add('Content-Transfer-Encoding: '+AMsg.Headers.Values['Content-Transfer-Encoding']); {do not localize}
            end;
            ContentDisposition := AMsg.Headers.Values['Content-Disposition']; {do not localize}
            ContentID := AMsg.Headers.Values['Content-ID'];                   {do not localize}
            ContentLocation := AMsg.Headers.Values['Content-Location'];       {do not localize}
          end else begin
            ContentType := ResolveContentType(ADecoder.Headers.Values['Content-Type']);  {do not localize}
            Headers.Add('Content-Type: '+ADecoder.Headers.Values[SContentType]);         {do not localize}
            CharSet := GetCharSet(ADecoder.Headers.Values['Content-Type']);              {do not localize}
            if ADecoder is TIdMessageDecoderUUE then begin
              if TIdMessageDecoderUUE(ADecoder).CodingType = 'XXE' then begin {do not localize}
                ContentTransfer := 'XXE';  {do not localize}
              end else begin
                ContentTransfer := 'UUE';  {do not localize}
              end;
            end else begin
              //Watch out for BinHex 4.0 encoding: no ContentTransfer is specified
              //in the header, but we need to set it to something meaningful for us...
              if TextIsSame(Copy(ContentType, 1, 24), 'application/mac-binhex40') then begin {do not localize}
                ContentTransfer := 'binhex40';                                               {do not localize}
                Headers.Add('Content-Transfer-Encoding: binhex40');                          {do not localize}
              end else begin
                ContentTransfer := ADecoder.Headers.Values['Content-Transfer-Encoding'];  {do not localize}
                Headers.Add('Content-Transfer-Encoding: '+ADecoder.Headers.Values['Content-Transfer-Encoding']); {do not localize}
              end;
            end;
            ContentDisposition := ADecoder.Headers.Values['Content-Disposition']; {do not localize}
            ContentID := ADecoder.Headers.Values['Content-ID'];                   {do not localize}
            ContentLocation := ADecoder.Headers.Values['Content-Location'];       {do not localize}
            ExtraHeaders.NameValueSeparator := '=';                               {do not localize}
            for i := 0 to ADecoder.Headers.Count-1 do begin
              if Headers.IndexOfName(ADecoder.Headers.Names[i]) < 0 then begin
                ExtraHeaders.Add(ADecoder.Headers.Strings[i]);
              end;
            end;
          end;
          Filename := ADecoder.Filename;
          if TextIsSame(Copy(ContentType, 1, 10), 'multipart/') then begin  {do not localize}
            ParentPart := LPreviousParentPart;
          end else begin
            ParentPart := LParentPart;
          end;
          ADecoder.Free;
        finally FinishTempStream; end;
      except
        //This should also remove the Item from the TCollection.
        //Note that Delete does not exist in the TCollection.
        AMsg.MessageParts[Index].Free;
        Free;
      end;
    end;
  end;

begin
  LMsgEnd := False;
  if AMsg.NoDecode then begin
    IOHandler.Capture(AMsg.Body, ADelim);
  end else begin
    BeginWork(wmRead); try
      if (
       ((AMsg.Encoding = meMIME) and (AMsg.MIMEBoundary.Count > 0))
       or ((AMsg.Encoding = mePlainText) and (not TextIsSame(AMsg.ContentTransferEncoding, 'base64'))  {do not localize}
          and (not TextIsSame(AMsg.ContentTransferEncoding, 'quoted-printable')))                      {do not localize}
       ) then begin
        {NOTE: You hit this code path with multipart MIME messages and with
        plain-text messages (which may have UUE or XXE attachments embedded).}
        LActiveDecoder := nil;
        repeat
          {CC: This code assumes the preamble text (before the first boundary)
          is plain text.  I cannot imagine it not being, but if it arises, lines
          will have to be decoded.}
          LLine := IOHandler.ReadLn;
          if LLine = ADelim then begin
            Break;
          end;
          if LActiveDecoder = nil then begin
            LActiveDecoder := TIdMessageDecoderList.CheckForStart(AMsg, LLine);
          end;
          // Check again, the if above can set it.
          if LActiveDecoder = nil then begin
            if (LLine <> '') and (LLine[1] = '.') then begin             {do not localize}
              Delete(LLine, 1, 1);
            end;
            AMsg.Body.Add(LLine);
          end else begin
            RemoveLastBlankLine(AMsg.Body);
            while LActiveDecoder <> nil do begin
              LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
              LPreviousParentPart := AMsg.MIMEBoundary.ParentPart;
              LActiveDecoder.ReadHeader;
              case LActiveDecoder.PartType of
                mcptUnknown:
                  EIdException.Toss(RSMsgClientUnkownMessagePartType);
                mcptText:
                  LActiveDecoder := ProcessTextPart(LActiveDecoder);
                mcptAttachment:
                  LActiveDecoder := ProcessAttachment(LActiveDecoder);
              end;
            end;
          end;
        until LMsgEnd;
        RemoveLastBlankLine(AMsg.Body);
      end else begin
        {These are single-part MIMEs, or else mePlainTexts with the body encoded QP/base64}
        AMsg.IsMsgSinglePartMime := True;
        LActiveDecoder := TIdMessageDecoderMime.Create(AMsg);
        LActiveDecoder.SourceStream := TIdTCPStream.Create(Self);
        TIdMessageDecoderMime(LActiveDecoder).CheckAndSetType(AMsg.ContentType, AMsg.ContentDisposition);
        case LActiveDecoder.PartType of
          mcptUnknown:    EIdException.Toss(RSMsgClientUnkownMessagePartType);
          mcptText:       ProcessTextPart(LActiveDecoder, True); //Put the text into TIdMessage.Body
          mcptAttachment: ProcessAttachment(LActiveDecoder);
        end;
      end;
    finally EndWork(wmRead); end;
  end;
end;

procedure TIdMessageClient.SendHeader(AMsg: TIdMessage);
begin
  AMsg.GenerateHeader;
  IOHandler.Write(AMsg.LastGeneratedHeaders);
end;

procedure TIdMessageClient.SendBody(AMsg: TIdMEssage);
var
  i: Integer;
  LAttachment: TIdAttachment;
  LBoundary: string;
  LDestStream: TIdStream;
  LSrcStream: TIdStreamVCL;
  LStrStream: TIdStreamVCL;
  ISOCharset: string;
  HeaderEncoding: Char;  { B | Q }
  TransferEncoding: TTransfer;
  LEncoder: TIdMessageEncoder;
  LLine: string;
  LX: integer;

  function GetLine(ASrcStream: TStream; var ALine: string): Boolean;
  {Gets the next character, adding an extra '.' if line starts with a '.'}
  var
    LChar: Char;
    LGotAChar: Boolean;
  begin
    LGotAChar := False;
    Result := True;
    ALine := '';
    while ReadCharFromStream(ASrcStream, LChar) > 0 do begin
      if ((LGotAChar = False) and (LChar = '.')) then begin
        {Lines that start with a '.' are required to have an extra '.'
        inserted per RFC 821.}
        ALine := ALine + LChar;
      end;
      LGotAChar := True;
      if LChar = #13 then begin
        {Get the LF after the CR...}
        ReadCharFromStream(ASrcStream, LChar);
        ALine := ALine + EOL;
        Exit;
      end;
      ALine := ALine + LChar;
    end;
    if LGotAChar = False then begin
      Result := False;
    end;
  end;

  procedure WriteTextPart(ATextPart: TIdText);
  var
    LData: string;
    LDestStream: TIdStream;
    LStrStream: TIdStreamVCL;
    LBodyLine: String;
    i: Integer;
  begin
    if ATextPart.ContentType = '' then begin
      ATextPart.ContentType := 'text/plain'; {do not localize}
    end;
    if ATextPart.ContentTransfer = '' then begin
      ATextPart.ContentTransfer := 'quoted-printable'; {do not localize}
    end;
    IOHandler.WriteLn(GenerateTextPartContentType(ATextPart.ContentType, ATextPart.CharSet));

    if ( (not TextIsSame(ATextPart.ContentTransfer, 'quoted-printable')) {do not localize}
     and (not TextIsSame(ATextPart.ContentTransfer, 'base64')) {do not localize}
     and ATextPart.IsBodyEncodingRequired ) then begin
      ATextPart.ContentTransfer := '8bit';                    {do not localize}
    end;
    IOHandler.WriteLn(SContentTransferEncoding + ': ' + ATextPart.ContentTransfer); {do not localize}

    if ATextPart.ContentID <> '' then begin
      IOHandler.WriteLn('Content-ID: ' + ATextPart.ContentID);  {do not localize}
    end;

    LX := ATextPart.ExtraHeaders.Count;  {Debugging}
    IOHandler.Write(ATextPart.ExtraHeaders);
    IOHandler.WriteLn('');

    if TextIsSame(ATextPart.ContentTransfer, 'quoted-printable') then begin {do not localize}
      LData := '';
      for i := 0 to ATextPart.Body.Count - 1 do begin
        LBodyLine := ATextPart.Body[i];
        if (LBodyLine <> '') and (LBodyLine[1] = '.') then begin           {do not localize}
          ATextPart.Body[i] := '.' + LBodyLine;                            {do not localize}
        end;
        LData := TIdEncoderQuotedPrintable.EncodeString(ATextPart.Body[i] + EOL);
        if TransferEncoding = iso2022jp then begin
          IOHandler.Write(Encode2022JP(LData))
        end else begin
          IOHandler.Write(LData);
        end;
      end;
      if (LData <> '') and not CharIsInEOF(LData, Length(LData)) then begin
        { The last line has no line break, add it to get a blank line when
          WriteTextPart returns. This should not happen because quoted-printable
          does not remove the EOL. }
        IOHandler.WriteLn('');
      end;
    end else if TextIsSame(ATextPart.ContentTransfer, 'base64') then begin  {do not localize}
      LDestStream := TIdTCPStream.Create(Self); try
        LEncoder := TIdMessageEncoder(TIdMessageEncoderMIME.Create(Self)); try
          LStrStream := TIdStreamVCL.Create(TIdStringStream.Create(''), True); try
            ATextPart.Body.SaveToStream(LStrStream.VCLStream);
            LStrStream.Position := 0;
            LEncoder.Encode(LStrStream, LDestStream);
          finally FreeAndNil(LStrStream); end;
        finally FreeAndNil(LEncoder); end;
      finally FreeAndNil(LDestStream); end;
    end else begin
      LX := ATextPart.Body.Count;
      IOHandler.Write(ATextPart.Body);
      { No test for last line break necessary because IOHandler.Write(TIdStrings) uses WriteLn. }
    end;
  end;

var
  LBodyLine: String;
  LTextPart: TIdText;
  LAddedTextPart: Boolean;
  LLastPart: integer;
  LBinHex4Encoder: TIdEncoderBinHex4;
begin
  LBoundary := '';
  AMsg.InitializeISO(TransferEncoding, HeaderEncoding, ISOCharSet);
  BeginWork(wmWrite); try
    if ((AMsg.IsMsgSinglePartMime = False) and (TextIsSame(AMsg.ContentTransferEncoding, 'base64') or {do not localize}
      TextIsSame(AMsg.ContentTransferEncoding, 'quoted-printable'))) then begin  {do not localize}
      //CC2: The user wants the body encoded.
      if AMsg.MessageParts.Count > 0 then begin
        //CC2: We cannot deal with parts within a body encoding (user has to do
        //this manually, if the user really wants to). Note this should have been trapped in TIdMessage.GenerateHeader.
        raise EIdException.Create(RSMsgClientInvalidForTransferEncoding);
      end;
      IOHandler.WriteLn('');     //This is the blank line after the headers
      DoStatus(hsStatusText, [RSMsgClientEncodingText]);
      //CC2: Now output AMsg.Body in the chosen encoding...
      LDestStream := TIdTCPStream.Create(Self); try
        if TextIsSame(AMsg.ContentTransferEncoding, 'base64') then begin  {do not localize}
          LEncoder := TIdMessageEncoder(TIdMessageEncoderMIME.Create(Self));
        end else begin  {'quoted-printable'}
          LEncoder := TIdMessageEncoder(TIdMessageEncoderQuotedPrintable.Create(Self));
        end;
        try
          LStrStream := TIdStreamVCL.Create(TIdStringStream.Create(''), True); try
            AMsg.Body.SaveToStream(LStrStream.VCLStream);
            LStrStream.Position := 0;
            LEncoder.Encode(LStrStream, LDestStream);
          finally
            FreeAndNil(LStrStream);
          end;
        finally
          FreeAndNil(LEncoder)
        end;
      finally
        FreeAndNil(LDestStream);
      end;
    end else if AMsg.Encoding = mePlainText then begin
      IOHandler.WriteLn('');     //This is the blank line after the headers
      //CC2: It is NOT Mime.  It is a body followed by optional attachments
      DoStatus(hsStatusText, [RSMsgClientEncodingText]);
      // Write out Body first
      //TODO: Why just iso2022jp? Why not someting generic for all MBCS? Or is iso2022jp special?
      if TransferEncoding = iso2022jp then begin
        for i := 0 to AMsg.Body.Count - 1 do begin
          LBodyLine := AMsg.Body[i];
          if (LBodyLine>'') and (LBodyLine = '.') then begin  {do not localize}
            IOHandler.WriteLn('.' + Encode2022JP(LBodyLine)); {do not localize}
          end else begin
            IOHandler.WriteLn(Encode2022JP(LBodyLine));
          end;
        end;
      end else begin
        WriteBodyText(AMsg);
      end;
      IOHandler.WriteLn('');
      if AMsg.MessageParts.Count > 0 then begin
        //The message has attachments.
        for i := 0 to AMsg.MessageParts.Count - 1 do begin
          //CC: Added support for TIdText...
          if AMsg.MessageParts.Items[i] is TIdText then begin
            IOHandler.WriteLn('');
            IOHandler.WriteLn('------- Start of text attachment -------'); {do not localize}
            DoStatus(hsStatusText,  [RSMsgClientEncodingText]);
            WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
            IOHandler.WriteLn('------- End of text attachment -------');   {do not localize}
          end else if AMsg.MessageParts.Items[i] is TIdAttachment then begin
            DoStatus(hsStatusText, [RSMsgClientEncodingAttachment]);
            if AMsg.MessageParts[i].ContentTransfer = '' then begin
              //The user has nothing specified: see has he set a preference in
              //TIdMessage.AttachmentEncoding (AttachmentEncoding is really an
              //old and somewhat deprecated property, but we can still support it)...
              if ((AMsg.AttachmentEncoding = 'UUE') or (AMsg.AttachmentEncoding = 'XXE')) then begin  {do not localize}
                AMsg.MessageParts[i].ContentTransfer := AMsg.AttachmentEncoding;
              end else begin
                //We default to UUE (rather than XXE)...
                AMsg.MessageParts[i].ContentTransfer := 'UUE';  {do not localize}
              end;