sending event email

[rlebeau]

sorry.  it is now attached.

Try this code instead:

Code:

unit dEmail;

interface

uses
  Vcl.Forms, System.SysUtils, Vcl.StdCtrls, Vcl.Buttons, Vcl.Controls, Vcl.ExtCtrls, Data.DB,
  Vcl.Dialogs, System.Classes, dbEmail;

type
  TdlgEmail = class(TForm)
    dlgOpen: TOpenDialog;
    reBody: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    mmAddresses: TMemo;
    Label2: TLabel;
    mmCarbon: TMemo;
    Label3: TLabel;
    mmBlindCarbon: TMemo;
    Label4: TLabel;
    edtSubject: TEdit;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    procedure btnOKClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    function emailMessage : boolean;
    procedure CreatePDFEmail;
  public
    { Public declarations }
    eventText : TStringList;
  end;

var
  dlgEmail: TdlgEmail;

implementation

{$R *.dfm}

uses
  idException, idAttachmentFile, idGlobalProtocols, idText;

procedure TdlgEmail.btnOKClick(Sender: TObject);
begin
  if (mmAddresses.Lines.Count = 0) and
    (mmCarbon.Lines.Count = 0) and
    (mmBlindCarbon.Lines.Count = 0) then
  begin
    ShowMessage('Please enter a valid email address');
  end
  else if dmEmail.SetupSMTP then
  begin
    if EmailMessage then
      ModalResult := mrOK;
  end;
end;

procedure TdlgEmail.FormCreate(Sender: TObject);
begin
  dmEmail := TdmEmail.Create(Self);
  eventText := TStringList.Create;
  eventText.LoadFromFile('testEvent.ics');
end;

procedure TdlgEmail.FormDestroy(Sender: TObject);
begin
  eventText.Free;
end;

procedure TdlgEmail.FormShow(Sender: TObject);
begin
  mmAddresses.SetFocus;

  mmCarbon.SetFocus;
  mmCarbon.SelStart := 0;//scroll back to top of memo
  mmCarbon.SelLength := 0;

  mmBlindCarbon.SetFocus;
  mmBlindCarbon.SelStart := 0;//scroll back to top of memo
  mmBlindCarbon.SelLength := 0;

  mmAddresses.SetFocus;
  mmAddresses.SelStart := 0;//scroll back to top of memo
  mmAddresses.SelLength := 0;
end;

function tdlgEmail.EmailMessage: boolean;
var
  x : integer;
begin
  Result := false;
  if dmEmail.SetupSMTP then
  begin
    CreatePDFEmail;
    Result := dmEmail.DoMail;
  end;
end;

procedure TdlgEmail.CreatePDFEmail;
var
  AlternativePartIdx: Integer;
  //Stream: TStream;
begin
  // let's not get too fancy here with CreateAttachment(), let's get a single Calendar
  // email working properly first, then add on to the code logic later as needed ...
 
  dmEmail.emMessage.Clear;

  dmEmail.emMessage.Recipients.EMailAddresses := mmAddresses.Lines.CommaText;
  dmEmail.emMessage.CCList.EMailAddresses := mmCarbon.Lines.CommaText;
  dmEmail.emMessage.BccList.EMailAddresses := mmBlindCarbon.Lines.CommaText;
  dmEmail.emMessage.Subject := edtSubject.Text;
  dmEmail.emMessage.UseNowForDate := True;
  dmEmail.emMessage.ContentType := 'multipart/mixed';

  if reBody.Lines.Count > 0 then
  begin
    with TIdText.Create(dmEmail.emMessage.MessageParts, nil) do
    begin
      ContentType := 'multipart/alternative';
      AlternativePartIdx := Index;
    end;
    with TIdText.Create(dmEmail.emMessage.MessageParts, reBody.Lines) do
    begin
      ContentType := 'text/plain';
      ParentPart := AlternativePartIdx;
    end;
  end else
    AlternativePartIdx := -1;

  with TIdText.Create(dmEMail.emMessage.Messageparts, eventText) do
  begin
    ContentType := 'text/calendar;method=REQUEST';
    ParentPart := AlternativePartIdx;
  end;

  with TIdAttachmentFile.Create(dmEmail.emMessage.MessageParts, 'testEvent.ics') do
  begin
    ContentDisposition := 'attachment';
    ContentType := 'text/calendar;method=REQUEST';
    ParentPart := -1;
  end;

  { alternatively, since you already have the .ICS file loaded in memory, you could use this instead:

  Stream := TStringStream.Create(eventText.Text, TEncoding.UTF8);
  try
    with TIdAttachmentMemory.Create(dmEmail.emMessage.MessageParts, Stream) do
    begin
      ContentDisposition := 'attachment';
      ContentType := 'text/calendar;method=REQUEST';
      ParentPart := -1;
    end;
  finally
    Stream.Free;
  end;

  or this:
 
  with TIdAttachmentMemory.Create(dmEmail.emMessage.MessageParts) do
  begin
    ContentDisposition := 'attachment';
    ContentType := 'text/calendar;method=REQUEST';
    ParentPart := -1;
    Stream := PrepareTempStream;
try
      WriteStringToStream(Stream, eventText.Text, IndyTextEncoding_UTF8);
finally
      FinishTempStream;
    end;
  end;
  }

  dmEmail.emMessage.SaveToFile('mail.txt');
end;

end.