idmessage.pas

indy的原文件哈!大家可以下来参考和学习之用.也可以用以作组件.开发其他的应用程序.

  FReplyTo.Free;
  FSender.Free;
  FReceiptRecipient.Free;
  FMIMEBoundary.Free;
  inherited destroy;
end;

function TIdMessage.GenerateHeader: TIdHeaderList;
var
  ISOCharset: string;
  HeaderEncoding: Char;
  TransferHeader: TTransfer;
begin
  // TODO: Clean up
  MessageParts.CountParts;
  if Encoding = meMIME then begin
    TIdMessageEncoderInfo(MessageParts.MessageEncoderInfo).InitializeHeaders(Self);
    if Length(CharSet) > 0 then begin
      if Length(ContentType) = 0 then begin
        ContentType := 'charset="' + CharSet + '"';
      end else begin
        ContentType := ContentType + ';' + EOL + TAB + 'charset="' + CharSet + '"';
      end;
    end;
  end else begin
    // Check message parts
    with MessageParts do begin
      if (FRelatedPartCount > 0) or (FTextPartCount > 0) then begin
        raise EIdMessageException.Create(RSMsgClientInvalidEncoding);
      end;
    end;
  end;

  InitializeISO(TransferHeader, HeaderEncoding, ISOCharSet);
  DoInitializeISO(TransferHeader, HeaderEncoding, ISOCharSet);//APR
  Result := TIdHeaderList.Create;

  // added 2001-Oct-29 Don Siders insures use of headers received but not used in properties
  if (FHeaders.Count > 0) then begin
    Result.Assign(FHeaders);
  end;

  try
    with Result do
    begin
      Values['From'] := EncodeAddressItem(From, HeaderEncoding, TransferHeader, ISOCharSet); {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}
      {RL: do not include BCCList here}
      Values['Newsgroups'] := NewsGroups.CommaText; {do not localize}

      if Encoding = meMIME then
      begin
        Values['Content-Type'] := ContentType; {do not localize}
        if MessageParts.Count > 0 then begin
          Values['MIME-Version'] := '1.0'; {do not localize}
        end;
        Values['Content-Transfer-Encoding'] := ContentTransferEncoding; {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 fill the priority header if it's different from normal
      if Priority <> mpNormal then
        Values['X-Priority'] := IntToStr(Ord(Priority) + 1); {do not localize}

      // Add extra headers created by UA - allows duplicates
      if (FExtraHeaders.Count > 0) then
      begin
        AddStrings(FExtraHeaders);
      end;
    end;
  except
    FreeAndNil(Result);
    raise;
  end;
end;

procedure TIdMessage.ProcessHeaders;
var
  ABoundary: 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, ' '));
      Num := StrToIntDef(s, 3);
      Result := TIdMessagePriority(Num - 1);
    end;
  end;

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

begin
  ContentType := Headers.Values['Content-Type']; {do not localize}
  ExtractCharSet;

  ContentTransferEncoding := Headers.Values['Content-Transfer-Encoding']; {do not localize}
  ContentDisposition := Headers.Values['Content-Disposition'];
  Subject := DecodeHeader(Headers.Values['Subject']); {do not localize}
  From.Text := 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}
  {RL: 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;
  ABoundary := MIMEBoundary.FindBoundary(ContentType);
  MIMEBoundary.Push(ABoundary);
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';
  end else begin
    AttachmentEncoding := 'UUE';
  end;
end;

{ procedure TIdMessage.LoadFromFile(const AFileName: string; const AHeaderOnly: Boolean = False);
  var
    LMsgClient : TIdMessageClient;
  begin
    LMsgClient := TIdMessageClient.Create(self);
    try
      LMsgClient.ProcessMessage(Self, AFileName, AHeaderOnly);
    finally
      FreeAndNil(LMsgClient);
    end;
  end;  }

{ procedure TIdMessage.SaveToFile(AFileName: string);
  var
    LMsgClient : TIdMessageClient;
    LS : TFileStream;
    IOHandler : TIdIOHandlerStream;
  begin
    if FileExists(AFileName) then begin
      DeleteFile(AFileName);
    end;

    LS := TFileStream.create(AFileName, fmCreate);

    IOHandler := TIdIOHandlerStream.Create(nil);
    IOHandler.StreamType := stWrite;
    IOHandler.WriteStream := LS;

    try
      LMsgClient := TIdMessageClient.Create(nil);
      LMsgClient.IOHandler := IOHandler;
      LMsgClient.OpenWriteBuffer(32768);
      LMsgClient.SendMsg(Self);
      LMsgClient.WriteLn('.');
      LMsgClient.CloseWriteBuffer;
    finally
      FreeAndNil(LMsgClient);
      IOHandler.WriteStream.Free;
      FreeAndNil(IOHandler);
    end;
  end;  }

procedure TIdMessage.LoadFromFile(const AFileName: string; const AHeadersOnly: Boolean = False);
var
  vStream: TFileStream;
begin
  if (not FileExists(AFilename)) then
  begin
    raise EIdMessageCannotLoad.CreateFmt(RSIdMessageCannotLoad, [AFilename]);
  end;

  vStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(vStream, AHeadersOnly);
  finally
    vStream.Free;
  end;
end;

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

procedure TIdMessage.SaveToFile(const AFileName: string; const AHeadersOnly: Boolean = False);
var
  vStream : TFileStream;
begin
  if FileExists(AFileName) then
  begin
    DeleteFile(AFileName);
  end;

  vStream := TFileStream.create(AFileName, fmCreate);
  try
    SaveToStream(vStream, AHeadersOnly);
  finally
    vStream.Free;
  end;
end;

// TODO: Override TIdMessageClient.SendMsg to provide socket, stream, and file
// versions like TIdMessageClient.ProcessMessage?
procedure TIdMessage.SaveToStream(AStream: TStream;
 const AHeadersOnly: Boolean = False);
var
  LMsgClient: TIdMessageClient;
  LIOHS: TIdIOHandlerStream;
begin
  LMsgClient := TIdMessageClient.Create(nil);
  try
    LIOHS := TIdIOHandlerStream.Create(nil);
    try
      LIOHS.FreeStreams := False;
      LIOHS.OutputStream := AStream;
      LMsgClient.IOHandler := LIOHS;
      LMsgClient.OpenWriteBuffer(32768);

      {
        ds - the following is required with new Active property in IOHandler.

        Without Connect, IOHandler.Open is never called and a false
        ConnectionClosedGracefully is raised when trying to write to the
        Output stream.  This uses the same logic as used in
        TIdMessageClient.ProcessMessage.

        For stream IOHandlers, perhaps Open could be called in Create just like
        Close is called in the Destroy.
      }
      LMsgClient.Connect;
      try
        LMsgClient.SendMsg(Self, AHeadersOnly);
        // Add the end of message marker when body is included
        if AHeadersOnly = False then
        begin
          LMsgClient.WriteLn('.');
        end;
      finally
        LMsgClient.CloseWriteBuffer;
        {
          ds - the following is required with new Active property in IOHandler.
        }
        LMsgClient.Disconnect;
      end;
    finally
      FreeAndNil(LIOHS);
    end;
  finally
    FreeAndNil(LMsgClient);
  end;
end;

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

procedure TIdMessage.SetBccList(const AValue: TIdEmailAddressList);
begin
  FBccList.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
  FFrom.Assign(AValue);
end;

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

procedure TIdMessage.SetNewsGroups(const AValue: TStrings);
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;

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

initialization
  RegisterClasses([TIdAttachment, TIdText]);
end.