{***************************************************************************}
{ TMS WinLive Cloud access                                                  }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2012                                               }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit CloudLiveCalendar;

interface

uses
  Classes, CloudBase, CloudLive, SysUtils, Windows;

type
  TAdvLiveCalendar = class;
  TLiveCalendars = class;
  TLiveCalendarItems = class;

  TAvailability = (avFree, avBusy, avTentative, avOutOfOffice);
  TVisibility = (viPublic, viPrivate);

  TLiveCalendar = class(TCollectionItem)
  private
    FOwner: TLiveCalendarItems;
    FSummary: string;
    FDescription: string;
    FID: string;
    FReadOnly: boolean;
    procedure SetDescription(const Value: string);
    procedure SetID(const Value: string);
    procedure SetReadOnly(const Value: boolean);
    procedure SetSummary(const Value: string);
  public
    constructor Create(Collection: TCollection);  override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetOwner: TPersistent; override;
  protected
    function GetDisplayName: string; override;
  published
    property ID: string read FID write SetID;
    property Summary: string read FSummary write SetSummary;
    property Description: string read FDescription write SetDescription;
    property ReadOnly: boolean read FReadOnly write SetReadOnly;
  end;

  TLiveCalendars = class(TCollection)
  private
    FOwner: TAdvLiveCalendar;
    function GetItems(Index: Integer): TLiveCalendar;
    procedure SetItems(Index: Integer; const Value: TLiveCalendar);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TAdvLiveCalendar);
    function GetOwner: TPersistent; override;
    function Add: TLiveCalendar;
    function Insert(Index: Integer):TLiveCalendar;
    property Items[Index: Integer]: TLiveCalendar read GetItems write SetItems; default;
  end;

  TLiveCalendarItem = class(TCollectionItem)
  private
    FOwner: TLiveCalendarItems;
    FLocation: string;
    FSummary: string;
    FStartTime: TDateTime;
    FIsAllDay: boolean;
    FEndTime: TDateTime;
    FDescription: string;
    FID: string;
    FVisibility: TVisibility;
    FAvailability: TAvailability;
    FRecurrence: string;
    FIsRecurrent: boolean;
    FCalendarID: string;
    procedure SetDescription(const Value: string);
    procedure SetEndTime(const Value: TDateTime);
    procedure SetIsAllDay(const Value: boolean);
    procedure SetLocation(const Value: string);
    procedure SetSummary(const Value: string);
    procedure SetStartTime(const Value: TDateTime);
    procedure SetID(const Value: string);
    procedure SetAvailability(const Value: TAvailability);
    procedure SetVisibility(const Value: TVisibility);
    procedure SetCalendarID(const Value: string);

  public
    constructor Create(Collection: TCollection);  override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetOwner: TPersistent; override;
  protected
    function GetDisplayName: string; override;
  published
    property ID: string read FID write SetID;
    property CalendarID: string read FCalendarID write SetCalendarID;
    property Summary: string read FSummary write SetSummary;
    property Description: string read FDescription write SetDescription;
    property StartTime: TDateTime read FStartTime write SetStartTime;
    property EndTime: TDateTime read FEndTime write SetEndTime;
    property Location: string read FLocation write SetLocation;
    property IsAllDay: boolean read FIsAllDay write SetIsAllDay default false;
    property Availability: TAvailability read FAvailability write SetAvailability default avFree;
    property Visibility: TVisibility read FVisibility write SetVisibility default viPublic;
    property IsRecurrent: boolean read FIsRecurrent default false;
    property Recurrence: string read FRecurrence;
  end;

  TLiveCalendarItems = class(TCollection)
  private
    FOwner: TAdvLiveCalendar;
    function GetItems(Index: Integer): TLiveCalendarItem;
    procedure SetItems(Index: Integer; const Value: TLiveCalendarItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TAdvLiveCalendar);
    function GetOwner: TPersistent; override;
    function Add: TLiveCalendarItem;
    function Find(const ID: integer): TLiveCalendarItem; overload;
    function Find(const ID: string): TLiveCalendarItem; overload;
    function Insert(Index: Integer):TLiveCalendarItem;
    property Items[Index: Integer]: TLiveCalendarItem read GetItems write SetItems; default;
  end;

  TAdvLiveCalendar = class(TCloudLive)
  private
    APIBase: string;
    FItems: TLiveCalendarItems;
    FCalendars: TLiveCalendars;
  protected
    function GetCalendarData(Item: TLiveCalendarItem): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetCalendars;
    procedure GetCalendar(ID: string; FromDate, ToDate: TDate); overload;
    procedure GetCalendar(FromDate, ToDate: TDate); overload;
    procedure GetCalendar(ID: string); overload;
    procedure GetCalendar(); overload;
    procedure Add(Item: TLiveCalendarItem);
    procedure Update(Item: TLiveCalendarItem);
    procedure Delete(Item: TLiveCalendarItem);
  published
    property Calendars: TLiveCalendars read FCalendars write FCalendars;
    property Items: TLiveCalendarItems read FItems write FItems;
    property Locale;
  end;

