idmessagecodermime.pas

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

    by the body encoded in base64 or quoted-printable.  The problem with this type
    is that the header may state it as MIME, but the MIME parts and their headers
    will be encoded, so we won't find them - in this case, we will later take
    all the info we need from the message header, and not try to take it from
    the part header.}
    if (TIdMessage(AOwner).ContentTransferEncoding <> '') and
      {CC2: added 8bit below, changed to TextIsSame.  Reason is that many emails
      set the Content-Transfer-Encoding to 8bit, have multiple parts, and display
      the part header in plain-text.}
      (not TextIsSame(TIdMessage(AOwner).ContentTransferEncoding, '8bit')) and  {do not localize}
      (not TextIsSame(TIdMessage(AOwner).ContentTransferEncoding, '7bit')) and  {do not localize}
      (not TextIsSame(TIdMessage(AOwner).ContentTransferEncoding, 'binary'))    {do not localize}
      then
    begin
      FBodyEncoded := True;
    end;
  end;
end;

constructor TIdMessageDecoderMIME.Create(AOwner: TComponent; const ALine: string);
begin
  Create(AOwner);
  FFirstLine := ALine;
end;

function TIdMessageDecoderMIME.ReadBody(ADestStream: TIdStream; var VMsgEnd: Boolean): TIdMessageDecoder;
var
  LContentTransferEncoding: string;
  LDecoder: TIdDecoder;
  LLine: string;
  LBuffer: string;  //Needed for binhex4 because cannot decode line-by-line.
  LIsThisTheFirstLine: Boolean; //Needed for binary encoding
  BoundaryStart, BoundaryEnd: string;
  IsBinaryContentTransferEncoding: Boolean;
