{
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.