Besprechnungsanfrage (iCalendar)

**tdroese**

Hallo Forum!

Ich versuche nun die letzten 3 Nächte mit den Indy-Komponenten eine Besprechungsanfrage für Outlook/Lotus Notes zu generieren. Dies klappt leider nicht so wie ich es mir wünschen würde.

In Outlook erhalte ich eine Mail, mit einem Anhang "*.ics" nach einem Doppelklick, wird dieser dann als Termin importiert. In Lotus Notes wird der gleiche Termin als "ungültiger" Anhang gewertet.

Das Problem dürfte darin liegen, dass ich den "text/calendar" Content nicht an die richtige Stelle bringe bzw. nicht richtig verschlüssele (MIME?). Ich habe allerdings nicht so ganz viel Ahnung von IdMessage und Co.

Mein Code:

zusammenfalten · markieren

Delphi-Quellcode:

			uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, IdPOP3, IdBaseComponent, IdComponent, IdTCPConnection,

  IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,

  IdSMTP, StdCtrls, ComCtrls, Grids, IdMessage, IdIOHandler, IdCoder3to4,

  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdSASLLogin,

  IdSASLExternal, IdUserPassProvider, IdSASL_CRAM_MD5, IdSASL_CRAM_SHA1,

  IdSASLPlain, IdSASLSKey, IdSASLOTP, IdSASLAnonymous, IdAttachment, IdGlobal,

  IdSASLUserPass, IdSASLDigest, IdText, IdCoderMIME, IdCoder, 

  IdAttachmentFile, IdAttachmentMemory;

type

  TCalendarData = class

    cdHost: string;                 //Strato: smtp.strato.de

    cdAccount: string;              //Mr. T's Mailaccount

    cdPort: integer;                //Strato: 465 or 587

    cdUseTLS: integer;

    cdSSLConnection: boolean;       //Strato: True

    cdTransferEmail: string;        //Strato: you@youraccout.de

    cdUser: string;                 //Strato: you@youraccout.de

    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

    cdBody: TStringList;            //Body

    cdDescription: string;          //Beschreibung

    cdPriority: TIdMessagePriority; //Prioriät

    constructor Create;

    destructor Destroy; override;

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

constructor TCalendarData.Create;

begin

  inherited;

  cdBody := TStringList.Create;

end;

destructor TCalendarData.Destroy;

begin

  cdBody.Free;

  inherited;

end;

procedure SendCalendarRequest(CD: TCalendarData);

var

  IdMessage: TIdMessage;

  SMTP: TIdSMTP;

  SSLHandler: TIdSSLIOHandlerSocketOpenSSL;

  IdUserPassProvider: TIdUserPassProvider;

  IdSASLCRAMMD5: TIdSASLCRAMMD5;

  IdSASLCRAMSHA1: TIdSASLCRAMSHA1;

  IdSASLPlain: TIdSASLPlain;

  IdSASLLogin: TIdSASLLogin;

  IdSASLSKey: TIdSASLSKey;

  IdSASLOTP: TIdSASLOTP;

  IdSASLAnonymous: TIdSASLAnonymous;

  IdSASLExternal: TIdSASLExternal;

  MemoryStream: TMemoryStream;

  Attachment: TIdAttachment;

