idmessageclient.pas

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

            end;
            if TextIsSame(AMsg.MessageParts[i].ContentTransfer, 'UUE') then begin          {do not localize}
              LEncoder := TIdMessageEncoderUUE.Create(nil);
            end else if TextIsSame(AMsg.MessageParts[i].ContentTransfer, 'XXE') then begin {do not localize}
              LEncoder := TIdMessageEncoderXXE.Create(nil);
            end;

            LDestStream := TIdTCPStream.Create(Self);
            try
              with LEncoder do
              try
                Filename := TIdAttachment(AMsg.MessageParts[i]).Filename;
                LSrcStream := TIdStreamVCL.Create(TIdAttachment(AMsg.MessageParts[i]).OpenLoadStream);
                try
                  Encode(LSrcStream, LDestStream);
                finally
                  TIdAttachment(AMsg.MessageParts[i]).CloseLoadStream;
                  LSrcStream.Free;
                end;
              finally
                Free;
              end;
            finally
              FreeAndNil(LDestStream);
            end;
          end;
          IOHandler.WriteLn('');
        end;
      end;
    end else begin
      //CC2: It is MIME-encoding...
      LAddedTextPart := False;
      //######### OUTPUT THE PREAMBLE TEXT ########
      {For single-part MIME messages, we want the message part headers to be appended
      to the message headers.  Otherwise, add the blank separator between header and
      body...}
      if AMsg.IsMsgSinglePartMime = False then begin
        IOHandler.WriteLn('');     //This is the blank line after the headers
        //if AMsg.Body.Count > 0 then begin
        if AMsg.IsBodyEmpty = False then begin
          //CC2: The message has a body text.  There are now a few possibilities.
          //First up, if ConvertPreamble is False then the user explicitly does not want us
          //to convert the .Body since he had to change it from the default False.
          //Secondly, if AMsg.MessageParts.TextPartCount > 0, he may have put the
          //message text in the part, so don't convert the body.
          //Thirdly, if AMsg.MessageParts.Count = 0, then it has no other parts
          //anyway: in this case, output it without boundaries. 
          //if (AMsg.ConvertPreamble and (AMsg.MessageParts.TextPartCount = 0)) then begin
          if (AMsg.ConvertPreamble and (AMsg.MessageParts.TextPartCount = 0) and (AMsg.MessageParts.Count > 0)) then begin
            //CC2: There is no text part, the user has not changed ConvertPreamble from
            //its default of True, so the user has probably put his message into
            //the body by mistake instead of putting it in a TIdText part.
            //Create a TIdText part from the .Body text...
            LTextPart := TIdText.Create(AMsg.MessageParts);
            LTextPart.Body.Text := AMsg.Body.Text;
            LTextPart.ContentType := 'text/plain';  {do not localize}
            LTextPart.ContentTransfer := '7bit';    {do not localize}
            //Have to remember that we added a text part, which is the last part
            //in the collection, because we need it to be outputted first...
            LAddedTextPart := True;
            //CC2: Insert our standard preamble text...
            IOHandler.WriteLn(SThisIsMultiPartMessageInMIMEFormat);
          end else begin
            //CC2: Hopefully the user has put suitable text in the preamble, or this
            //is an already-received message which already has a preamble text...
            WriteBodyText(AMsg);
          end;
        end else begin
          //CC2: The user has specified no body text: he presumably has the message in
          //a TIdText part, but it may have no text at all (a message consisting only
          //of headers, which is allowed under the RFC, which will have a parts count
          //of 0).
          if AMsg.MessageParts.Count <> 0 then begin
            //Add the "standard" MIME preamble text for non-html email clients...
            IOHandler.WriteLn(SThisIsMultiPartMessageInMIMEFormat);
          end;
        end;
        IOHandler.WriteLn('');
        //######### SET UP THE BOUNDARY STACK ########
        AMsg.MIMEBoundary.Clear;
        LBoundary := IdMIMEBoundaryStrings.IndyMIMEBoundary;
        AMsg.MIMEBoundary.Push(LBoundary, -1);  //-1 is "top level"
      end;
      //######### OUTPUT THE PARTS ########
      //CC2: Write the text parts in their order, if you change the order you
      //can mess up mutipart sequences.
      //The exception is due to ConvertPreamble, which may have added a text
      //part at the end (the only place a TIdText part can be added), but it
      //needs to be outputted first...
      LLastPart := AMsg.MessageParts.Count - 1;
      if LAddedTextPart then begin
          IOHandler.WriteLn('--' + LBoundary);       {do not localize}
          DoStatus(hsStatusText,  [RSMsgClientEncodingText]);
          WriteTextPart(AMsg.MessageParts.Items[LLastPart] as TIdText);
          IOHandler.WriteLn('');
          Dec(LLastPart);  //Don't output it again in the following "for" loop
      end;
      for i := 0 to LLastPart do begin
        LLine := AMsg.MessageParts.Items[i].ContentType;
        if TextIsSame(Copy(LLine, 1, 10), 'multipart/') then begin  {do not localize}
          //A multipart header.  Write out the CURRENT boundary first...
          IOHandler.WriteLn('--' + LBoundary);      {do not localize}
          //Make the current boundary and this part number active...
          //Now need to generate a new boundary by adding a random character to
          //the current boundary...
          LBoundary := LBoundary + IdMIMEBoundaryStrings.GenerateRandomChar;
          AMsg.MIMEBoundary.Push(LBoundary, i);
          IOHandler.WriteLn('Content-Type: ' + LLine + ';');            {do not localize}
          IOHandler.WriteLn('        boundary="' + LBoundary + '"');  {do not localize}
          IOHandler.WriteLn('');
        end else begin
          //Not a multipart header, see if it is a part change...
          if AMsg.IsMsgSinglePartMime = False then begin
            while AMsg.MessageParts.Items[i].ParentPart <> AMsg.MIMEBoundary.ParentPart do begin
              IOHandler.WriteLn('--' + LBoundary + '--');  {do not localize}
              IOHandler.WriteLn('');
              AMsg.MIMEBoundary.Pop;  //This also pops AMsg.MIMEBoundary.ParentPart
              LBoundary := AMsg.MIMEBoundary.Boundary;
            end;
            IOHandler.WriteLn('--' + LBoundary);  {do not localize}
          end;
          if AMsg.MessageParts.Items[i] is TIdText then begin
            DoStatus(hsStatusText,  [RSMsgClientEncodingText]);
            WriteTextPart(AMsg.MessageParts.Items[i] as TIdText);
            IOHandler.WriteLn('');
          end
          else
          if AMsg.MessageParts.Items[i] is TIdAttachment then begin
            LAttachment := TIdAttachment(AMsg.MessageParts[i]);
            DoStatus(hsStatusText, [RSMsgClientEncodingAttachment]);
            if LAttachment.ContentTransfer = '' then begin
              LAttachment.ContentTransfer := 'base64'; {do not localize}
            end;
            if LAttachment.ContentDisposition = '' then begin
              LAttachment.ContentDisposition := 'attachment'; {do not localize}
            end;
            if LAttachment.ContentType = '' then begin
              if TextIsSame(LAttachment.ContentTransfer, 'base64') then begin {do not localize}
                LAttachment.ContentType := 'application/octet-stream'; {do not localize}
              end else begin
                {CC4: Set default type if not base64 encoded...}
                LAttachment.ContentType := 'text/plain'; {do not localize}
              end;
            end;
            if TextIsSame(LAttachment.ContentTransfer, 'binhex40') then begin   {do not localize}
              //This is special - you do NOT write out any Content-Transfer-Encoding
              //header!  We also have to write a Content-Type specified in RFC 1741
              //(overriding any ContentType present, if necessary).
              LAttachment.ContentType := 'application/mac-binhex40';            {do not localize}
              if LAttachment.CharSet <> '' then begin
                IOHandler.WriteLn('Content-Type: '+LAttachment.ContentType+'; charset="'+LAttachment.CharSet+'";'); {do not localize}
              end else begin
                IOHandler.WriteLn('Content-Type: '+LAttachment.ContentType+';'); {do not localize}
              end;
              IOHandler.WriteLn('        name="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
            end else begin
              if LAttachment.CharSet <> '' then begin
                IOHandler.WriteLn('Content-Type: ' + RemoveHeaderEntry(LAttachment.ContentType, 'charset')  {do not localize}
                 + '; charset="'+LAttachment.CharSet+'";'); {do not localize}
              end else begin
                IOHandler.WriteLn('Content-Type: ' + LAttachment.ContentType + ';'); {do not localize}
              end;
              IOHandler.WriteLn('        name="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
              IOHandler.WriteLn('Content-Transfer-Encoding: ' + LAttachment.ContentTransfer); {do not localize}
              IOHandler.WriteLn('Content-Disposition: ' + LAttachment.ContentDisposition +';'); {do not localize}
              IOHandler.WriteLn('        filename="' + ExtractFileName(LAttachment.FileName) + '"'); {do not localize}
            end;
            if LAttachment.ContentID <> '' then begin
              IOHandler.WriteLn('Content-ID: '+ LAttachment.ContentID); {Do not Localize}
            end;
            IOHandler.Write(LAttachment.ExtraHeaders);
            IOHandler.WriteLn('');
            LDestStream := TIdTCPStream.Create(Self);
            try
              if ((TextIsSame(LAttachment.ContentTransfer, 'base64') = False) and {do not localize}
               (TextIsSame(LAttachment.ContentTransfer, 'quoted-printable') = False) and {do not localize}
               (TextIsSame(LAttachment.ContentTransfer, 'binhex40') = False)) then begin {do not localize}
                LSrcStream := TIdStreamVCL.Create(TIdAttachment(AMsg.MessageParts[i]).OpenLoadStream);
                try
                  while GetLine(LSrcStream.VCLStream, LLine) do begin
                    LDestStream.Write(LLine);
                  end;
                finally
                  TIdAttachment(AMsg.MessageParts[i]).CloseLoadStream;
                  LSrcStream.Free;
                end;
              end else begin
                if TextIsSame(LAttachment.ContentTransfer, 'binhex40') then begin  {do not localize}
                  //This is different, it has to create a header that includes CRC checks
                  LBinHex4Encoder := TIdEncoderBinHex4.Create(Self);
                  try
                    LSrcStream := TIdStreamVCL.Create(TIdAttachment(AMsg.MessageParts[i]).OpenLoadStream);
                    try
                      LBinHex4Encoder.EncodeFile(TIdAttachment(AMsg.MessageParts[i]).Filename,
                       LSrcStream, LDestStream);
                    finally
                      TIdAttachment(AMsg.MessageParts[i]).CloseLoadStream;
                      LSrcStream.Free;
                    end;
                  finally
                    LBinHex4Encoder.Free;
                  end;
                end else begin
                  if TextIsSame(LAttachment.ContentTransfer, 'base64') then begin {do not localize}
                    LEncoder := TIdMessageEncoder(TIdMessageEncoderMIME.Create(Self));
                  end else begin  {'quoted-printable'}
                    LEncoder := TIdMessageEncoder(TIdMessageEncoderQuotedPrintable.Create(Self));
                  end;
                  try
                    LEncoder.Filename := TIdAttachment(AMsg.MessageParts[i]).Filename;
                    LSrcStream := TIdStreamVCL.Create(TIdAttachment(AMsg.MessageParts[i]).OpenLoadStream);
                    try
                      LEncoder.Encode(LSrcStream, LDestStream);
                    finally
                      TIdAttachment(AMsg.MessageParts[i]).CloseLoadStream;
                      LSrcStream.Free;
                    end;
                  finally
                    LEncoder.Free;
                  end;
                end;
              end;
            finally
              FreeAndNil(LDestStream);
            end;
            IOHandler.WriteLn('');
          end;
        end;
      end;
      if AMsg.MessageParts.Count > 0 then begin
        for i := 0 to AMsg.MIMEBoundary.Count - 1 do begin
          IOHandler.WriteLn('--' + AMsg.MIMEBoundary.Boundary + '--');
          IOHandler.WriteLn('');
          AMsg.MIMEBoundary.Pop;
        end;
      end;
    end;
  finally EndWork(wmWrite); end;
end;

procedure TIdMessageClient.SendMsg(AMsg: TIdMessage; AHeadersOnly: Boolean = False);
begin
  if AMsg.NoEncode then begin
    BeginWork(wmWrite); try
      IOHandler.Write(AMsg.Headers);
      IOHandler.WriteLn('');
      if not AHeadersOnly then begin
        IOHandler.Write(AMsg.Body);
      end;
    finally EndWork(wmWrite); end;
  end else begin
    SendHeader(AMsg);
    if (not AHeadersOnly) then begin
      SendBody(AMsg);
    end;
  end;
end;

function TIdMessageClient.ReceiveHeader(AMsg: TIdMessage; const AAltTerm: string = ''): string;
begin
  BeginWork(wmRead); try
    repeat
      Result := IOHandler.ReadLn;
      // Exchange Bug: Exchange sometimes returns . when getting a message instead of
      // '' then a . - That is there is no seperation between the header and the message for an
      // empty message.
      if ((Length(AAltTerm) = 0) and (Result = '.')) or  {do not localize}
         ({APR: why? (Length(AAltTerm) > 0) and }(Result = AAltTerm)) then begin
        Break;
      end else if Result <> '' then begin
        AMsg.Headers.Append(Result);
      end;
    until False;
    AMsg.ProcessHeaders;
  finally EndWork(wmRead); end;
end;

procedure TIdMessageclient.ProcessMessage(AMsg: TIdMessage; AHeaderOnly: Boolean = False);
begin
  if IOHandler <> nil then begin
    //Don't call ReceiveBody if the message ended at the end of the headers
    //(ReceiveHeader() would have returned '.' in that case)...
    if ReceiveHeader(AMsg) = '' then begin
      if not AHeaderOnly then begin
        ReceiveBody(AMsg);
      end;
    end;
  end;
end;

procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; AStream: TStream; AHeaderOnly: Boolean = False);
begin
  IOHandler := TIdIOHandlerStreamMsg.Create(nil, AStream);
  try
    TIdIOHandlerStreamMsg(IOHandler).FreeStreams := False;
    IOHandler.Open;
    //Don't call ReceiveBody if the message ended at the end of the headers
    //(ReceiveHeader() would have returned '.' in that case)...
    if ReceiveHeader(AMsg) = '' then begin
      if not AHeaderOnly then begin
        ReceiveBody(AMsg);
      end;
    end;
  finally
    IOHandler.Free;
    IOHandler := nil;
  end;
end;

procedure TIdMessageClient.ProcessMessage(AMsg: TIdMessage; const AFilename: string; AHeaderOnly: Boolean = False);
var
  LStream: TFileStream;
begin
  LStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); try
    ProcessMessage(AMsg, LStream, AHeaderOnly);
  finally FreeAndNil(LStream); end;
end;

procedure TIdMessageClient.WriteBodyText(AMsg: TIdMessage);
var
  i: integer;
  LBodyLine: String;
begin
  for i := 0 to AMsg.Body.Count - 1 do begin
    LBodyLine := AMsg.Body[i];
    if Copy(AMsg.Body[i], 1, 1) = '.' then  {do not localize}
    begin
      IOHandler.WriteLn('.' + LBodyLine);   {do not localize}
    end
    else begin
      IOHandler.WriteLn(LBodyLine);
    end;
  end;
end;

destructor TIdMessageClient.Destroy;
begin
  inherited;
end;

end.