Besprechnungsanfrage (iCalendar)

[tdroese]

Hallo Forum,

ein paar Tage und Nächte später - ein Ergebnis, mit dem ich vorerst glücklich bin. Die Besprechungsanfragen werden nun sauber von Outlook, Lotus Notes und Strato Communicator als solche erkannt und verarbeitet.

Für den Fall das der ein oder andere auch schon ein paar Tage vergeblich nach einer Lösung sucht, habe ich den Quellcode noch einmal angehängt.

Danke noch einmal für die Kommentare auf dem Weg zum Ziel!

Delphi-Quellcode:

{
  Projekt: Besprechungseinladung
  ===============================

  Dieses Projekt erzeugt mittels der Komponenten IdMessage und IdSMTP eine Besprechungsanfrage
  im iCalendar-Standard und sendet sie über SMTP an einen beliebigen Empfänger.

  Die Übertragung erfolgt in diesem Fall via SSLTLS verschlüsselt oder unverschlüsselt. Die
  Paramenter dafür sind "cdUseTLS", "cdSSLConnection" und "cdPort".

  Bei diesem Programm handelt es sich um eine simple Testversion die lediglich ein einfaches
  Form nutzt. Neben der Form gibt es lediglich ein TButton welches auf das "OnClick"-Ereignis
  auslöst.

  Funktioniert (getestet) mit Outlook, Lotus Notes und Strato Communicator..

  Hinweise/Verbesserungen gern an: delphi(a-t)index-consulting.de
}

unit Mainform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdMessage, IdSMTP, IdSSLOpenSSL, IdSASLLogin, IdSASLExternal,
  IdUserPassProvider, IdSASL_CRAM_MD5, IdSASL_CRAM_SHA1, IdSASLPlain, IdGlobal,
  IdSASLSKey, IdSASLOTP, IdSASLAnonymous, IdComponent, IdTCPClient, StdCtrls,
  IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,  IdTCPConnection;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
   TCalendarData = class
     cdHost: string;                 //Strato: smtp.strato.de
     cdAccount: string;              //Mr. T's Mailaccount
     cdPort: integer;                //Strato: 465 or 587
     cdUseTLS: boolean;              //TLS nutzen (Ja/Nein)
     cdSSLConnection: boolean;       //Strato: True
     cdTransferEmail: string;        //Strato: [e-mail]
     cdUser: string;                 //Strato: [e-mail]
     cdPass: string;                 //Strato: Strato Password
     cdOrganizer: string;            //Organisator
     cdAttendee: string;             //Empfänger
     cdAppointmentStart: TDateTime;  //Anfang Termin
     cdAppointmentEnd: TDateTime;    //Ende Termin
     cdSummary: string;              //Betreff
     cdLocation: string;             //Ort
     cdSequence: integer;            //Anzahl Anfragen/Änderungenen
     cdBody: TStringList;            //Body (Mail)
     cdDescription: string;          //Beschreibung (Termin)
     cdPriority: TIdMessagePriority; //Prioriät
     procedure CreateInvitation(IdMessage: TIdMessage);
     function FoldLines(Input: string; FoldAt: integer; IntentChar: Byte) : string;
     constructor Create;
     destructor Destroy; override;
   end;

var
  Form1: TForm1;
  cd: TCalendarData;

implementation

{$R *.dfm}

constructor TCalendarData.Create;
begin
   inherited;
   cdBody := TStringList.Create;
end;

destructor TCalendarData.Destroy;
begin
   cdBody.Free;
   inherited;
end;

