idmessage.pas

来自「Indy控件的使用源代码」· PAS 代码 · 共 1,099 行 · 第 1/3 页

  FMessageParts.Free;
  FNewsGroups.Free;
  FHeaders.Free;
  FExtraHeaders.Free;
  FFrom.Free;
  FReplyTo.Free;
  FSender.Free;
  FReceiptRecipient.Free;
  FMIMEBoundary.Free;
  inherited destroy;
end;


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

procedure TIdMessage.SetNewsGroups(const Value: TStrings);
begin
  FNewsgroups.Assign(Value);
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}
      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}
  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;

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

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

procedure TIdMessage.SetUseNowForDate(const Value: Boolean);
begin
    Date := 0;
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.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.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.