lazarus-ccr/components/tvplanit/source/vpical.pas

unit VpICAL;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, VpBaseDataFiles;

type
  TVpICalendar = class;

  TVpICalItem = class(TVpFileItem)
  public
    function GetAttribute(AName: String): string;
  end;

  TVpICalEntry = class(TVpFileBlock)
  private
    FCalendar: TVpICalendar;
    FChecked: Boolean;
  protected
    procedure SaveToStrings(const AList: TStrings); virtual;
  public
    constructor Create(ACalendar: TVpICalendar); virtual;
    function FindItem(AKey: String): TVpICalItem;
    property Checked: Boolean read FChecked write FChecked default true;
  end;

  TVpICalTimeZoneInfo = class(TVpICalEntry)
  public
    TimeZoneID: String;     // e.g. Europe/Berlin
    TimeZoneName: String;   // e.g. CEST
    UTCOffset: Double;      // add to UTC to get local time
  end;

  TVpICalAlarm = class(TVpICalEntry)
  private
    FDuration: Double;   // "SnoozeTime"
    FRepeat: Integer;
    FTrigger: Double;    // "AlarmAdvance"
    FAudio: Boolean;
    FAudioSrc: String;
  protected
    procedure SaveToStrings(const AList: TStrings); override;
  public
    procedure Analyze; override;
    property Duration: Double read FDuration write FDuration;
    property RepeatCount: Integer read FRepeat write FRepeat;
    property Trigger: Double read FTrigger write FTrigger;
    property Audio: Boolean read FAudio write FAudio;
    property AudioSrc: String read FAudioSrc write FAudioSrc;
  end;

  { TVpICalEvent }

  TVpICalEvent = class(TVpICalEntry)
  private
    FUID: String;
    FSummary: String;        // --> Description
    FDescription: String;    // --> Notes
    FLocation: String;
    FStartTime: TDateTime;
    FStartTimeTZ: String;
    FEndTime: TDateTime;
    FEndTimeTZ: String;
    FDuration: double;
    FRecurrenceFreq: String;
    FRecurrenceInterval: Integer;
    FRecurrenceEndDate: TDateTime;
    FRecurrenceCount: Integer;
    FRecurrenceByXXX: String;
    FAlarm: TVpICalAlarm;
    FCategories: TStrings;
    FPickedCategory: Integer;
    function GetCategory(AIndex: Integer): String;
    function GetCategoryCount: Integer;
    function GetEndTime(UTC: Boolean): TDateTime;
    function GetStartTime(UTC: Boolean): TDateTime;
    procedure SetEndTime(UTC: Boolean; const AValue: TDateTime);
    procedure SetStartTime(UTC: Boolean; const AValue: TDateTime);
  public
    constructor Create(ACalendar: TVpICalendar); override;
    destructor Destroy; override;
    procedure Analyze; override;
    function Categories: TStrings;
    function IsAllDayEvent: Boolean;
    procedure SaveToStrings(const AList: TStrings); override;
    procedure UseAlarm(AEnable: Boolean);
    property Summary: String read FSummary write FSummary;              // is "Description" of tvp
    property Description: String read FDescription write FDescription;  // is "Notes" of tvp
    property Location: String read FLocation write FLocation;
    property StartTime[UTC: Boolean]: TDateTime read GetStartTime write SetStartTime;
    property EndTime[UTC: Boolean]: TDateTime read GetEndTime write SetEndTime;
    property Category[AIndex: Integer]: String read GetCategory;
    property CategoryCount: Integer read GetCategoryCount;
    property Alarm: TVpICalAlarm read FAlarm;
    property RecurrenceFrequency: String read FRecurrenceFreq write FRecurrenceFreq;
    property RecurrenceInterval: Integer read FRecurrenceInterval write FRecurrenceInterval;
    property RecurrenceEndDate: TDateTime read FRecurrenceEndDate write FRecurrenceEndDate;
    property RecurrenceCount: Integer read FRecurrenceCount write FRecurrenceCount;
    property RecurrenceByXXX: String read FRecurrenceByXXX write FRecurrenceByXXX;
    property PickedCategory: Integer read FPickedCategory write FPickedCategory;
    property UID: String read FUID write FUID;
  end;

  TVpICalToDo = class(TVpICalEntry)
  private
    FSummary: String;
    FComment: String;
    FCreatedTime: TDateTime;
    FCreatedTimeTZ: String;
    FStartTime: TDateTime;
    FStartTimeTZ: String;
    FDueTime: TDateTime;
    FDueTimeTZ: String;
    FCompletedTime: TDateTime;
    FCompletedTimeTZ: String;
    FDuration: double;
    FCategories: TStrings;
    FPickedCategory: Integer;
    FPriority: integer;
    FStatus: String;
    FUID: String;
    function GetCategory(AIndex: integer): String;
    function GetCategoryCount: Integer;
    function GetCompletedTime(UTC: Boolean): TDateTime;
    function GetCreatedTime(UTC: Boolean): TDateTime;
    function GetDueTime(UTC: Boolean): TDateTime;
    function GetStartTime(UTC: Boolean): TDateTime;
    procedure SetCompletedTime(UTC: Boolean; const AValue: TDateTime);
    procedure SetCreatedTime(UTC: Boolean; const AValue: TDateTime);
    procedure SetDueTime(UTC: Boolean; const AValue: TDateTime);
    procedure SetStartTime(UTC: Boolean; const AValue: TDateTime);
  public
    constructor Create(AOwner: TVpICalendar); override;
    destructor Destroy; override;
    procedure Analyze; override;
    function Categories: TStrings;
    procedure SaveToStrings(const AList: TStrings); override;
    property Summary: String read FSummary write FSummary;
    property Comment: String read FComment write FComment;
    property CreatedTime[UTC: Boolean]: TDateTime read GetCreatedTime write SetCreatedTime;
    property StartTime[UTC: Boolean]: TDateTime read GetStartTime write SetStartTime;
    property DueTime[UTC: Boolean]: TDateTime read GetDueTime write SetDueTime;
    property CompletedTime[UTC: Boolean]: TDateTime read GetCompletedTime write SetCompletedTime;
    property Category[AIndex: Integer]: String read GetCategory;
    property CategoryCount: Integer read GetCategoryCount;
    property PickedCategory: Integer read FPickedCategory write FPickedCategory;
    property Priority: Integer read FPriority write FPriority; // 0=undefined, 1-highest, 9=lowest
    property Status: String read FStatus write FStatus;
    property UID: String read FUID write FUID;
  end;

  TVpICalendar = class
  private
    FEntries: array of TVpICalEntry;
    FVersion: String;
    function GetCount: Integer;
    function GetEntry(AIndex: Integer): TVpICalEntry;
    function GetEventCount: Integer;
    function GetToDoCount: Integer;
  protected
    // Reading
    procedure LoadFromStrings(const AStrings: TStrings);
    // Writing
    procedure SaveToStrings(const AList: TStrings);
    // Time conversion
    function ConvertTime(ADateTime: TDateTime; ATimeZoneID: String; ToUTC: Boolean): TDateTime;
    function LocalTimeToUTC(ADateTime: TDateTime; ATimeZoneID: String): TDateTime;
    function UTCToLocalTime(ADateTime: TDateTime; ATimeZoneID: String): TDateTime;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(AEntry: TVpICalEntry);
    procedure Clear;
    procedure LoadFromFile(const AFileName: String);
    procedure LoadFromStream(const AStream: TStream);
    procedure SaveToFile(const AFileName: String);
    procedure SaveToStream(const AStream: TStream);
    property Count: Integer read GetCount;
    property EventCount: Integer read GetEventCount;
    property TodoCount: Integer read GetToDoCount;
    property Entry[AIndex: Integer]: TVpICalEntry read GetEntry; default;
    property Version: String read FVersion write FVersion;
  end;