procedure TCalendarData.CreateInvitation(IdMessage: TIdMessage);
begin
  with cd.cdBody do
  begin
    //Den Body der Mail im Typ "Text/Calendar" erzeugen
    Add('BEGIN:VCALENDAR');
    Add('VERSION:2.0');
    //Produkt - Softwarename
    Add('PRODID:-//INDEX Consulting GmbH//LeanCredit MIMEDIR//DE');
    Add('METHOD:REQUEST');
    //Zeitzone festlegen
    Add('BEGIN:VTIMEZONE');
    Add('TZID:W. Europe Standard Time');
    //Sommerzeit
    Add('BEGIN:STANDARD');
    Add('DTSTART:16011028T030000');
    Add('RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=10');
    Add('TZOFFSETFROM:+0200');
    Add('TZOFFSETTO:+0100');
    Add('END:STANDARD');
    //Winterzeit
    Add('BEGIN:DAYLIGHT');
    Add('DTSTART:16010325T020000');
    Add('RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=3');
    Add('TZOFFSETFROM:+0100');
    Add('TZOFFSETTO:+0200');
    Add('END:DAYLIGHT');
    Add('END:VTIMEZONE');
    //Das eigentliche Event "Besprechung" konstruieren
    //Organisator + Empfänger
    Add('BEGIN:VEVENT');
    Add('ORGANIZER;CN=' + FoldLines(cdAccount + ':MAILTO:' + cdOrganizer, 70, 9));
    Add('ATTENDEE;CN=' + FoldLines(cdAttendee + ';RSVP=TRUE:mailto:' + cdAttendee, 70, 9));
    //Betreff + Besprechungsort
    Add('SUMMARY:' + FoldLines(cdSummary, 70, 9));
    Add('LOCATION;ENCODING=QUOTED-PRINTABLE:' + cdLocation);
    //Blockt den Kalender, auch wenn bereits ein Termin vorhanden ist.
    Add('TRANSP:OPAQUE');
    //Beschreibung der Anfrage + Anzahl der Änderungen (Neu = 0)
    Add('DESCRIPTION:' + FoldLines(cdDescription, 70, 9));
    Add('SEQUENCE:' + IntToStr(cdSequence));
    Add('CLASS:PUBLIC');
    //User-ID um die Besprechung in der Datenbank zu identifizieren
    Add('UID:900567890' + FormatDateTime('HHMMSS', cdAppointmentStart));
    //Beginn und Ende des Termins
    //Ergänzt man hinter der Uhrzeit noch "Z", dann handelt es sich um UTC-Zeiten
    //so nimmt das Mailprogramm die Nachricht mit "Ortszeit" entgegen.
    Add('DTSTART:' + FormatDateTime('YYYYMMDD"T"HHMMSS', cdAppointmentStart));
    Add('DTEND:' + FormatDateTime('YYYYMMDD"T"HHMMSS', cdAppointmentEnd));
    //Erstellungs- und Signaturdatum
    Add('CREATED:' + FormatDateTime('YYYYMMDD"T"HHMMSS', Now));
    Add('DTSTAMP:' + FormatDateTime('YYYYMMDD"T"HHMMSS', Now));
    //Alarm setzten (also 15 Minuten vor Termin warnen '-PT15M')
    Add('BEGIN:VALARM');
    Add('TRIGGER:-PT15M');
    Add('ACTION:DISPLAY');
    //Beschreibung der Erinnerung
    Add('DESCRIPTION:Reminder');
    Add('END:VALARM');
    Add('END:VEVENT');
    Add('END:VCALENDAR');
  end;
  //An die Message übergeben
  IdMessage.Body := cd.cdBody;
end; //TCalendarData.CreateInvitation


function TCalendarData.FoldLines(Input: string; FoldAt: integer; IntentChar: Byte) : string;
//Diese Funktion bricht Zeilen nach "x" Zeichen um. Dies ist lt. RFC5545 Section 3.1 unter
//dem Punkt "Content Lines" beschrieben.
var
  i: integer;
begin
  i := 1;
  //Ersetzte alle Zeichenumbrüche durch "\n"
  Input := StringReplace(Input, sLineBreak, '\n', [rfReplaceAll]);
  //Nun erfolgt der Umbruch im Text
  while i < Length(Input) do
  begin
    //Zeilen "falten"..
    if i = 1 then
      Result := Result + Copy(Input, i, FoldAt)
    else
      Result := Result + sLineBreak + Chr(IntentChar) + Copy(Input, i, FoldAt);
    i := i + FoldAt;
    if i < Length(Input) then Result := Result;
  end; //i < Length(Input) do
end;//BreakLines


procedure SendCalendarRequest(CD: TCalendarData);
var
   SMTP: TIdSMTP;
   IdMessage: TIdMessage;
   SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
   IdUserPassProvider: TIdUserPassProvider;
   IdSASLCRAMMD5: TIdSASLCRAMMD5;
   IdSASLCRAMSHA1: TIdSASLCRAMSHA1;
   IdSASLPlain: TIdSASLPlain;
   IdSASLLogin: TIdSASLLogin;
   IdSASLSKey: TIdSASLSKey;
   IdSASLOTP: TIdSASLOTP;
   IdSASLAnonymous: TIdSASLAnonymous;
   IdSASLExternal: TIdSASLExternal;