begin

  MemoryStream := TMemoryStream.Create();

  IdMessage := TIdMessage.Create(nil);

  try

    with IdMessage, cd do

    begin

      AttachmentEncoding := 'mime';

      ContentTransferEncoding := 'base64';

      //ContentTransferEncoding := '7-bit';

      Encoding := meMIME;

      ContentType := 'text/html';

      Charset := 'utf-8';

      From.Name := cdAccount;

      From.Address := cdOrganizer;

      Recipients.EMailAddresses := cdAttendee;

      Priority := cdPriority;

      Body.Text := '';

      //Body.AddStrings(cd.cdBody);

      Attachment.ContentType:='text/calendar';//set the content type to text/calendar

    //  Attachment := TIdAttachment.Create(IdMessage.MessageParts, cdBody.ToString);

    end; //with IdMessage, md

    SMTP := TIdSMTP.Create(nil);

    try

      if 1=1 then //CD.edSSLConnection

      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;

        SMTP.UseTLS := utUseImplicitTLS; //utUseExplicitTLS;

      end;

      if (cd.cdUser <> '') or (cd.cdPass <> '') then

      begin

        SMTP.AuthType := satSASL;

        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

        SMTP.Send(IdMessage);

        finally

        SMTP.Disconnect;

      end; //try..finally

    finally

      SMTP.Free;

    end; //try..finally

  finally

    MemoryStream.Free;

    IdMessage.Free;

  end; //try..finally

end; //SendCalendarRequest

begin

  //Sende Besprechungseinladungen

  cd := TCalendarData.Create();

  with cd do

  begin

    cdHost := Edit3.Text;

    cdAccount := 'Auto Calendar';                  //Mr. T's Mailaccount

    cdPort := StrToInt(Edit6.Text);                //Strato: 465 or 587

    cdUseTLS := Combobox1.ItemIndex;

    cdSSLConnection := True;                       //Strato: True

    cdTransferEmail := Edit2.Text;                 //Strato: you@youraccout.de

    cdUser := Edit4.Text;                          //Strato: you@youraccout.de

    cdPass := Edit5.Text;                          //Strato: Strato Passwort

    cdOrganizer := 'calendar@xyz.de';              //Organisator

    cdAttendee := 'empfaenger@xyz.de';             //Empfänger

    cdAppointmentStart := Now;                     //Anfang Termin

    cdAppointmentEnd := Now+0.1;                   //Ende Termin

    cdSummary := 'Besprechung Meier (wwewe)';      //Betreff

    cdLocation := 'Büro XY';                       //Ort

    cdDescription := 'Dies ist ein Text;';         //Beschreibung

    cdPriority := mpNormal;                        //Prioriät

    with cdBody do

    begin

      Add('BEGIN:VCALENDAR');

      Add('VERSION:1.0');

      Add('BEGIN:VEVENT');

      Add('ATTENDEE:' + cdAttendee);

      Add('ORGANIZER:MAILTO:' + cdOrganizer);

      Add('DTStart:' + FormatDateTime('YYYYMMDD', cdAppointmentStart) + 'T' + FormatDateTime('HHMMSS', cdAppointmentStart) + 'Z');

      Add('DTEnd:' + FormatDateTime('YYYYMMDD', cdAppointmentEnd) + 'T' + FormatDateTime('HHMMSS', cdAppointmentEnd) + 'Z');

      Add('LOCATION:' + cdLocation);

      Add('UID:LeanCredit.de');

      Add('SUMMARY:' + cdSummary);

      Add('DESCRIPTION:' + cdDescription);

      Add('PRIORITY:5');

      Add('END:VEVENT');

      Add('END:VCALENDAR');

    end; //cdBody

  end; //cd

  SendCalendarRequest(cd);

end.

**himitsu**

Hast du es denn auch einmal ohne Unicode (nur ASCII) probiert, ob es dann geht?
> speziell das ü im cdLocation

Kannst du dir denn diese Anfrage von einem anderen Programm senden lassen?
Dann schau da doch mal nach, wie das Format richtig auszusehen hat und wo genau diese Datei/Info rein muß.

markieren

Delphi-Quellcode:

			ContentType := 'text/calendar';

//Boby.Text := '';  // ist das nicht sowieso noch leer?

Body.AddStrings(cd.cdBody);

Attachment := TIdAttachment.Create(IdMessage.MessageParts, cdBody.Text);

, oder wurde TStrings.ToString nun doch inzwischen mal überschrieben?