implementation

uses
  VpConst, VpBase;

const
  TIME_FORMAT = 'yyyymmdd"T"hhnnss';
  TIME_FORMAT_UTC = TIME_FORMAT + '"Z"';

// Examples: 19970702T160000, or T123000, or 20120101
function iCalDateTime(AText: String; out IsUTC: Boolean): TDateTime;
var
  shour, smin, ssec: String;
  yr, mon, day, hr, min, sec: Integer;
  p: Integer;
  d: TDate = 0;
  t: TTime = 0;
begin
  Result := 0;
  if AText = '' then exit;

  if AText = '' then
    exit;

  if (AText[1] <> 'T') and (Length(AText) >= 8) then begin
    if TryStrToInt(Copy(AText, 1, 4), yr) and
       TryStrToInt(Copy(AText, 5, 2), mon) and
       TryStrToInt(Copy(AText, 7, 2), day)
    then
      if not TryEncodeDate(yr, mon, day, d) then exit;
  end;

  shour := '0';
  smin := '0';
  ssec := '0';
  p := pos('T', AText);
  if p > 0 then begin
    if Length(AText) >= p + 2 then shour := Copy(AText, p+1, 2);
    if Length(AText) >= p + 4 then smin := Copy(AText, p+3, 2);
    if Length(AText) >= p + 6 then ssec := Copy(AText, p+5, 2);
  end;
  if TryStrToInt(shour, hr) and
     TryStrToInt(smin, min) and
     TryStrToInt(ssec, sec)
  then
    if not TryEncodeTime(hr, min, sec, 0, t) then exit;

  Result := d + t;
  IsUTC := AText[Length(AText)] = 'Z';