implementation

uses
  DBXJSON;

{ TAdvLiveCalendar }

constructor TAdvLiveCalendar.Create(AOwner: TComponent);
begin
  inherited;
  APIBase := 'https://apis.live.net/v5.0/';

  FCalendars := TLiveCalendars.Create(Self);
  FItems := TLiveCalendarItems.Create(self);

  //required scopes
  Scopes.Add('wl.basic');
  Scopes.Add('wl.calendars');
  Scopes.Add('wl.calendars_update');
end;

destructor TAdvLiveCalendar.Destroy;
begin
  FCalendars.Free;
  FItems.Free;
  inherited;
end;

procedure TAdvLiveCalendar.GetCalendar(ID: string);
begin
  GetCalendar(ID, 0, 0);
end;

procedure TAdvLiveCalendar.GetCalendar(ID: string; FromDate, ToDate: TDate);
var
  url, avail, vis: string;
  o, fo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  di: TLiveCalendarItem;
begin

  if ID = EmptyStr then
    url := APIBase + 'me/events?'
  else
    url := APIBase + ID + '/events?';

  url := url + 'access_token=' + Token_Access;

  if (FromDate <> 0) and (ToDate <> 0)  then
  begin
    url := url + '&start_time=' + DateToWL(FromDate) + '&end_time=' + DateToWL(ToDate);
  end;

  o := GetJSONObject(url);

  ja := GetJSONValue(o,'data') as TJSONArray;

  try
    if Assigned(ja) then
    begin
      Items.Clear;
      for i := 0 to ja.Size - 1 do
      begin
        fo := ja.Get(i) as TJSONObject;

        di := Items.Add;
        di.ID := GetJSONProp(fo,'id');
        di.Summary := GetJSONProp(fo,'name');
        di.Description := GetJSONProp(fo,'description');
        di.Location := GetJSONProp(fo,'location');
        di.StartTime := IsoToDateTime(GetJSONProp(fo,'start_time'));
        di.EndTime := IsoToDateTime(GetJSONProp(fo,'end_time'));
        di.IsAllDay := GetJSONValue(fo,'is_all_day_event') is TJSONTrue;
        di.FIsRecurrent := GetJSONValue(fo,'is_recurrent') is TJSONTrue;
        di.FRecurrence := GetJSONProp(fo,'recurrence');

        avail := GetJSONProp(fo,'availability');
        if avail = 'free' then
          di.Availability := avFree
        else if avail = 'busy' then
          di.Availability := avBusy
        else if avail = 'tentative' then
          di.Availability := avTentative
        else if avail = 'out_of_office' then
          di.Availability := avOutOfOffice;

        vis := GetJSONProp(fo,'visibility');
        if vis = 'public' then
          di.Visibility := viPublic
        else
          di.Visibility := viPrivate;

        //ffo := GetJSONValue(fo,'from') as TJSONObject;
        //OutputDebugString(pchar('EVENT FROM NAME= ' + GetJSONProp(ffo,'name')));

      end;
