Option Public Option Declare %REM iCalBasic LotusScript library version 1.0 Copyright (c) 2008 Julian Robichaux, http://www.nsftools.com This code is licensed under the terms of the MIT License, shown at the end of this comment section and available at http://www.opensource.org/licenses/mit-license.php =============================== Creates a basic iCalendar feed, for import into calendar applications. Example usage: Dim session As New NotesSession Dim db As NotesDatabase Dim dc As NotesDocumentCollection Dim doc As NotesDocument Dim item As NotesItem Dim created As NotesDateTime, modified As NotesDateTime Dim startTime As NotesDateTime, endTime As NotesDateTime Dim calItem As iCalItem Dim calFeed As New iCalFeed Set db = session.CurrentDatabase Set dc = db.UnprocessedDocuments Set doc = dc.GetFirstDocument() Do Until (doc Is Nothing) Set calItem = New iCalItem Call calItem.setUid(doc.Universalid) Set created = New NotesDateTime(doc.Created) Set modified = New NotesDateTime(doc.LastModified) Set startTime = New NotesDateTime(doc.GetItemValue("startDate")(0)) Set endTime = New NotesDateTime(doc.GetItemValue("endDate")(0)) Call calItem.setTimes(starttime, endtime, created, modified) Set item = doc.GetFirstItem("Body") Call calItem.setContent(doc.Location(0), doc.Subject(0), item.Text) Call calFeed.addItem(calItem) Set doc = dc.GetNextDocument(doc) Loop Dim filePath As String Dim fileNum As Integer filePath = "c:\temp\icaltest.ics" fileNum = FreeFile() Open filePath For Output As fileNum% Print #fileNum, calFeed.toString() Close fileNum =============================== Copyright (c) 2008 Julian Robichaux (http://www.nsftools.com) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. %END REM '/** ' * iCalItem represents a single iCalendar event that can be added ' * to an iCalendar feed. The only thing you HAVE to do is set times, ' * although it's always nice to have at least a description too. ' * See the comments on the various "set" methods for more info ' * on the different types of content you can add. ' *
' * Note that this does not come close to supporting every single ' * thing that iCalendar can do; it is just a simple class for ' * generating an iCalendar appointment that should be importable ' * by most iCalendar applications. ' */ Class iCalItem crlf As String '** always Chr(13)+Chr(10) uid As String '** unique identifier dtStart As NotesDateTime dtEnd As NotesDateTime dtCreated As NotesDateTime dtModified As NotesDateTime allDayEvent As Boolean location As String summary As String description As String '** no HTML, text only htmlDescription As String organizer As String '** only for "group" activities, not single-user events categories As String '** comma-separated values classType As String '** PUBLIC or PRIVATE sequence As Integer '** zero or higher (just use zero) Public Sub New () crlf = Chr(13) + Chr(10) classType = "PUBLIC" uid = Mid$(CStr(Rnd), 3) End Sub '/** ' * REQUIRED: Unique identifier for this entry. In Notes, this is ' * normally a document UNID if there is an actual document ' * associated with this event. This value is used not only ' * to uniquely identify an event, but also for matching up ' * an event that needs to be modified or deleted. It is also ' * important for recurring events, which we don't deal with here. ' */ Public Sub setUid (uid As String) Me.uid = uid End Sub Public Function getUid () As String getUid = Me.uid End Function '/** ' * REQUIRED: Set all of these times. Start and end time are the ' * start and end of the event itself. Created is when the event ' * was originally created (either "now", or the doc.created date of ' * a Notes document this came from). Modified is when the event ' * was last updated (either "now", or the doc.lastModified date of ' * a Notes document this came from). ' *
' * For an all-day or a multi-day event, set the startTime as the ' * first day of the event and the endTime as the day AFTER(!) the ' * day the event ends; then be sure to call the setAllDay() method. ' *
' * Note that the date values are copied into the iCalItem object, ' * not referenced. ' */ Public Sub setTimes (startTime As NotesDateTime, endTime As NotesDateTime, _ createDate As NotesDateTime, lastModified As NotesDateTime) Set Me.dtStart = New NotesDateTime(startTime.Lslocaltime) Set Me.dtEnd = New NotesDateTime(endTime.Lslocaltime) Set Me.dtCreated = New NotesDateTime(createDate.Lslocaltime) Set Me.dtModified = New NotesDateTime(lastModified.Lslocaltime) End Sub '/** ' * Set this as an "all day" event, either a single day or multiple ' * days. Remember that iCalendar applications seem to require that ' * the end date for an all-day or multi-day event should be ' * the day AFTER the event ends -- so, if you have a three day ' * event, the end date is three days after the start date, not two. ' */ Public Sub setAllDay () Me.allDayEvent = True End Sub '/** ' * OPTIONAL BUT RECOMMENDED: These are strings that describe the ' * calendar event. For maximum compatibility they should be plain ' * text, not HTML. ' */ Public Sub setContent (location As String, summary As String, description As String) Me.location = location Me.summary = summary Me.description = description End Sub '/** ' * OPTIONAL: An HTML description of the event. This should be ' * formatted like a full web page (i.e. starts with , has ' * a
and section, ends with a closing tag). ' * No guaranteed compatibility with all mail/calendar systems -- for ' * example, Lotus Notes seems to ignore this -- so make sure you ' * also have a plain-text description from setContent() ' * to fall back on. ' */ Public Sub setHtmlContent (html As String) me.htmlDescription = html End Sub '/** ' * OPTIONAL, NOT NORMALLY REQUIRED: This is for "group" events ' * like meetings, where there is a chair/organizer who controls ' * the event. For single-user calendar entries (reminders, ' * appointments, etc.) don't set this property. ' */ Public Sub setOrganizer (commonName As String, internetEmail As String) Me.organizer = |CN="| + commonName + |":mailto:| + internetEmail End Sub '/** ' * OPTIONAL: A comma-separated string indicating the category ' * labels to be used for this event (i.e. "BIRTHDAY,FAMILY"). ' */ Public Sub setCategories (categories As String) Me.categories = categories End Sub '/** ' * OPTIONAL: Mark this as a "private" event rather than a "public" one. ' */ Public Sub setPrivate () classType = "PRIVATE" End Sub '/** ' * OPTIONAL: For new or unchanged events, this is zero (the default). ' * For updated events, this is greater than zero. You are responsible ' * for keeping the number of changes and the sequence number in sync. ' */ Public Sub setSequence (sequence As Integer) Me.sequence = sequence End Sub '/** ' * Output this event as an iCalendar-formatted entry, to be included ' * in a full iCalendar feed. Note that if you are only creating a single ' * event, you still need to wrap this in a full iCalendar feed. ' */ Public Function toString () As String Dim s As String s = s + |BEGIN:VEVENT| + crlf '** REQUIRED s = s + |UID:| + escapeLine(me.uid) + crlf '** REQUIRED s = s + |DTSTAMP:| + dateToString(me.dtCreated) + crlf '** REQUIRED s = s + |LAST-MODIFIED:| + dateToString(me.dtModified) + crlf If (me.allDayEvent = True) Then s = s + |DTSTART;VALUE=DATE:| + StrLeft(dateToString(me.dtStart), "T") + crlf s = s + |DTEND;VALUE=DATE:| + StrLeft(dateToString(me.dtEnd), "T") + crlf Else s = s + |DTSTART:| + dateToString(me.dtStart) + crlf s = s + |DTEND:| + dateToString(me.dtEnd) + crlf End If s = s + |SEQUENCE:| + CStr(me.sequence) + crlf s = s + |CLASS:| + me.classType + crlf If (me.location <> "") Then s = s + |LOCATION:| + escapeLine(me.location) + crlf If (me.summary <> "") Then s = s + |SUMMARY:| + escapeLine(me.summary) + crlf If (me.description <> "") Then s = s + |DESCRIPTION:| + escapeLine(me.description) + crlf If (me.organizer <> "") Then s = s + |ORGANIZER;| + escapeLine(organizer) + crlf '** the semi-colon is not a mistake If (me.categories <> "") Then s = s + |CATEGORIES:| + escapeLine(me.categories) + crlf If (me.htmlDescription <> "") Then s = s + |X-ALT-DESC;FMTTYPE=text/html:| + escapeLine(me.htmlDescription) + crlf s = s + |END:VEVENT| + crlf toString = s End Function '/** ' * Utility function for converting a NotesDateTime value to ' * the date format that iCalendar likes. ' */ Public Function dateToString (dt As NotesDateTime) As String If Not (dt Is Nothing) Then dateToString = Format$(dt.Lsgmttime, "yyyymmddThhnnssZ") End If End Function '/** ' * Utility function for escaping characters and splitting long ' * lines into the multi-line format that iCalendar likes. ' */ Public Function escapeLine (ByVal s As String) As String s = Replace(s, "\", "\\") s = Replace(s, ";", "\;") s = Replace(s, ",", "\,") s = Replace(s, crlf, "\n") s = Replace(s, Chr(10), "\n") s = Replace(s, Chr(13), "\n") Dim returnString As String While (Len(s) > 75) returnString = returnString + Left(s, 75) + crlf + " " s = Mid$(s, 76) Wend returnString = returnString + s escapeLine = returnString End Function End Class '/** ' * iCalFeed is an object that can be used to create an iCalendar feed ' * with one or more iCalItem events. Note that if you are only creating ' * a single event, you still need to wrap it in a full iCalendar feed. ' */ Class iCalFeed items List As iCalItem prodID As String '** name of the product that generated this feed version As String '** pretty much always "2.0" right now scale As String '** always "GREGORIAN" method As String '** always "PUBLISH" for our purposes crlf As String '** always Chr(13)+Chr(10) Public Sub New () Dim session As New NotesSession crlf = Chr(13) + Chr(10) '** the RFC doesn't specify a prodID format, but it seems '** to always be a format like: -//Company//Product//EN prodID = |-//Custom iCal//IBM Lotus Notes | + _ StrLeft(session.Notesversion, "|") + |//EN| version = "2.0" scale = "GREGORIAN" method = "PUBLISH" End Sub '/** ' * Add an iCalItem to this feed. ' */ Public Sub addItem (item As iCalItem) Set items( item.getUid ) = item End Sub '/** ' * Output a full iCalendar feed, including all iCalItems that ' * have been added. ' *' * IMPORTANT NOTE: the iCalendar standard indicates that the ' * encoding should be (but doesn't specifically have to be) UTF-8. ' * The Lotus Notes client seems to use the platform character set ' * to determine encoding, in my limited tests. Apple iCal didn't ' * seem to care either. So you probably don't have to worry about ' * the output encoding of this string. ' *
' * However, if you want to force UTF-8 output from agents, you can ' * specify a character set in the Open command when you create a file. ' * For web output from an agent, try: ' *
' * Print "Content-type: text/calendar;charset=utf-8" ' * Print "" ' * Print myICalFeed.toString() ' */ Public Function toString () As String Dim s As String Dim formatter As New iCalItem() s = s + |BEGIN:VCALENDAR| + crlf s = s + |PRODID:| + formatter.escapeLine(me.prodID) + crlf s = s + |VERSION:| + me.version + crlf s = s + |CALSCALE:| + me.scale + crlf s = s + |METHOD:| + me.method + crlf ForAll item In items s = s + item.toString() End ForAll s = s + |END:VCALENDAR| + crlf toString = s End Function End Class