PS: FormatDateTime('YYYYMMDD"T"HHMMSS"Z"', cdAppointmentStart)

PPS: Der Code in/ab with cdBody do gehört ja wohl eigentlich in eine Funktion in TCalendarData.
Wobei die Funktion SendCalendarRequest wohl auch da reingehört und wenn man diese noch etwas aufsplittet (z.B. die Authentifizierung und das eigentich Senden (SMTP.Host bis Disconnect) auch nochmals auslagert)

**tdroese**

Hallo! Danke erst einmal für die Hinweise. Ich werde es morgen noch einmal probieren - muss zugeben, dass ich nach den 3 Tagen den Quelltext a) zu einer "Quick an Dirty" Lösung mutieren ließ und b) einfach nicht mehr dran lang blicke.

Ein paar Stunden schlaf werden hier sicher helfen. Manchmal sieht man ja den Wald vor lauter Bäumen nicht mehr.

Danke aber erst einmal. Mit einer so prompten Antwort hab ich nicht gerechnet!

**tdroese**

Hallo,

habe den Code einmal aus dem Hauptprogramm genommen und auf ein einfaches VCL mit einem Button kopiert. Ein wenig aufgeräumt und umgeschrieben.

Aber das Ergebnis bleibt das gleiche - meine Besprechungsanfrage bleibt ein Anhang und wird nicht automatisch als Anfrage erkannt.

Alles andere läuft wie gewünscht:
Es wird eine gesicherte Verbindung (SSLTLS) zum Mailserver (Strato) aufgebaut. Die Mail wird inkl. Anlage verschlüsselt übertragen. Klappt nun auch in Notes, Outlook, Google, etc.

Aber das eigentliche Problem ist nach wie vor vorhanden.

Jemand noch einen Tipp? Ich stehe einfach auf dem Schlauch.

zusammenfalten · markieren

Delphi-Quellcode:

			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,

  IdSASLSKey, IdSASLOTP, IdSASLAnonymous, IdAttachment, IdComponent,

  IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,

  IdGlobal, IdTCPConnection, StdCtrls, IdText, IdAttachmentMemory;

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;

     cdSSLConnection: boolean;       //Strato: True

     cdTransferEmail: string;        //Strato: you@youraccout.de

     cdUser: string;                 //Strato: you@youraccout.de

     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

     cdBody: TStringList;            //Body

     cdDescription: string;          //Beschreibung

     cdPriority: TIdMessagePriority; //Prioriät

     procedure CreateInvitation(Msg_In : TIdMessage);

     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(Msg_In : TIdMessage);

var

  s: TStrings;

  MemoryStream: TMemoryStream;

  Attachment: TIdAttachmentMemory;

begin

  s := nil;

  MemoryStream := nil;

  try

    s := TStringList.Create;

    MemoryStream := TMemoryStream.Create();

    with s do

    begin

      Add('BEGIN:VCALENDAR');

      Add('VERSION:2.0');

      Add('PRODID:-//LeanCredit GmbH//NONSGML AML//DE');

      Add('BEGIN:VEVENT');

      Add('UID:' + cdAttendee);

      Add('DTSTAMP:' + FormatDateTime('YYYYMMDD"T"HHMMSS"Z"', Now));

      Add('ORGANIZER;CN=' + cdAccount + ':MAILTO:' + cdOrganizer);

      Add('LOCATION;ENCODING=QUOTED-PRINTABLE:' + cdLocation);

      Add('DESCRIPTION:Test');

      Add('DTSTART:' + FormatDateTime('YYYYMMDD"T"HHMMSS"Z"', cdAppointmentStart));

      Add('DTEND:' + FormatDateTime('YYYYMMDD"T"HHMMSS"Z"', cdAppointmentEnd));

      Add('SUMMARY:' + cdSummary);

      Add('END:VEVENT');

      Add('END:VCALENDAR');

    end;

    s.SaveToStream(MemoryStream);

    //Erzeuge den Kalendereintrag

    Attachment := TIdAttachmentMemory.Create(Msg_In.MessageParts);

    Attachment.ContentType := 'text/calendar';

    Attachment.MethodAddress('request');

    Attachment.CharSet := 'utf-8';

    Attachment.FileName := 'calendar.ics';

    Attachment.LoadFromStream(MemoryStream);

  finally

    MemoryStream.Free;

    s.free;

  end;