end;

function IsInteger(d, Epsilon: Double): Boolean;
begin
  Result := abs(d - round(d)) < Epsilon;
end;

// Converts a duration (in day units) to a string according to ical specs
function Duration2iCalStr(AValue: double): String;
var
  isNeg: Boolean = false;
begin
  if AValue < 0 then
  begin
    isNeg := true;
    AValue := -AValue;
  end;
  if IsInteger(AValue, 1.0 / SecondsInDay) then
    Result :=Format('P%dS', [round(AValue * SecondsInDay)])
  else if IsInteger(AValue, 1.0/MinutesInDay) then
    Result := Format('P%dM', [round(AValue * MinutesInDay)])
  else if IsInteger(AValue, 1.0/HoursInday) then
    Result := Format('P%dH', [round(AValue * HoursInDay)])
  else if IsInteger(AValue, 1.0) then
    Result := Format('P%dD', [round(AValue)])
  else
    Result := Format('P%D%s', [trunc(AValue), FormatDateTime('h"H"n"M"s"S"', AValue)]);
  if isNeg then Result := '-' + Result;
end;

// Example: PT0H20M0S, or -PT15M, or -P2D
function iCalDuration(AText: String): Double;
var
  isNeg: Boolean = false;
  inDate: Boolean = true;
  p: PChar;
  s: String;
begin
  Result := 0;
  if AText = '' then
    exit;

  p := @AText[1];
  if p^ = '-' then begin
    isNeg := true;
    inc(p);
  end;
  if p^ <> 'P' then   // 'P' = "period"
    exit;

  inc(p);
  s := '';
  while true do begin
    case p^ of
      #0 : break;
      'T': begin
             inDate := false;
             s := '';
           end;
      'D': begin
             Result := Result + StrToInt(s);
             s := '';
           end;
      'H': begin
             Result := Result + StrToInt(s)/24;
             s := '';
           end;
      'M': begin
             if inDate then
               // don't know about months... ?!
             else
               Result := Result + StrToInt(s)/MinutesInDay;
               ;  // don't know about months... ?!
             s := '';
           end;
      'S': begin
             Result := Result + StrToInt(s) / SecondsInDay;
             s := '';
           end;
      '0'..'9': s := s + p^;
      else raise EVpException.CreateFmt('Invalid character in DURATION string "%s"', [AText]);
    end;
    inc(p);
  end;
  if isNeg then Result := -Result;
end;


{==============================================================================}
{                             TVpICalItem                                      }
{==============================================================================}

function TVpICalItem.GetAttribute(AName: String): String;
begin
  Result := FAttributes.Values[AName];
end;


{==============================================================================}
{                             TVpICalEntry                                     }
{==============================================================================}

constructor TVpICalEntry.Create(ACalendar: TVpICalendar);
begin
  inherited Create(TVpICalItem);
  FChecked := true;
  FCalendar := ACalendar;
end;

function TVpICalEntry.FindItem(AKey: String): TVpICalItem;
begin
  Result := TVpICalItem(inherited FindItem(AKey, ''));
end;

procedure TVpICalEntry.SaveToStrings(const AList: TStrings);
begin
end;

{==============================================================================}
{                               TVpICalAlarm                                   }
{==============================================================================}
procedure TVpICalAlarm.Analyze;
var
  i: Integer;
  item: TVpICalItem;
begin
  inherited;
  for i := 0 to FItems.Count-1 do begin
    item := TVpICalItem(FItems[i]);
    case item.Key of
      'TRIGGER':
        FTrigger := ICalDuration(item.Value);
      'DURATION' :
        FDuration := ICalDuration(item.Value);
      'REPEAT':
        FRepeat := StrToInt(item.Value);
      'ACTION':
        FAudio := Uppercase(item.Value) = 'AUDIO';
      'ATTACH':
        if Lowercase(item.GetAttribute('FMTTYPE')) = 'audio' then
          FAudioSrc := item.Value;
    end;
  end;
