idmessage.pas

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

  end;

  with LastGeneratedHeaders do
  begin
    {CC: If From has no Name field, use the Address field as the Name field by setting last param to True (for SA)...}
    Values['From'] := EncodeAddress(FromList, HeaderEncoding, TransferHeader, ISOCharSet, True); {do not localize}
    Values['Subject'] := EncodeHeader(Subject, [], HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['To'] := EncodeAddress(Recipients, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['Cc'] := EncodeAddress(CCList, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    {CC: SaveToFile sets FGenerateBCCListInHeader to True so that BCC names are saved
     when saving to file and omitted otherwise (as required by SMTP)...}
    if FGenerateBCCListInHeader = False then begin
      Values['Bcc'] := ''; {do not localize}
    end else begin
      Values['Bcc'] := EncodeAddress(BCCList, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    end;
    Values['Newsgroups'] := NewsGroups.CommaText; {do not localize}
    if Encoding = meMIME then
    begin
      if DetermineIfMsgIsSinglePartMime = True then begin
        {This is a single-part MIME: the part may be a text part or an attachment.
        The relevant headers need to be taken from MessageParts[0].  The problem,
        however, is that we have not yet processed MessageParts[0] yet, so we do
        not have its properties or header content properly set up.
        So we will let the processing of MessageParts[0] append its headers to
        the message headers, i.e. DON'T generate Content-Type or Content-Transfer-Encoding
        headers here.}
        Values['MIME-Version'] := '1.0'; {do not localize}
      end else begin
        Values['Content-Type'] := ContentType;  {do not localize}
        if FCharSet > '' then begin
          Values['Content-Type'] := Values['Content-Type'] + ';' + EOL + TAB + 'charset="' + FCharSet + '"';  {do not localize}
        end;
        if MessageParts.Count > 0 then begin
          Values['Content-Type'] := Values['Content-Type'] + '; boundary="' + LMIMEBoundary + '"'; {do not localize}
        end;
        {CC2: We may have MIME with no parts if ConvertPreamble is True}
        Values['MIME-Version'] := '1.0'; {do not localize}
        Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
      end;
    end else begin
      //CC: non-MIME can have ContentTransferEncoding of base64, quoted-printable...
      Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {do not localize}
      Values['Content-Type'] := ContentType;  {do not localize}
    end;
    Values['Sender'] := Sender.Text; {do not localize}
    Values['Reply-To'] := EncodeAddress(ReplyTo, HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}
    Values['Organization'] := EncodeHeader(Organization, [], HeaderEncoding, TransferHeader, ISOCharSet); {do not localize}

    Values['Disposition-Notification-To'] := EncodeAddressItem(ReceiptRecipient, {do not localize}
      HeaderEncoding, TransferHeader, ISOCharSet);

    Values['References'] := References; {do not localize}

    if UseNowForDate then begin
      Values['Date'] := DateTimeToInternetStr(Now); {do not localize}
    end else begin
      Values['Date'] := DateTimeToInternetStr(Self.Date); {do not localize}
    end;

    // S.G. 27/1/2003: Only issue X-Priority header if priority <> mpNormal (for stoopid spam filters)
    if Priority <> mpNormal then begin
      Values['X-Priority'] := IntToStr(Ord(Priority) + 1) {do not localize}
    end else begin
      if IndexOfName('X-Priority') >= 0 then begin  {do not localize}
        delete(IndexOfName('X-Priority'));    {do not localize}
      end;
    end;

    // Add extra headers created by UA - allows duplicates
    if (FExtraHeaders.Count > 0) then begin
      AddStrings(FExtraHeaders);
    end;
    {Generate In-Reply-To if at all possible to pacify SA.  Do this after FExtraHeaders
     added in case there is a message-ID present as an extra header.}
    if InReplyTo = '' then begin
      if Values['Message-ID'] <> '' then begin  {do not localize}
        Values['In-Reply-To'] := Values['Message-ID'];  {do not localize}
      end else begin
        {CC: The following was originally present, but it so wrong that it has to go!
        Values['In-Reply-To'] := Subject;   {do not localize}
      end;
    end else begin
      Values['In-Reply-To'] := InReplyTo; {do not localize}
    end;
  end;
end;

function TIdMessage.ExtractCharSet(AContentType: string): string;
var
  s: string;
begin
  s := UpperCase(AContentType);
  Fetch(s, 'CHARSET='); {do not localize}
  if Copy(s, 1, 1) = '"' then begin {do not localize}
    Delete(s, 1, 1);
    Result := Fetch(s, '"'); {do not localize}
  // Sometimes its not in quotes
  end else begin
    Result := Fetch(s, ';');   {do not localize}
  end;
end;

procedure TIdMessage.ProcessHeaders;
var
  LBoundary: string;
  LMIMEVersion: string;

  // Some mailers send priority as text, number or combination of both
  function GetMsgPriority(Priority:string): TIdMessagePriority;
  var
    s: string;
    Num: integer;
  begin
    // This is for Pegasus.
    if IndyPos('urgent', LowerCase(Priority)) <> 0 then begin {do not localize}
      Result := mpHigh;
    end else if IndyPos('non-priority', LowerCase(Priority)) <> 0 then begin {do not localize}
      Result := mpLow;
    end else begin
      s := Trim(Priority);
      s := Trim(Fetch(s, ' '));   {do not localize}
      Num := StrToIntDef(s, 3);
      Result := TIdMessagePriority(Num - 1);
    end;
  end;

begin
  FContentType := Headers.Values['Content-Type']; {do not localize}
  if FContentType = '' then begin
    FContentType := 'text/plain';  {do not localize}
  end else begin
    FContentType := Trim(Fetch(FContentType, ';'));  {do not localize}
  end;
  FCharset := ExtractCharSet(Headers.Values['Content-Type']);  {do not localize}

  ContentTransferEncoding := Headers.Values['Content-Transfer-Encoding']; {do not localize}
  ContentDisposition := Headers.Values['Content-Disposition'];  {do not localize}
  Subject := DecodeHeader(Headers.Values['Subject']); {do not localize}
  FromList.EMailAddresses := DecodeHeader(Headers.Values['From']); {do not localize}
  MsgId := Headers.Values['Message-Id']; {do not localize}
  CommaSeparatedToStringList(Newsgroups, Headers.Values['Newsgroups']); {do not localize}
  Recipients.EMailAddresses := DecodeHeader(Headers.Values['To']); {do not localize}
  CCList.EMailAddresses := DecodeHeader(Headers.Values['Cc']); {do not localize}
  {CC2: Added support for BCCList...}
  BCCList.EMailAddresses := DecodeHeader(Headers.Values['Bcc']); {do not localize}
  Organization := Headers.Values['Organization']; {do not localize}
  ReceiptRecipient.Text := Headers.Values['Disposition-Notification-To']; {do not localize}

  if Length(ReceiptRecipient.Text) = 0 then begin
    ReceiptRecipient.Text := Headers.Values['Return-Receipt-To']; {do not localize}
  end;

  References := Headers.Values['References']; {do not localize}
  ReplyTo.EmailAddresses := Headers.Values['Reply-To']; {do not localize}
  Date := GMTToLocalDateTime(Headers.Values['Date']); {do not localize}
  Sender.Text := Headers.Values['Sender']; {do not localize}

  if Length(Headers.Values['Priority']) = 0 then begin {do not localize}
    Priority := GetMsgPriority(Headers.Values['X-Priority']) {do not localize}
  end else begin
    Priority := GetMsgPriority(Headers.Values['Priority']); {do not localize}
  end;
  {Note that the following code ensures MIMEBoundary.Count is 0 for single-part MIME messages...}
  LBoundary := MIMEBoundary.FindBoundary(Headers.Values['Content-Type']);  {do not localize}
  if LBoundary <> '' then begin
    MIMEBoundary.Push(LBoundary, -1);
  end;
  {CC2: Set MESSAGE_LEVEL "encoding" (really the format or layout)}
  LMIMEVersion := Headers.Values['MIME-Version']; {do not localize}
  if LMIMEVersion = '' then begin
    Encoding := mePlainText;
  end else begin
    Encoding := meMIME;
  end;
end;

procedure TIdMessage.SetBccList(const AValue: TIdEmailAddressList);
begin
  FBccList.Assign(AValue);
end;

procedure TIdMessage.SetBody(const AValue: TIdStrings);
begin
  FBody.Assign(AValue);
end;

procedure TIdMessage.SetCCList(const AValue: TIdEmailAddressList);
begin
  FCcList.Assign(AValue);
end;

procedure TIdMessage.SetExtraHeaders(const AValue: TIdHeaderList);
begin
  FExtraHeaders.Assign(AValue);
end;

procedure TIdMessage.SetFrom(const AValue: TIdEmailAddressItem);
begin
  GetFrom.Assign(AValue);
end;

function  TIdMessage.GetFrom: TIdEmailAddressItem;
begin
  if FFromList.Count = 0 then begin
    FFromList.Add;
  end;
  Result := FFromList[0];
end;

procedure TIdMessage.SetFromList(const AValue: TIdEmailAddressList);
begin
  FFromList.Assign(AValue);
end;

procedure TIdMessage.SetHeaders(const AValue: TIdHeaderList);
begin
  FHeaders.Assign(AValue);
end;

procedure TIdMessage.SetNewsGroups(const AValue: TIdStrings);
begin
  FNewsgroups.Assign(AValue);
end;

procedure TIdMessage.SetReceiptRecipient(const AValue: TIdEmailAddressItem);
begin
  FReceiptRecipient.Assign(AValue);
end;

procedure TIdMessage.SetRecipients(const AValue: TIdEmailAddressList);
begin
  FRecipients.Assign(AValue);
end;

procedure TIdMessage.SetReplyTo(const AValue: TIdEmailAddressList);
begin
  FReplyTo.Assign(AValue);
end;

procedure TIdMessage.SetSender(const AValue: TIdEmailAddressItem);
begin
  FSender.Assign(AValue);
end;

function TIdMessage.GetUseNowForDate: Boolean;
begin
  Result := (FDate = 0);
end;

procedure TIdMessage.SetUseNowForDate(const AValue: Boolean);
begin
  if GetUseNowForDate <> AValue then begin
    if AValue then begin
      FDate := 0;
    end else begin
      FDate := Now;
    end;
  end;
end;

procedure TIdMessage.SetAttachmentEncoding(const AValue: string);
begin
  MessageParts.AttachmentEncoding := AValue;
end;

function TIdMessage.GetAttachmentEncoding: string;
begin
  Result := MessageParts.AttachmentEncoding;
end;

procedure TIdMessage.SetEncoding(const AValue: TIdMessageEncoding);
begin
  FEncoding := AValue;
  if AValue = meMIME then begin
    AttachmentEncoding := 'MIME';    {do not localize}
  end else begin
    //Default to UUE for mePlainText, user can override to XXE by calling
    //TIdMessage.AttachmentEncoding := 'XXE';
    AttachmentEncoding := 'UUE';    {do not localize}
  end;
end;

procedure TIdMessage.LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False);
var
  LStream: TFileStream;
begin
  EIdMessageCannotLoad.IfFalse(FileExists(AFilename), Format(RSIdMessageCannotLoad, [AFilename]));
  LStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); try
    LoadFromStream(LStream, AHeadersOnly);
  finally FreeAndNil(LStream); end;
end;

procedure TIdMessage.LoadFromStream(AStream: TStream; const AHeadersOnly: Boolean = False);
begin
  // clear message properties, headers before loading
  Clear;
  with TIdMessageClient.Create do try
    ProcessMessage(Self, AStream, AHeadersOnly);
  finally Free; end;
end;

procedure TIdMessage.SaveToFile(const AFileName: string; const AHeadersOnly: Boolean = False);
var
  LStream : TFileStream;
begin
  LStream := TFileStream.Create(AFileName, fmCreate); try
    FGenerateBCCListInHeader := True; try
      SaveToStream(LStream, AHeadersOnly);
    finally FGenerateBCCListInHeader := False; end;
  finally FreeAndNil(LStream); end;
end;

procedure TIdMessage.SaveToStream(AStream: TStream; const AHeadersOnly: Boolean = False);
var
  LMsgClient: TIdMessageClient;
  LIOHandler: TIdIOHandlerStream;
begin
  LMsgClient := TIdMessageClient.Create(nil); try
    LIOHandler := TIdIOHandlerStream.Create(nil, nil, AStream); try
      LIOHandler.FreeStreams := False;
      LMsgClient.IOHandler := LIOHandler;
      LMsgClient.SendMsg(Self, AHeadersOnly);
      // add the end of message marker when body is included
      if not AHeadersOnly then begin
        LMsgClient.IOHandler.WriteLn('.');  {do not localize}
      end;
    finally FreeAndNil(LIOHandler); end;
  finally FreeAndNil(LMsgClient); end;
end;

procedure TIdMessage.DoInitializeISO(var VTransferHeader: TTransfer;
  var VHeaderEncoding: Char; var VCharSet: string);
Begin
  if Assigned(FOnInitializeISO) then begin
    FOnInitializeISO(VTransferHeader, VHeaderEncoding, VCharSet);//APR
  end;
End;//

procedure TIdMessage.InitializeISO(var VTransferHeader: TTransfer; var VHeaderEncoding: Char; var VCharSet: String);
Begin
  VTransferHeader := bit8;    { header part conversion type }
  VHeaderEncoding := 'B';     { base64 / quoted-printable }    {Do not Localize}
  VCharSet := IdCharsetNames[IdGetDefaultCharSet];

  // it's not clear when VHeaderEncoding should be Q not B.
  // Comments welcome on atozedsoftware.indy.general

  case IdGetDefaultCharSet of
    idcsISO_2022_JP : VTransferHeader := iso2022jp; { header needs conversion }
    idcsISO_8859_1 : VHeaderEncoding := 'Q';    {Do not Localize}
    idcsUNICODE_1_1 : VCharSet := IdCharsetNames[idcsUTF_8];
  else
    // nothing
  end;
  DoInitializeISO(VTransferHeader, VHeaderEncoding, VCharSet);
End;

procedure TIdMessage.DoCreateAttachment(const AHeaders: TIdStrings;
  var VAttachment: TIdAttachment);
begin
  VAttachment := nil;
  if Assigned(FOnCreateAttachment) then begin
    FOnCreateAttachment(Self, AHeaders, VAttachment);
  end;
  if VAttachment = nil then begin
    VAttachment := TIdAttachmentFile.Create(Self.MessageParts);
  end;
end;

function TIdMessage.IsBodyEncodingRequired: Boolean;
var
  i,j: Integer;
  S: String;
Begin
  Result := FALSE;//7bit
  for i:= 0 to FBody.Count - 1 do begin
    S := FBody[i];
    for j := 1 to Length(S) do begin
      if S[j] > #127 then begin
        Result := TRUE;
        EXIT;
      end;
    end;
  end;
End;//

function TIdMessage.GetInReplyTo: String;
begin
  Result := FixUpMsgID(FInReplyTo);
end;

procedure TIdMessage.SetInReplyTo(const AValue: String);
begin
  FInReplyTo := FixUpMsgID(AValue);
end;

function TIdMessage.FixUpMsgID(const AValue: String): String;
begin
  Result := AValue;
  if (Length(Result) > 0) then begin
    if (Result[1] <> '<') then begin
      Result := '<' + Result;
    end;
    if (Result[Length(Result)] <> '>') then begin
      Result := Result + '>';
    end;
  end;
end;

procedure TIdMessage.SetMsgID(const AValue: String);
begin
  FMsgId := FixUpMsgID(AValue);
end;

end.