Mega Code Archive

 

Categories / Delphi / Examples

 

Sending html emails with ics

procedure THtmlMailForm.SendButtonClick(Sender: TObject);begin if FRunning then begin MessageBeep(MB_OK); Display('**** ALREADY RUNNING ****'); Exit; end; FRunning := TRUE; try { Give the component the various data he need } HtmlSmtpClient.PlainText := PlainTextMemo.Lines; HtmlSmtpClient.HtmlText := HtmlTextMemo.Lines; HtmlSmtpClient.EmailImages := ImageFilesMemo.Lines; HtmlSmtpClient.EmailFiles := AttachedFilesMemo.Lines; { Initialize all SMTP component properties from our GUI } HtmlSmtpClient.Host := HostEdit.Text; HtmlSmtpClient.Port := PortEdit.Text; HtmlSmtpClient.SignOn := SignOnEdit.Text; HtmlSmtpClient.FromName := FromEdit.Text; HtmlSmtpClient.HdrFrom := FromEdit.Text; HtmlSmtpClient.HdrTo := ToEdit.Text; HtmlSmtpClient.HdrCc := CcEdit.Text; HtmlSmtpClient.HdrSubject := SubjectEdit.Text; HtmlSmtpClient.AuthType := smtpAuthNone; { Recipient list is computed from To, Cc and Bcc fields } HtmlSmtpClient.RcptName.Clear; HtmlSmtpClient.RcptNameAdd(ToEdit.Text, CcEdit.Text, BccEdit.text); if PlainTextCheckBox.Checked then HtmlSmtpClient.ContentType := smtpPlainText else HtmlSmtpClient.ContentType := smtpHtml; Display('Connecting to SMTP server...'); { Start first operation to do to send an email } { Next operations are started from OnRequestDone event } HtmlSmtpClient.Connect; except on E:Exception do begin Display(E.ClassName + ': ' + E.Message); FRunning := FALSE; end; end;end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}procedure THtmlMailForm.HtmlSmtpClientRequestDone( Sender : TObject; RqType : TSmtpRequest; ErrorCode : Word);begin { For every operation, we display the status } if (ErrorCode > 0) and (ErrorCode < 10000) then Display('RequestDone Rq=' + IntToStr(Ord(RqType)) + ' Error='+ HtmlSmtpClient.ErrorMessage) else Display('RequestDone Rq=' + IntToStr(Ord(RqType)) + ' Error='+ IntToStr(ErrorCode)); if not FRunning then Exit; { Start next operation, but first check if previous one was OK } if ErrorCode <> 0 then begin FRunning := FALSE; { Terminate All-In-One demo } Display('Error, stop.'); Exit; end; case RqType of smtpConnect: begin if HtmlSmtpClient.AuthType = smtpAuthNone then HtmlSmtpClient.Helo else HtmlSmtpClient.Ehlo; end; smtpHelo: HtmlSmtpClient.MailFrom; smtpEhlo: HtmlSmtpClient.Auth; smtpAuth: HtmlSmtpClient.MailFrom; smtpMailFrom: HtmlSmtpClient.RcptTo; smtpRcptTo: HtmlSmtpClient.Data; smtpData: HtmlSmtpClient.Quit; smtpQuit: begin Display('Done !'); FRunning := FALSE; end; end;end;