end; //TCalendarData.CreateInvitation

procedure SendCalendarRequest(CD: TCalendarData);

var

   IdMessage: TIdMessage;

   SMTP: TIdSMTP;

   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

       ContentType := 'multipart/mixed';

       ContentTransferEncoding := '8 bit';

       Encoding := meMIME;

       AttachmentEncoding := 'MIME';

       Charset := 'utf-8';

       //Absender

       From.Name := cdAccount;

       From.Address := cdOrganizer;

       //Empfänger, Priorität + Nachrichtentext

       Recipients.EMailAddresses := cdAttendee;

       Priority := cdPriority;

       Body.AddStrings(cd.cdBody);

     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

         SMTP.Send(IdMessage);

         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;

     cdSSLConnection := true;                          //Strato: True

     cdTransferEmail := 'noreply@vb-ml.leancredit.de'; //Strato: you@youraccout.de

     cdUser := 'User';                                 //Strato: you@youraccout.de

     cdPass := 'Pass';                                 //Strato: Strato Passwort

     cdOrganizer := 'calendar@leancredit.de';          //Organisator

     cdAttendee := 'max_mueller@test.de';              //Empfänger

     cdAppointmentStart := Now;                        //Anfang Termin

     cdAppointmentEnd := Now+0.1;                      //Ende Termin

     cdSummary := 'Besprechung Meier (wwewe)';         //Betreff

     cdLocation := 'Buero XY';                         //Ort

     cdDescription := 'Dies ist ein Text';             //Beschreibung

     cdBody.Add('Dies ist der Body der Mail');

     cdPriority := mpNormal;                           //Prioriät

   end;

   SendCalendarRequest(cd);

end;

end.

**himitsu**

Was ich zumindestens erkenne, daß du sagst es sei UTF-8, es aber dennoch als ANSI speicherst.

markieren

Delphi-Quellcode:

			      SaveToStream(MemoryStream, TEncoding.UTF8);

    end;

    //s.SaveToStream(MemoryStream);

**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!

zusammenfalten · markieren

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: you@youraccout.de

     cdUser: string;                 //Strato: you@youraccout.de

     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 := 'autocalendar@yourdomain.com';           //Strato: you@youraccout.de

     cdUser := 'Username';                                       //Benutzername         

     cdPass := 'Password';                                       //Passwort

     cdOrganizer := 'autocalendar@yourdomain.com';               //Organisator

     cdAttendee := 'empaenger@der-besprechungsanfrage.de';       //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

Besprechnungsanfrage (iCalendar)

Besprechnungsanfrage (iCalendar)

AW: Besprechnungsanfrage (iCalendar)

AW: Besprechnungsanfrage (iCalendar)

AW: Besprechnungsanfrage (iCalendar)

AW: Besprechnungsanfrage (iCalendar)

AW: Besprechnungsanfrage (iCalendar)

Stichworte

Forumregeln

himitsu Registriert seit: 11. Okt 2003 Ort: Elbflorenz 44.585 Beiträge Delphi 12 Athens	#5 AW: Besprechnungsanfrage (iCalendar) 19. Nov 2013, 12:10 Was ich zumindestens erkenne, daß du sagst es sei UTF-8, es aber dennoch als ANSI speicherst. markieren Delphi-Quellcode: SaveToStream(MemoryStream, TEncoding.UTF8); end; //s.SaveToStream(MemoryStream); Ein Therapeut entspricht 1024 Gigapeut.
	Zitat