Generating Outlook Calendaring Event

Next code contains nice function for sending Outlook calendar event by SMTP. Good for creating and distributing calendar events from your applications.

It is good sample how to use tmimemess for sending mails too.

uses Classes, SysUtils, synautil, smtpsend, mimemess, 
mimepart, synachar, jcldatetime;
 
 
function SendMime(const SMTPHost, Username, Password: 
string; const Mime: TMimeMess): string;
var
   SMTP: TSMTPSend;
   s, t: string;
   sendOK: boolean;
begin
   Result := '';
   sendOK := false;
   SMTP := TSMTPSend.Create;
   try
// if you need SOCKS5 support, uncomment next lines:
     // SMTP.Sock.SocksIP := '127.0.0.1';
     // SMTP.Sock.SocksPort := '1080';
// if you need support for upgrade session to TSL/SSL, 
uncomment next lines:
     // SMTP.AutoTLS := True;
// if you need support for TSL/SSL tunnel, uncomment next lines:
     // SMTP.FullSSL := True;
     SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':'));
     s := Trim(SeparateRight(SMTPHost, ':'));
     if (s  '') and (s  SMTPHost) then
       SMTP.TargetPort := s;
     SMTP.Username := Username;
     SMTP.Password := Password;
     if SMTP.Login then
     begin
       if SMTP.MailFrom(GetEmailAddr(Mime.Header.From), 
Length(Mime.Lines.Text)) then
       begin
         s := Mime.Header.ToList.Text;
         repeat
           t := GetEmailAddr(Trim(FetchEx(s, ',', '"')));
           if t  '' then
             sendOK := SMTP.MailTo(t);
           if not sendOK then
             Break;
         until s = '';
         sendOK := SMTP.MailData(Mime.Lines);
         if (sendOK) then
         begin
           result := sendOKString;
         end
         else
         begin
           result := 'Send FAIL with error: "' + 
SMTP.ResultString + '"';
         end;
       end;
       SMTP.Logout;
     end;
   finally
     SMTP.Free;
   end;
end;
 
function ConvertToUTCDateString(const date: TDateTime): string;
begin
   DateTimeToString(result, 'yyyymmdd"T"hhnnss"Z"', 
DateTimeToLocalDateTime(date));
end;
 
  function SendMailCalendarEvent(const MailFrom, MailTo, 
Subject, SMTPHost, user, pass, Summary, Location, 
Description: string;
   const FromDate, ToDate : TDateTime): string;
var
   mime: TMimemess;
   mimePart, mimeHtml: TMimepart;
   i: integer;
   t: TStringList;
begin
   result := '';
   mime := TMimemess.create;
   t := TStringList.Create();
   t.Add('BEGIN:VCALENDAR');
     t.Add('PRODID:HourMailer');
     t.Add('VERSION:2.0');
     t.Add('METHOD:REQUEST');
     t.Add('BEGIN:VEVENT');
 
t.Add('ATTENDEE;ROLE=REQ-PARTICIPANT;RSVP=TRUE:MAILTO:' + 
MailTo);
       t.Add('ORGANIZER:MAILTO:' + MailFrom);
       t.Add('DTSTART:' + ConvertToUTCDateString(FromDate));
       t.Add('DTEND:' + ConvertToUTCDateString(ToDate));
       t.Add('TRANSP:OPAQUE');
       t.Add('SEQUENCE:0');
       t.Add('UID:' + ConvertToUTCDateString(Now) + 
'@HourMailer');
       t.Add('DTSTAMP:' + ConvertToUTCDateString(Now));
       t.Add('SUMMARY:' + CharsetConversion(Summary, 
GetCurCP, UTF_8));
       if not(Location = '') then
       begin
         t.Add('LOCATION:' + CharsetConversion(Location, 
GetCurCP, UTF_8));
       end;
       if not(description = '') then
       begin
         t.Add('DESCRIPTION:' + 
CharsetConversion(description, GetCurCP, UTF_8));
       end;
       t.Add('PRIORITY:5');
       t.Add('X-MICROSOFT-CDO-IMPORTANCE:1');
       t.Add('CLASS:PUBLIC');
       t.Add('BEGIN:VALARM');
         t.Add('TRIGGER:-PT15M');
         t.Add('ACTION:DISPLAY');
         t.Add('DESCRIPTION:Reminder');
       t.Add('END:VALARM');
     t.Add('END:VEVENT');
   t.Add('END:VCALENDAR');
   try
     mimePart := mime.AddPart(nil);
     with mimePart do
     begin
       t.SaveToStream(DecodedLines);
       Primary := 'text';
       Secondary := 'calendar; method=REQUEST';
       CharsetCode := GetCurCP;
       EncodingCode := ME_8BIT;
       EncodePart;
       CharsetCode := UTF_8;
       EncodePartHeader;
     end;
 
     mime.header.from := MailFrom;
     mime.header.tolist.add(MailTo);
     mime.header.subject := Subject;
     mime.EncodeMessage;
     result := SendMime(SMTPHost, user, pass, mime);
   finally
     mime.free;
     t.Free;
   end;
end;
public/howto/outlookevent.txt · Last modified: 2007/11/30 14:30 (external edit)
Driven by DokuWiki Recent changes RSS feed