end;

procedure TVpICalAlarm.SaveToStrings(const AList: TStrings);
begin
  AList.Add('BEGIN:VALARM');
  if Audio then
    AList.Add('ACTION:AUDIO');
  if AudioSrc <> '' then
    AList.Add('ATTACH;FMTTYPE=AUDIO:' + AudioSrc);
  if RepeatCount > 0 then
    AList.Add('REPEAT:' + IntToStr(RepeatCount));
  if Trigger <> 0 then
    AList.Add('TRIGGER;VALUE=DURATION:' + Duration2iCalStr(Trigger));
  if Duration <> 0 then
    AList.Add('DURATION;VALUE=DURATION:' + Duration2iCalStr(Duration));
  AList.Add('END:VALARM');
end;


{==============================================================================}
{                              TVpICalEvent                                    }
{==============================================================================}

constructor TVpICalEvent.Create(ACalendar: TVpICalendar);
begin
  inherited;
  FCategories := TStringList.Create;
  FCategories.Delimiter := VALUE_DELIMITER;
  FCategories.StrictDelimiter := True;
  FCategories.SkipLastLineBreak := True;
  FStartTime := NO_DATE;
  FEndTime := NO_DATE;
  FDuration := NO_DATE;
end;

destructor TVpICalEvent.Destroy;
begin
  FCategories.Free;
  FAlarm.Free;
  inherited;
end;

procedure TVpICalEvent.Analyze;
var
  i, j: Integer;
  item: TVpICalItem;
  L: TStrings;
  s: String;
  isUTC: Boolean;
begin
  inherited;

  for i := 0 to FItems.Count-1 do begin
    item := TVpICalItem(FItems[i]);
    case item.Key of
      'UID':
        FUID := item.Value;
      'SUMMARY':
        FSummary := item.Value;
      'DTSTART':
        begin
          FStartTimeTZ := item.GetAttribute('TZID');
          FStartTime := iCalDateTime(item.Value, isUTC);
          if not isUTC then
            FStartTime := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
        end;
      'DTEND':
        begin
          FEndTimeTZ := item.GetAttribute('TZID');
          FEndTime := iCalDateTime(item.Value, isUTC);
          if not isUTC then
            FEndTime := FCalendar.LocalTimeToUTC(FEndTime, FEndTimeTZ);
        end;
      'DESCRIPTION':
        FDescription := item.Value;
      'LOCATION':
        FLocation := item.Value;
      'DURATION':
        FDuration := ICalDuration(item.Value);
      'CATEGORIES':
        FCategories.DelimitedText := item.Value;
      'RRULE':
        begin
          L := TStringList.Create;
          try
            L.StrictDelimiter := true;
            L.Delimiter := VALUE_DELIMITER; // ';'
            L.DelimitedText := item.Value;
            FRecurrenceFreq := L.Values['FREQ'];
            FRecurrenceInterval := StrToIntDef(L.Values['INTERVAL'], 0);
            FRecurrenceEndDate := iCalDateTime(L.Values['UNTIL'], isUTC);
            if FRecurrenceEndDate = 0 then
              FRecurrenceEndDate := FOREVER_DATE;
            FRecurrenceCount := StrToIntDef(L.Values['COUNT'], 0);
            FRecurrenceByXXX := '';
            for j:=0 to L.Count-1 do begin
              s := L[j];
              if pos('BY', s) = 1 then FRecurrenceByXXX := FRecurrenceByXXX + ';' + s;
            end;
            if FRecurrenceByXXX <> '' then
              Delete(FRecurrenceByXXX, 1, 1);
          finally
            L.Free;
          end;
        end;
    end;
  end;
end;

function TVpICalEvent.Categories: TStrings;
begin
  Result := FCategories;
end;

function TVpICalEvent.GetCategory(AIndex: Integer): String;
begin
  if (AIndex >= 0) and (AIndex < FCategories.Count) then
    Result := FCategories[AIndex]
  else
    Result := '';
end;

function TVpICalEvent.GetCategoryCount: Integer;
begin
  Result := FCategories.Count;
end;

function TVpICalEvent.GetEndTime(UTC: Boolean): TDateTime;
begin
  if (FEndTime = NO_DATE) and (FDuration = NO_DATE) then
    Result := NO_DATE
  else
  if FEndTime <> 0 then
    Result := FEndTime
  else
    Result := FStartTime + FDuration;
  if not UTC then
    Result := FCalendar.UTCToLocalTime(Result, FEndTimeTZ);