//      OutputDebugString(pchar(o.ToString));
    end;
  finally
    if Assigned(o) then
      o.Free;
  end;
end;

procedure TAdvLiveCalendar.GetCalendar(FromDate, ToDate: TDate);
begin
  GetCalendar(EmptyStr, FromDate, ToDate);
end;

procedure TAdvLiveCalendar.GetCalendar;
begin
  GetCalendar(EmptyStr, 0 , 0);
end;

function TAdvLiveCalendar.GetCalendarData(Item: TLiveCalendarItem): string;
var
  isallday, avail, vis: string;
begin
  if Item.IsAllDay then
    isallday := 'true'
  else
    isallday := 'false';

  case Item.Availability of
    avFree: avail := 'free';
    avBusy: avail := 'busy';
    avTentative: avail := 'tentative';
    avOutOfOffice: avail := 'out_of_office';
  end;

  case Item.Visibility of
    viPublic: vis := 'public';
    viPrivate: vis := 'private';
  end;

  Result :=
  '{' + #13#10
  + '    "name": "' + Item.Summary +' ",' + #13#10
  + '    "description": "' + Item.Description + '",' + #13#10
  + '    "start_time": "' + DateTimeToWL(Item.StartTime) + '",' + #13#10
  + '    "end_time": "' + DateTimeToWL(Item.EndTime) + '",' + #13#10
  + '    "location": "' + Item.Location + '",' + #13#10
  + '    "is_all_day_event": ' + isallday + ',' + #13#10
  + '    "availability": "' + avail + '",' + #13#10
  + '    "visibility": "' + vis + '"' + #13#10
  + '}';

//  Outputdebugstring(pchar('Start time: ' + DateTimeToWL(Item.StartTime)));
end;

procedure TAdvLiveCalendar.GetCalendars;
var
  url, perms: string;
  o, fo: TJSONObject;
  ja: TJSONArray;
  di: TLiveCalendar;
  i: integer;
begin
  url := APIBase + 'me/calendars/?';
  url := url + 'access_token=' + Token_Access;
  o := GetJSONObject(url);

  ja := GetJSONValue(o,'data') as TJSONArray;

  try
    if Assigned(ja) then
    begin
      Items.Clear;
      for i := 0 to ja.Size - 1 do
      begin
        fo := ja.Get(i) as TJSONObject;
//        OutputDebugString(pchar('CAL: ' + fo.ToString));

        di := Calendars.Add;
        di.ID := GetJSONProp(fo,'id');
        di.Summary := GetJSONProp(fo,'name');
        di.Description := GetJSONProp(fo,'description');

        di.ReadOnly := true;
        perms := GetJSONProp(fo,'permissions');
        if (perms = 'owner') or (perms = 'co_owner') or (perms = 'read_write') then
          di.ReadOnly := false;

      end;
    end;
  finally
    if Assigned(o) then
      o.Free;
  end;
end;

procedure TAdvLiveCalendar.Add(Item: TLiveCalendarItem);
var
  headers: TCoreCloudHeaders;
  resdat, data: ansistring;
  url: string;