begin
   IdMessage := TIdMessage.Create(nil);
   try
     with IdMessage, cd do
     begin
       //Header setzen
       ContentType := 'text/calendar; method=REQUEST';
       ContentTransferEncoding := '7bit';
       Encoding := meMIME;
       Charset := 'utf-8';
       //Absender
       From.Name := cdAccount;
       From.Address := cdOrganizer;
       //Empfänger, Priorität + Betreff
       Recipients.EMailAddresses := cdAttendee;
       Priority := cdPriority;
       Subject := cdSummary;
     end; //with IdMessage, md
     //Anlage Besprechnungsanfrage erzeugen
     cd.CreateInvitation(IdMessage);
     SMTP := TIdSMTP.Create(nil);
     try
       if cd.cdSSLConnection = true then
       begin
         SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(SMTP);
         with SSLHandler do
         begin
           MaxLineAction := maException;
           SSLOptions.Method := sslvTLSv1;
           SSLOptions.Mode := sslmClient;
           SSLOptions.VerifyMode := [];
           SSLOptions.VerifyDepth := 0;
         end; //with SSLHandler
         SMTP.IOHandler := SSLHandler;
         if cd.cdUseTLS = true then
           SMTP.UseTLS := utUseImplicitTLS
         else
           SMTP.UseTLS := utUseExplicitTLS;
       end;
       if (cd.cdUser <> '') or (cd.cdPass <> '') then
       begin
         if cd.cdUseTLS = true then
           SMTP.AuthType := satSASL
         else
           SMTP.AuthType := satDefault;
         IdUserPassProvider := TIdUserPassProvider.Create(SMTP);
         IdUserPassProvider.Username := cd.cdUser;
         IdUserPassProvider.Password:= cd.cdPass;
         IdSASLCRAMSHA1 := TIdSASLCRAMSHA1.Create(SMTP);
         IdSASLCRAMSHA1.UserPassProvider := IdUserPassProvider;
         IdSASLCRAMMD5 := TIdSASLCRAMMD5.Create(SMTP);
         IdSASLCRAMMD5.UserPassProvider := IdUserPassProvider;
         IdSASLSKey := TIdSASLSKey.Create(SMTP);
         IdSASLSKey.UserPassProvider := IdUserPassProvider;
         IdSASLOTP := TIdSASLOTP.Create(SMTP);
         IdSASLOTP.UserPassProvider := IdUserPassProvider;
         IdSASLAnonymous := TIdSASLAnonymous.Create(SMTP);
         IdSASLExternal := TIdSASLExternal.Create(SMTP);
         IdSASLLogin := TIdSASLLogin.Create(SMTP);
         IdSASLLogin.UserPassProvider := IdUserPassProvider;
         IdSASLPlain := TIdSASLPlain.Create(SMTP);
         IdSASLPlain.UserPassProvider := IdUserPassProvider;
         SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMSHA1;
         SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMMD5;
         SMTP.SASLMechanisms.Add.SASL := IdSASLSKey;
         SMTP.SASLMechanisms.Add.SASL := IdSASLOTP;
         SMTP.SASLMechanisms.Add.SASL := IdSASLAnonymous;
         SMTP.SASLMechanisms.Add.SASL := IdSASLExternal;
         SMTP.SASLMechanisms.Add.SASL := IdSASLLogin;
         SMTP.SASLMechanisms.Add.SASL := IdSASLPlain;
       end
       else
       begin
         SMTP.AuthType := satNone;
       end;
       SMTP.Host := cd.cdHost;
       SMTP.Port := cd.cdPort;
       SMTP.ConnectTimeout := 30000;
       SMTP.UseEHLO := True;
       SMTP.Connect;
       try
         try
           SMTP.Send(IdMessage);
         except
           on e: Exception do
           begin
             MessageBox(Form1.Handle, PChar(e.Message), PChar('Übertragungsfehler'), MB_OK + MB_ICONHAND);
             exit;
           end;
         end;
       finally
         SMTP.Disconnect;
       end; //try..finally
     finally
       SMTP.Free;
     end; //try..finally
   finally
     IdMessage.Free;
   end; //try..finally
end; //SendCalendarRequest


procedure TForm1.Button1Click(Sender: TObject);
begin
   //Sende Besprechungseinladungen
   cd := TCalendarData.Create();
   with cd do
   begin
     cdHost := 'smtp.strato.de';
     cdAccount := 'Auto Calendar';                               //Mr. T's Mailaccount
     cdPort := 465;                                              //Strato: 465 or 587
     cdUseTLS := true;                                           //Strato: True
     cdSSLConnection := true;                                    //Strato: True
     cdTransferEmail := '[e-mail]';           //Strato: [e-mail]
     cdUser := 'Username';                                       //Benutzername         
     cdPass := 'Password';                                       //Passwort
     cdOrganizer := '[e-mail]';               //Organisator
     cdAttendee := '[e-mail]';       //Empfänger
     cdAppointmentStart := StrToDateTime('24.12.2013 16:00:00'); //Anfang Termin
     cdAppointmentEnd := StrToDateTime('24.12.2013 19:00:00');   //Ende Termin
     cdSummary := 'Weihnachtliche Bescherung';                   //Betreff
     cdLocation := 'Unter dem Weihnachtsbaum';                   //Ort
     cdSequence := 0;                                            //0 = Erster Termin
     //Beschreibung
     cdDescription := 'Lines of text SHOULD NOT be longer than 75 octets, excluding the line' + sLineBreak +
                      'break. Long content lines SHOULD be split into a multiple line' + sLineBreak +
                      'representations using a line "folding" technique.  That is, a long' + sLineBreak +
                      'line can be split between any two characters by inserting a CRLF' + sLineBreak +
                      'immediately followed by a single linear white-space character (i.e.,' + sLineBreak +
                      'SPACE or HTAB).  Any sequence of CRLF followed immediately by a' + sLineBreak +
                      'single linear white-space character is ignored (i.e., removed) when' + sLineBreak +
                      'processing the content type.';
     cdPriority := mpNormal;                                     //Prioriät
   end;
   SendCalendarRequest(cd);
end;

end.

Viele Grüße!

Thomas