end;

function TVpICalEvent.GetStartTime(UTC: Boolean): TDateTime;
begin
  if FStartTime = NO_DATE then
    Result := NO_DATE
  else
  if UTC then
    Result := FStartTime
  else
    Result := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
end;

{ Determines whether the event is an all-day event.
  See specs (https://www.rfc-editor.org/rfc/rfc5545#page-54):
    The "DTEND" property for a "VEVENT" calendar component specifies the 
    non-inclusive end of the event.  For cases where a "VEVENT" calendar 
    component specifies a "DTSTART" property with a DATE value type but no
    "DTEND" nor "DURATION" property, the event's duration is taken to
    be one day.  For cases where a "VEVENT" calendar component
    specifies a "DTSTART" property with a DATE-TIME value type but no
    "DTEND" property, the event ends on the same calendar date and
    time of day specified by the "DTSTART" property. }
function TVpICalEvent.IsAllDayEvent: Boolean;
var
  tstart, tend: TDateTime;
begin
  tstart := GetStartTime(false);
  tend := GetEndTime(false);
  if ((FEndTime = NO_DATE) or (frac(tend) = 0.0)) and (frac(tstart) = 0.0) then
    Result := true
  else
    Result := false;
end;

procedure TVpICalEvent.SaveToStrings(const AList: TStrings);
var
  lKey: String = '';
  lValue: String = '';
begin
  AList.Add('BEGIN:VEVENT');

  if UID <> '' then
    AList.Add('UID:' + UID);
  if FSummary <> '' then
    AList.Add('SUMMARY:' + FSummary);
  if FDescription <> '' then
    AList.Add('DESCRIPTION:' + FDescription);
  if FLocation <> '' then
    AList.Add('LOCATION:' + FLocation);
  if FCategories.Count > 0 then
    AList.Add('CATEGORIES:' + FCategories.CommaText);

  // todo: check time zones!
  if FStartTimeTZ <> '' then
    lKey := 'DTSTART;TZID=' + FStartTimeTZ + ':'
  else
    lKey := 'DTSTART:';
  AList.Add(lKey +  FormatDateTime(TIME_FORMAT_UTC, StartTime[true]));
  if FEndTimeTZ <> '' then
    lKey := 'DTEND;TZID=' + FEndTimeTZ + ':'
  else
    lKey := 'DTEND:';
  AList.Add(lKey + FormatDateTime(TIME_FORMAT_UTC, EndTime[true]));

  if RecurrenceFrequency <> '' then
  begin
    lKey := 'RRULE:';
    lValue := 'FREQ=' + RecurrenceFrequency;
    if RecurrenceInterval > 0 then
      lValue := lValue + ';INTERVAL=' + IntToStr(RecurrenceInterval);
    if RecurrenceEndDate <> 0 then
      lValue := lValue + ';UNTIL=' + FormatDateTime(TIME_FORMAT, RecurrenceEndDate);
    if RecurrenceCount > 0 then
      lValue := lValue + ';COUNT=' + IntToStr(RecurrenceCount);
    if RecurrenceByXXX <> '' then
      lValue := lValue + ';' + RecurrenceByXXX;
    AList.Add(lKey + lValue);
  end;

  if Alarm <> nil then
    Alarm.SaveToStrings(AList);
end;

procedure TVpICalEvent.SetEndTime(UTC: Boolean; const AValue: TDateTime);
begin
  if AValue = NO_DATE then
    FEndTime := NO_DATE
  else
  if UTC then
    FEndTime := AValue
  else
    FEndTime := FCalendar.LocalTimeToUTC(AValue, FEndTimeTZ);
end;

procedure TVpICalEvent.SetStartTime(UTC: Boolean; const AValue: TDateTime);
begin
  if AValue = NO_DATE then
    FStartTime := NO_DATE
  else
  if UTC then
    FStartTime := AValue
  else
    FStartTime := FCalendar.LocalTimeToUTC(AValue, FStartTimeTZ);
end;

procedure TVpICalEvent.UseAlarm(AEnable: Boolean);
begin
  FreeAndNil(FAlarm);
  if AEnable then
    FAlarm := TVpICalAlarm.Create(FCalendar);
end;


{==============================================================================}
{                             TVpICalToDo                                      }
{==============================================================================}

constructor TVpICalToDo.Create(AOwner: TVpICalendar);
begin
  inherited;
  FCategories := TStringList.Create;
  FCategories.Delimiter := ',';   // ToDo categories are separated by comma in ical file.
  FCategories.StrictDelimiter := true;
  FStartTime := NO_DATE;
  FDueTime := NO_DATE;
end;

destructor TVpICalToDo.Destroy;
begin
  FCategories.Free;
  inherited;
end;

procedure TVpICalToDo.Analyze;
var
  i: Integer;
  item: TVpICalItem;
  isUTC: Boolean;
begin
  inherited;

  for i := 0 to FItems.Count-1 do begin
    item := TVpICalItem(FItems[i]);
    case item.Key of
      'UID':
        FUID := item.Value;
      'SUMMARY':
        FSummary := item.Value;
      'COMMENT':
        FComment := item.Value;
      'DTSTAMP':
        begin
          FCreatedTimeTZ := item.GetAttribute('TZID');
          FCreatedTime := iCalDateTime(item.Value, isUTC);
          if not isUTC then
            FCreatedTime := FCalendar.LocalTimeToUTC(FCreatedTime, FCreatedTimeTZ);
        end;
      'DTSTART':
        begin
          FStartTimeTZ := item.GetAttribute('TZID');
          FStartTime := iCalDateTime(item.Value, isUTC);
          if not isUTC then
            FStartTime := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
        end;
      'DUE':
        begin
          FDueTimeTZ := item.GetAttribute('TZID');
          FDueTime := iCalDateTime(item.Value, isUTC);
          if not isUTC then
            FDueTime := FCalendar.LocalTimeToUTC(FDueTime, FDueTimeTZ);
        end;
      'DURATION':
        FDuration := ICalDuration(item.Value);
      'COMPLETED':
        begin
          FCompletedTimeTZ := item.GetAttribute('TZID');
          FCompletedTime := iCalDateTime(item.Value, isUTC);
          if not isUTC then
            FCompletedTime := FCalendar.LocalTimeToUTC(FCompletedTime, FCompletedTimeTZ);
        end;
      'CATEGORIES':
        FCategories.DelimitedText := item.Value;
      'PRIORITY':
        FPriority := StrToIntDef(item.Value, 0);
      'STATUS':
        FStatus := item.Value;
    end;
  end;
end;

function TVpICalToDo.Categories: TStrings;
begin
  Result := FCategories;
end;

function TVpICalToDo.GetCategory(AIndex: Integer): String;
begin
  if (AIndex >= 0) and (AIndex < FCategories.Count) then
    Result := FCategories[AIndex]
  else
    Result := '';
end;

function TVpICalToDo.GetCategoryCount: Integer;
begin
  Result := FCategories.Count;
end;

function TVpICalToDo.GetCompletedTime(UTC: Boolean): TDateTime;
begin
  Result := FCompletedTime;
  if (Result > 0) and (not UTC) then
    Result := FCalendar.UTCToLocalTime(Result, FCompletedTimeTZ);
end;

function TVpICalToDo.GetCreatedTime(UTC: Boolean): TDateTime;
begin
  Result := FCreatedTime;
  if (Result > 0) and (not UTC) then
    Result := FCalendar.UTCToLocalTime(Result, FCreatedTimeTZ);
end;

function TVpICalToDo.GetDueTime(UTC: Boolean): TDateTime;
begin
  if FDueTime <> 0 then
    Result := FDueTime
  else
    Result := FStartTime + FDuration;
  if (Result > 0) and (not UTC) then
    Result := FCalendar.UTCToLocalTime(Result, FDueTimeTZ);
end;

function TVpICalToDo.GetStartTime(UTC: Boolean): TDateTime;
begin
  if UTC then
    Result := FStartTime
  else
    Result := FCalendar.LocalTimeToUTC(FStartTime, FStartTimeTZ);
end;

procedure TVpICalToDo.SaveToStrings(const AList: TStrings);
var
  key: String;
  dt: TDateTime;
begin
  AList.Add('BEGIN:TODO');

  if UID <> '' then
    AList.Add('UID:' + UID);

  if FCreatedTimeTZ <> '' then
    key := 'DTSTAMP;TZID=' + FCreatedTimeTZ + ':'
  else
    key := 'DTSTAMP:';
  AList.Add(key + FormatDateTime(TIME_FORMAT_UTC, CreatedTime[true]));

  if FSummary <> '' then
    AList.Add('SUMMARY:' + FSummary);

  if FComment <> '' then
    AList.Add('COMMENT:' + FComment);

  if FCategories.Count > 0 then
    AList.Add('CATEGORIES:' + FCategories.DelimitedText);

  // todo: check time zones!
  if FStartTimeTZ <> '' then
    key := 'DTSTART;TZID=' + FStartTimeTZ + ':'
  else
    key := 'DTSTART:';
  AList.Add(key +  FormatDateTime(TIME_FORMAT_UTC, StartTime[true]));

  if FDueTimeTZ <> '' then
    key := 'DUE;TZID=' + FDueTimeTZ + ':'
  else
    key := 'DUE:';
  AList.Add(key +  FormatDateTime(TIME_FORMAT_UTC, DueTime[true]));

  dt := CompletedTime[true];
  if dt > 0 then  // 0 means here: "not completed yet"
  begin
    if FCompletedTimeTZ <> '' then
      key := 'COMPLETE;TZID=' + FCompletedTimeTZ + ':'
    else
      key := 'COMPLETED:';
    AList.Add(key + FormatDateTime(TIME_FORMAT_UTC, CompletedTime[true]));
  end;

  if FDuration <> 0 then
    AList.Add('DURATION:' + Duration2iCalStr(FDuration));    // wp: Is this correct?

  AList.Add('PRIORITY:' + IntToStr(FPriority));
  if FStatus <> '' then
    AList.Add('STATUS:' + FStatus);

  AList.Add('END:TODO');
end;

procedure TVpICalToDo.SetCompletedTime(UTC: Boolean; const AValue: TDateTime);
begin
  if AValue = NO_DATE then
    FCompletedTime := NO_DATE
  else
  if UTC then
    FCompletedTime := AValue
  else
    FCompletedTime := FCalendar.LocalTimeToUTC(AValue, FCompletedTimeTZ);
end;

procedure TVpICalToDo.SetCreatedTime(UTC: Boolean; const AValue: TDateTime);
begin
  if AValue = NO_DATE then
    FCreatedTime := NO_DATE
  else
  if UTC then
    FCreatedTime := AValue
  else
    FCreatedTime := FCalendar.LocalTimeToUTC(AValue, FCreatedTimeTZ);
end;

procedure TVpICalToDo.SetDueTime(UTC: Boolean; const AValue: TDateTime);
begin
  if AValue = NO_DATE then
    FDueTime := NO_DATE
  else
  if UTC then
    FDueTime := AValue
  else
    FDueTime := FCalendar.LocalTimeToUTC(AValue, FDueTimeTZ);
end;

procedure TVpICalToDo.SetStartTime(UTC: Boolean; const AValue: TDateTime);
begin
  if AValue = NO_DATE then
    FStartTime := NO_DATE
  else
  if UTC then
    FStartTime := AValue
  else
    FStartTime := FCalendar.LocalTimeToUTC(AValue, FStartTimeTZ);
end;


{==============================================================================}
{                             TVpICalendar                                     }
{==============================================================================}

constructor TVpICalendar.Create;
begin
  inherited;
  FVersion := '2.0';
  SetLength(FEntries, 0);
end;

destructor TVpICalendar.Destroy;
begin
  Clear;
  inherited;
end;

procedure TVpICalendar.Add(AEntry: TVpICalEntry);
var
  n: Integer;
begin
  n := Length(FEntries);
  SetLength(FEntries, n+1);
  FEntries[n] := AEntry;
end;

procedure TVpICalendar.Clear;
var
  j: Integer;
begin
  for j := Count-1 downto 0 do
    FEntries[j].Free;
  SetLength(FEntries, 0);
end;

function TVpICalendar.GetCount: Integer;
begin
  Result := Length(FEntries);
end;

function TVpICalendar.GetEntry(AIndex: Integer): TVpICalEntry;
begin
  Result := FEntries[AIndex];
end;

function TVpICalendar.GetEventCount: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to High(FEntries) do
    if (FEntries[i] is TVpICalEvent) then
      inc(Result);
end;
  
function TVpICalendar.GetToDoCount: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to High(FEntries) do
    if (FEntries[i] is TVpICalToDo) then
      inc(Result);
end;

procedure TVpICalendar.LoadFromFile(const AFilename: String);
var
  L: TStrings;
begin
  L := TStringList.Create;
  try
    L.LoadFromFile(AFileName);
    LoadFromStrings(L);
  finally
    L.Free;
  end;
end;

procedure TVpICalendar.LoadFromStream(const AStream: TStream);
var
  L: TStrings;
begin
  L := TStringList.Create;
  try
    L.LoadFromStream(AStream);
    LoadFromStrings(L);
  finally
    L.Free;
  end;
end;

procedure TVpICalendar.LoadFromStrings(const AStrings: TStrings);
const
  BLOCK_SIZE = 100;
var
  p: Integer;
  itemName: String;
  itemValue: String;
  i, n: Integer;
  s: String;
  currEntry: TVpICalEntry = nil;
  oldEntry: TVpICalEntry = nil;
begin
  // Clear item list
  Clear;
  n := 0;
  SetLength(FEntries, BLOCK_SIZE);
  for i:=0 to AStrings.Count-1 do begin
    s := AStrings[i];
    if s = '' then
      continue;
    p := pos(':', s);
    if p = 0 then
      continue;
    itemName := Uppercase(copy(s, 1, p-1));
    itemValue := Uppercase(copy(s, p+1, MaxInt));
    case ItemName of
      'BEGIN':
        begin
          FEntries[n] := nil;
          case itemValue of
            'VTIMEZONE':
              begin
                currEntry := TVpICalTimeZoneInfo.Create(self);
                FEntries[n] := currEntry;
              end;
            'VEVENT':
              begin
                currEntry := TVpICalEvent.Create(self);
                FEntries[n] := currEntry;
              end;
            'VTODO':
              begin
                currEntry :=TVpICalToDo.Create(self);
                FEntries[n] := currEntry;
              end;
            'VJOURNAL':
              currEntry := nil;
            'VFREEBUSY':
              currEntry := nil;
            'VALARM':
              if currEntry is TVpICalEvent then begin
                oldEntry := currEntry;
                TVpICalEvent(currEntry).UseAlarm(true);
                currEntry := TVpICalEvent(currEntry).Alarm;
              end;
            else
              Continue;
          end;
          if FEntries[n] <> nil then begin
            inc(n);
            if n mod BLOCK_SIZE = 0 then
              SetLength(FEntries, Length(FEntries) + BLOCK_SIZE);
          end;
        end;
      'END':
        begin
          if currEntry <> nil then
            currEntry.Analyze;
          if oldEntry <> nil then begin
            currEntry := oldEntry;
            oldEntry := nil;
          end else
            currEntry := nil;
        end;
      'VERSION':
        FVersion := itemValue;
      else
        if currEntry <> nil then
          currEntry.Add(s);
    end;
  end;
  SetLength(FEntries, n);
end;

procedure TVpICalendar.SaveToFile(const AFileName: String);
var
  L: TStrings;
begin
  L := TStringList.Create;
  try
    SaveToStrings(L);
    L.SaveToFile(AFileName);
  finally
    L.Free;
  end;
end;

procedure TVpICalendar.SaveToStream(const AStream: TStream);
var
  L: TStrings;
begin
  L := TStringList.Create;
  try
    SaveToStrings(L);
    L.SaveToStream(AStream);
  finally
    L.Free;
  end;
end;

procedure TVpICalendar.SaveToStrings(const AList: TStrings);
var
  i: Integer;
begin
  AList.Clear;
  AList.Add('BEGIN:VCALENDAR');
  if FVersion <> '' then
    AList.Add('VERSION:' + FVersion);

  AList.Add('BEGIN:VTIMEZONE');
  // to do: complete here TIMEZONE section with DAYLIGHT and STANDARD sections
  AList.Add('END:VTIMEZONE');

  for i := 0 to Count-1 do
    Entry[i].SaveToStrings(AList);

  AList.Add('END:VCALENDAR');
end;

function TVpICalendar.ConvertTime(ADateTime: TDateTime;
  ATimeZoneID: String; ToUTC: Boolean): TDateTime;
var
  offs: Double;
  i: Integer;
begin
  offs := 0;
  for i:=0 to Count-1 do begin
    if (FEntries[i] is TVpICalTimeZoneInfo) and
       (TVpICalTimeZoneInfo(FEntries[i]).TimeZoneID = ATimeZoneID) then
    begin
      offs := TVpICalTimeZoneInfo(FEntries[i]).UTCOffset;
      break;
    end;
  end;
  if ToUTC then
    Result := ADateTime - offs
  else
    Result := ADateTime + offs;
end;

function TVpICalendar.LocalTimeToUTC(ADateTime: TDateTime;
  ATimeZoneID: String): TDateTime;
begin
  Result := ConvertTime(ADateTime, ATimeZoneID, true);
end;

function TVpICalendar.UTCToLocalTime(ADateTime: TDateTime;
  ATimeZoneID: String): TDateTime;
begin
  Result := ConvertTime(ADateTime, ATimeZoneID, false);
end;

end.