Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
sending event email
#10
(08-30-2019, 03:00 PM)ccMcBride Wrote: 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.

Reply


Messages In This Thread
sending event email - by ccMcBride - 08-27-2019, 02:33 PM
RE: sending event email - by rlebeau - 08-27-2019, 06:19 PM
RE: sending event email - by ccMcBride - 08-28-2019, 02:30 PM
RE: sending event email - by rlebeau - 08-28-2019, 04:45 PM
RE: sending event email - by ccMcBride - 08-28-2019, 07:16 PM
RE: sending event email - by rlebeau - 08-28-2019, 08:19 PM
RE: sending event email - by ccMcBride - 08-29-2019, 03:12 PM
RE: sending event email - by rlebeau - 08-30-2019, 01:39 AM
RE: sending event email - by ccMcBride - 08-30-2019, 03:00 PM
RE: sending event email - by rlebeau - 08-30-2019, 05:30 PM
RE: sending event email - by ccMcBride - 09-03-2019, 05:46 PM
RE: sending event email - by rlebeau - 09-03-2019, 11:12 PM
RE: sending event email - by ccMcBride - 09-04-2019, 01:27 PM
RE: sending event email - by rlebeau - 09-04-2019, 07:46 PM
RE: sending event email - by ccMcBride - 09-05-2019, 03:07 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)