begin
  LIsThisTheFirstLine := True;
  VMsgEnd := False;
  Result := nil;
  if FBodyEncoded then begin
    LContentTransferEncoding := TIdMessage(Owner).ContentTransferEncoding;
  end else begin
    LContentTransferEncoding := FHeaders.Values['Content-Transfer-Encoding']; {Do not Localize}
    if LContentTransferEncoding = '' then begin
      LContentTransferEncoding := FHeaders.Values['Content-Type']; {Do not Localize}
      if TextIsSame(Copy(LContentTransferEncoding, 1, 24), 'application/mac-binhex40') then begin  {Do not Localize}
        LContentTransferEncoding := 'binhex40'; {do not localize}
      end;
    end;
  end;
  if TextIsSame(LContentTransferEncoding, 'base64') then begin {Do not Localize}
    LDecoder := TIdDecoderMIME.Create(nil);
  end else if TextIsSame(LContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
    LDecoder := TIdDecoderQuotedPrintable.Create(nil);
  end else if TextIsSame(LContentTransferEncoding, 'binhex40') then begin {Do not Localize}
    LDecoder := TIdDecoderBinHex4.Create(nil);
  end else begin
    LDecoder := nil;
  end;
  try
    if LDecoder <> nil then begin
      LDecoder.DecodeBegin(ADestStream);
    end;

    BoundaryStart := '--' + MIMEBoundary; {Do not Localize}
    BoundaryEnd := BoundaryStart + '--'; {Do not Localize}
    IsBinaryContentTransferEncoding := TextIsSame(LContentTransferEncoding, 'binary'); {do not localize}

    repeat
      if FFirstLine = '' then begin // TODO: Improve this. Not very efficient
        if IsBinaryContentTransferEncoding then begin
          //For binary, need EOL because the default LF causes spurious CRs in the output...
          LLine := ReadLn(EOL);
        end else begin
          LLine := ReadLn;
        end;
      end else begin
        LLine := FFirstLine;
        FFirstLine := '';    {Do not Localize}
      end;
      if LLine = '.' then begin // Do not use ADELIM since always ends with . (standard) {Do not Localize}
        VMsgEnd := True;
        Break;
      end;
      // New boundary - end self and create new coder
      if MIMEBoundary <> '' then begin
        if TextIsSame(LLine, BoundaryStart) then begin
          Result := TIdMessageDecoderMIME.Create(Owner);
          Break;
        // End of all coders (not quite ALL coders)
        end
        else if TextIsSame(LLine, BoundaryEnd) then begin
          // POP the boundary
          if Owner is TIdMessage then begin
            TIdMessage(Owner).MIMEBoundary.Pop;
          end;
          Break;
        // Data to save, but not decode
        end else if LDecoder = nil then begin
          if (LLine <> '') and (LLine[1] = '.') then begin // Process . in front for no encoding    {Do not Localize}
            Delete(LLine, 1, 1);
          end;
          if IsBinaryContentTransferEncoding then begin {do not localize}
            //In this case, we have to make sure we dont write out an EOL at the
            //end of the file.
            if LIsThisTheFirstLine then begin
              ADestStream.Write(LLine);
              LIsThisTheFirstLine := False;
            end else begin
              ADestStream.Write(EOL);
              ADestStream.Write(LLine);
            end;
          end else begin
            LLine := LLine + EOL;
            ADestStream.Write(LLine);
          end;
        // Data to decode
        end else begin
          // For TIdDecoderQuotedPrintable, we have to make sure all EOLs are
          // intact
          if LDecoder is TIdDecoderQuotedPrintable then begin
            LDecoder.Decode(LLine + EOL);
          end else if LDecoder is TIdDecoderBinHex4 then begin
            //We cannot decode line-by-line because lines don't have a whole
            //number of 4-byte blocks due to the : inserted at the start of
            //the first line, so buffer the file...
            LBuffer := LBuffer + LLine;
          end else if LLine <> '' then begin
            LDecoder.Decode(LLine);
          end;
        end;
      end else begin  {CC3: Added "else" for QP and base64 encoded message BODIES}
        // For TIdDecoderQuotedPrintable, we have to make sure all EOLs are
        // intact
        if LDecoder is TIdDecoderQuotedPrintable then begin
          LDecoder.Decode(LLine + EOL);
        end else if LDecoder = nil then begin
          if (LLine <> '') and (LLine[1] = '.') then begin // Process . in front for no encoding    {Do not Localize}
            Delete(LLine, 1, 1);
          end;
          LLine := LLine + EOL;
          ADestStream.Write(LLine);
        end else if LLine <> '' then begin
          LDecoder.Decode(LLine);
        end;
      end;
    until False;
    if LDecoder <> nil then begin
      if LDecoder is TIdDecoderBinHex4 then begin
        //Now decode the complete block...
        LDecoder.Decode(LBuffer);
      end;
      LDecoder.DecodeEnd;
    end;
  finally FreeAndNil(LDecoder); end;
end;

function TIdMessageDecoderMIME.GetAttachmentFilename(AContentType, AContentDisposition: string): string;
var
  LValue: string;
  LPos: Integer;
begin
  LPos := IndyPos('FILENAME=', UpperCase(AContentDisposition));  {do not localize}
  if LPos > 0 then begin
    LValue := Trim(Copy(AContentDisposition, LPos + 9, MaxInt));
  end else begin
    LValue := ''; //FileName not found
  end;
  if Length(LValue) = 0 then begin
    // Get filename from Content-Type
    LPos := IndyPos('NAME=', UpperCase(AContentType)); {do not localize}
    if LPos > 0 then begin
      LValue := Trim(Copy(AContentType, LPos + 5, MaxInt));    {do not localize}
    end;
  end;
  if Length(LValue) > 0 then begin
    if LValue[1] = '"' then begin    {do not localize}
      // RLebeau - shouldn't this code use AnsiExtractQuotedStr() instead?
      Fetch(LValue, '"');    {do not localize}
      Result := Fetch(LValue, '"');    {do not localize}
    end else begin
      // RLebeau - just in case the name is not the last field in the line
      Result := Fetch(LValue, ';'); {do not localize}
    end;
    Result := RemoveInvalidCharsFromFilename(DecodeHeader(Result));
  end else begin
    Result := '';
  end;
end;

procedure TIdMessageDecoderMIME.CheckAndSetType(AContentType, AContentDisposition: string);
var
  LDisposition, LFileName: string;
begin
  LDisposition := Fetch(AContentDisposition, ';');    {Do not Localize}

  {The new world order: Indy now defines a TIdAttachment as a part that either has
  a filename, or else does NOT have a ContentType starting with text/ or multipart/.
  Anything left is a TIdText.}

  //WARNING: Attachments may not necessarily have filenames!
  LFileName := GetAttachmentFilename(AContentType, AContentDisposition);

  if TextIsSame(LDisposition, 'attachment') or (Length(LFileName) > 0) then begin {Do not Localize}
    {A filename is specified, so irrespective of type, this is an attachment...}
    FPartType := mcptAttachment;
    FFilename := LFileName;
  end else begin
    {No filename is specified, so see what type the part is...}
    if TextIsSame(Copy(AContentType, 1, 5), MIMEGenericText) or
      TextIsSame(Copy(AContentType, 1, 10), MIMEGenericMultiPart) then
    begin
      FPartType := mcptText;
    end else begin
      FPartType := mcptAttachment;
    end;
  end;
end;

procedure TIdMessageDecoderMIME.ReadHeader;
var
  ABoundary,
  s: string;
  LLine: string;
begin
  if FBodyEncoded then begin // Read header from the actual message since body parts don't exist    {Do not Localize}
    CheckAndSetType(TIdMessage(Owner).ContentType, TIdMessage(OWner).ContentDisposition);
  end else begin
    // Read header
    repeat
      LLine := ReadLn;
      if LLine = '.' then begin // TODO: abnormal situation (Masters!)    {Do not Localize}
        FPartType := mcptUnknown;
        Exit;
      end;//if
      if LLine = '' then begin
        Break;
      end;
      if CharIsInSet(LLine, 1, LWS) then begin
        if FHeaders.Count > 0 then begin
          FHeaders[FHeaders.Count - 1] := FHeaders[FHeaders.Count - 1] + ' ' + Copy(LLine, 2, MaxInt);    {Do not Localize}
        end else begin
          //Make sure you change 'Content-Type :' to 'Content-Type:'
          FHeaders.Add(StringReplace(StringReplace(Copy(LLine,2,MaxInt),': ','=',[]),' =','=',[])); {Do not Localize}
        end;
      end else begin
        //Make sure you change 'Content-Type :' to 'Content-Type:'
        FHeaders.Add(StringReplace(StringReplace(LLine,': ','=',[]),' =','=',[]));    {Do not Localize}
      end;
    until False;
    s := FHeaders.Values['Content-Type'];    {do not localize}
    //CC: Need to detect on "multipart" rather than boundary, because only the
    //"multipart" bit will be visible later...
    if TextIsSame(Copy(s, 1, 10), 'multipart/') then begin  {do not localize}
      ABoundary := TIdMIMEBoundary.FindBoundary(s);
      if Owner is TIdMessage then begin
        if Length(ABoundary) > 0 then begin
          TIdMessage(Owner).MIMEBoundary.Push(ABoundary, TIdMessage(Owner).MessageParts.Count);
          // Also update current boundary
          FMIMEBoundary := ABoundary;
        end else begin
          //CC: We are in trouble.  A multipart MIME Content-Type with no boundary?
          //Try pushing the current boundary...
          TIdMessage(Owner).MIMEBoundary.Push(FMIMEBoundary, TIdMessage(Owner).MessageParts.Count);
        end;
      end;
    end;
    CheckAndSetType(FHeaders.Values['Content-Type'],    {do not localize}
      FHeaders.Values['Content-Disposition']);    {do not localize}
  end;
end;

function TIdMessageDecoderMIME.RemoveInvalidCharsFromFilename(const AFilename: string): string;
var
  LN: integer;
begin
  Result := AFilename;
  //First, strip any Windows or Unix path...
  for LN := Length(Result) downto 1 do begin
    if ((Result[LN] = '/') or (Result[LN] = '\')) then begin  {do not localize}
      Result := Copy(Result, LN+1, MAXINT);
      break;
    end;
  end;
  //Now remove any invalid filename chars.
  //Hmm - this code will be less buggy if I just replace them with _
  for LN := 1 to Length(Result) do begin
    if Pos(Result[LN], ValidWindowsFilenameChars) = 0 then begin
      Result[LN] := '_';    {do not localize}
    end;
  end;
end;

{ TIdMessageEncoderInfoMIME }

constructor TIdMessageEncoderInfoMIME.Create;
begin
  inherited;
  FMessageEncoderClass := TIdMessageEncoderMIME;
end;

procedure TIdMessageEncoderInfoMIME.InitializeHeaders(AMsg: TIdMessage);
begin
  {CC2: The following logic does not work - it assumes that just because there
  are related parts, that the message header is multipart/related, whereas it
  could be multipart/related inside multipart/alternative, plus there are other
  issues.
  But...it works on simple emails, and it is better than throwing an exception.
  User must specify the ContentType to get the right results.}
  {CC4: removed addition of boundaries; now added at GenerateHeader stage (could
  end up with boundary added more than once)}
  if AMsg.ContentType = '' then begin
    if AMsg.MessageParts.RelatedPartCount > 0 then begin
      AMsg.ContentType := 'multipart/related; type="multipart/alternative"';  //; boundary="' + {do not localize}
    end else begin
      if AMsg.MessageParts.AttachmentCount > 0 then begin
        AMsg.ContentType := 'multipart/mixed'; //; boundary="' {do not localize}
      end else begin
        if AMsg.MessageParts.TextPartCount > 0 then begin
          AMsg.ContentType := 'multipart/alternative';  //; boundary="' {do not localize}
        end;
      end;
    end;
  end;
end;

{ TIdMessageEncoderMIME }

procedure TIdMessageEncoderMIME.Encode(ASrc: TIdStreamRandomAccess; ADest: TIdStream);
var
  s: string;
  LEncoder: TIdEncoderMIME;
  LSPos, LSSize : Int64;
begin
  ASrc.Position := 0;
  LSPos := 0;
  LSSize := ASrc.Size;
  LEncoder := TIdEncoderMIME.Create(nil); try
    while LSPos < LSSize do begin
      s := LEncoder.Encode(ASrc, 57) + EOL;
      Inc(LSPos,57);
      ADest.Write(s);
    end;
  finally FreeAndNil(LEncoder); end;
end;

initialization
  TIdMessageDecoderList.RegisterDecoder('MIME'    {Do not Localize}
   , TIdMessageDecoderInfoMIME.Create);
  TIdMessageEncoderList.RegisterEncoder('MIME'    {Do not Localize}
   , TIdMessageEncoderInfoMIME.Create);
  IdMIMEBoundaryStrings := TIdMIMEBoundaryStrings.Create;
finalization
  IdMIMEBoundaryStrings.Free;
  IdMIMEBoundaryStrings := nil;  {Global vars always initialised to 0, not nil}
end.