begin

  AddHeader(headers, 'Authorization', 'Bearer ' + Token_Access  + #13#10);
  AddHeader(headers, 'Content-Type', 'application/json');

  data := UTF8Encode(GetCalendarData(Item));

  url := APIBase + Item.CalendarID + '/events';

  HttpsPost(ExtractServer(url),RemoveServer(url),headers,data,resdat);
//  OutputDebugString(pchar('ADD RESULT: ' + string(resdat)));
end;

procedure TAdvLiveCalendar.Delete(Item: TLiveCalendarItem);
var
  url: string;
  resdat, data: ansistring;
begin
  url := APIBase + URLEncode(Item.ID) + '?access_token=' + Token_Access;
  data := '';
  HttpsDelete(ExtractServer(url),RemoveServer(url),nil,data,resdat);
//  OutputDebugString(pchar('DELETE: ' + string(resdat)));
end;

procedure TAdvLiveCalendar.Update(Item: TLiveCalendarItem);
var
  headers: TCoreCloudHeaders;
  resdat, data: ansistring;
  url: string;
begin
  AddHeader(headers, 'Authorization', 'Bearer ' + Token_Access  + #13#10);
  AddHeader(headers, 'Content-Type', 'application/json');

  data := ansistring(GetCalendarData(Item));

  url := APIBase + Item.ID;

  HttpsUpdate(ExtractServer(url),RemoveServer(url),headers,data,resdat);

//  OutputDebugString(pchar('Result UPDATE := ' + string(resdat)));
end;


{ TLiveCalendarItem }

procedure TLiveCalendarItem.Assign(Source: TPersistent);
begin
  if (Source is TLiveCalendarItem) then
  begin
    FID := (Source as TLiveCalendarItem).ID;
    FCalendarID := (Source as TLiveCalendarItem).CalendarID;
    FSummary := (Source as TLiveCalendarItem).Summary;
    FDescription := (Source as TLiveCalendarItem).Description;
    FStartTime := (Source as TLiveCalendarItem).StartTime;
    FEndTime := (Source as TLiveCalendarItem).EndTime;
    FLocation := (Source as TLiveCalendarItem).Location;
    FIsAllDay := (Source as TLiveCalendarItem).IsAllDay;
    FAvailability := (Source as TLiveCalendarItem).Availability;
    FVisibility := (Source as TLiveCalendarItem).Visibility;
    FIsRecurrent := (Source as TLiveCalendarItem).IsRecurrent;
    FRecurrence := (Source as TLiveCalendarItem).Recurrence;
  end;
end;

constructor TLiveCalendarItem.Create(Collection: TCollection);
begin
  inherited;
  FID := EmptyStr;
  FCalendarID := EmptyStr;
  FSummary := 'Item ' + IntToStr(Collection.Count - 1);
  FDescription := EmptyStr;
  FStartTime := Date;
  FEndTime := Date;
  FLocation := EmptyStr;
  FIsAllDay := false;
  FAvailability := avFree;
  FVisibility := viPublic;
  FIsRecurrent := false;
  FRecurrence := EmptyStr;

  if Collection is TLiveCalendarItems then
  begin
    FOwner := Collection as TLiveCalendarItems;
  end;
end;

destructor TLiveCalendarItem.Destroy;
begin
  inherited;
end;

function TLiveCalendarItem.GetDisplayName: string;
begin
  if Summary <> '' then
    Result := Summary
  else
    Result := 'Item '+ IntToStr(Index);
end;

function TLiveCalendarItem.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TLiveCalendarItem.SetAvailability(const Value: TAVailability);
begin
  FAvailability := Value;
end;

procedure TLiveCalendarItem.SetCalendarID(const Value: string);
begin
  FCalendarID := Value;
end;

procedure TLiveCalendarItem.SetDescription(const Value: string);
begin
  FDescription := Value;
end;

procedure TLiveCalendarItem.SetEndTime(const Value: TDateTime);
begin
  FEndTime := Value;
end;

procedure TLiveCalendarItem.SetID(const Value: string);
begin
  FID := Value;
end;

procedure TLiveCalendarItem.SetIsAllDay(const Value: boolean);
begin
  FIsAllDay := Value;
end;

procedure TLiveCalendarItem.SetLocation(const Value: string);
begin
  FLocation := Value;
end;

procedure TLiveCalendarItem.SetSummary(const Value: string);
begin
  FSummary := Value;
end;

procedure TLiveCalendarItem.SetStartTime(const Value: TDateTime);
begin
  FStartTime := Value;
end;

procedure TLiveCalendarItem.SetVisibility(const Value: TVisibility);
begin
  FVisibility := Value;
end;

{ TLiveCalendarItems }

function TLiveCalendarItems.Add: TLiveCalendarItem;
begin
  Result := TLiveCalendarItem(inherited Add);
end;

constructor TLiveCalendarItems.Create(AOwner: TAdvLiveCalendar);
begin
  inherited Create(TLiveCalendarItem);
  FOwner := AOwner;
end;

function TLiveCalendarItems.Find(const ID: integer): TLiveCalendarItem;
begin
  Result := Find(IntToStr(ID));
end;

function TLiveCalendarItems.Find(const ID: string): TLiveCalendarItem;
var
  i: integer;
begin
  Result := nil;

  for i := 0 to Count - 1 do
  begin
    if Items[i].ID = ID then
    begin
      Result := Items[i];
      break;
    end;
  end;
end;

function TLiveCalendarItems.GetItems(Index: Integer): TLiveCalendarItem;
begin
  Result := TLiveCalendarItem(inherited Items[Index]);
end;

function TLiveCalendarItems.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TLiveCalendarItems.Insert(Index: Integer): TLiveCalendarItem;
begin
  Result := TLiveCalendarItem(inherited Insert(Index));
end;

procedure TLiveCalendarItems.SetItems(Index: Integer;
  const Value: TLiveCalendarItem);
begin
  inherited Items[Index] := Value;
end;

procedure TLiveCalendarItems.Update(Item: TCollectionItem);
begin
  inherited;
end;


{ TLiveCalendar }

procedure TLiveCalendar.Assign(Source: TPersistent);
begin
  if (Source is TLiveCalendar) then
  begin
    FID := (Source as TLiveCalendar).ID;
    FSummary := (Source as TLiveCalendar).Summary;
    FDescription := (Source as TLiveCalendar).Description;
    FReadOnly := (Source as TLiveCalendar).ReadOnly;
  end;
end;

constructor TLiveCalendar.Create(Collection: TCollection);
begin
  inherited;
  FID := EmptyStr;
  FSummary := 'Item ' + IntToStr(Collection.Count - 1);
  FDescription := EmptyStr;
  FReadOnly := true;

  if Collection is TLiveCalendarItems then
  begin
    FOwner := Collection as TLiveCalendarItems;
  end;
end;

destructor TLiveCalendar.Destroy;
begin
  inherited;
end;

function TLiveCalendar.GetDisplayName: string;
begin
  if Summary <> '' then
    Result := Summary
  else
    Result := 'Calendar '+ IntToStr(Index);
end;

function TLiveCalendar.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TLiveCalendar.SetDescription(const Value: string);
begin
  FDescription := Value;
end;

procedure TLiveCalendar.SetID(const Value: string);
begin
  FID := Value;
end;

procedure TLiveCalendar.SetReadOnly(const Value: boolean);
begin
  FReadOnly := Value;
end;

procedure TLiveCalendar.SetSummary(const Value: string);
begin
  FSummary := Value;
end;

{ TLiveCalendars }

function TLiveCalendars.Add: TLiveCalendar;
begin
  Result := TLiveCalendar(inherited Add);
end;

constructor TLiveCalendars.Create(AOwner: TAdvLiveCalendar);
begin
  inherited Create(TLiveCalendar);
  FOwner := AOwner;
end;

function TLiveCalendars.GetItems(Index: Integer): TLiveCalendar;
begin
  Result := TLiveCalendar(inherited Items[Index]);
end;

function TLiveCalendars.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TLiveCalendars.Insert(Index: Integer): TLiveCalendar;
begin
  Result := TLiveCalendar(inherited Insert(Index));
end;

procedure TLiveCalendars.SetItems(Index: Integer; const Value: TLiveCalendar);
begin
  inherited Items[Index] := Value;
end;

procedure TLiveCalendars.Update(Item: TCollectionItem);
begin
  inherited;
end;

end.
