{***************************************************************************}
{ 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 CloudLiveContacts;

interface

uses
  Classes, CloudBase, CloudLive, SysUtils, Windows;

type
  TAdvLiveContacts = class;
  TLiveContactItems = class;

  TGender = (geNotSpecified, geFemale, geMale);

  TLiveContactItem = class(TCollectionItem)
  private
    FOwner: TLiveContactItems;
    FLastName: string;
    FID: string;
    FFirstName: string;
    FBirthDay: integer;
    FBirthMonth: integer;
    FUserID: string;
    FGender: TGender;
    FIsFavorite: boolean;
    FIsFriend: boolean;
    FFullName: string;
    procedure SetBirthDay(const Value: integer);
    procedure SetBirthMonth(const Value: integer);
    procedure SetFirstName(const Value: string);
    procedure SetGender(const Value: TGender);
    procedure SetIsFavorite(const Value: boolean);
    procedure SetIsFriend(const Value: boolean);
    procedure SetLastName(const Value: string);
    procedure SetUserID(const Value: string);
    procedure SetFullName(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;
    property FirstName: string read FFirstName write SetFirstName;
    property LastName: string read FLastName write SetLastName;
    property FullName: string read FFullName write SetFullName;
    property Gender: TGender read FGender write SetGender default geNotSpecified;
    property IsFriend: boolean read FIsFriend write SetIsFriend default false;
    property IsFavorite: boolean read FIsFavorite write SetIsFavorite default false;
    property UserID: string read FUserID write SetUserID;
    property BirthDay: integer read FBirthDay write SetBirthDay default -1;
    property BirthMonth: integer read FBirthMonth write SetBirthMonth default -1;

  end;

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

  TAdvLiveContacts = class(TCloudLive)
  private
    APIBase: string;
    FItems: TLiveContactItems;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetContacts;
    procedure Add(Item: TLiveContactItem);
  published
    property Items: TLiveContactItems read FItems write FItems;
    property Locale;
  end;

implementation

uses
  DBXJSON;

{ TAdvLiveContacts }

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

  FItems := TLiveContactItems.Create(self);

  //required scopes
  Scopes.Add('wl.basic');
  Scopes.Add('wl.contacts_birthday');
  Scopes.Add('wl.contacts_create');
  Scopes.Add('wl.emails');
// restricted scope
//  Scopes.Add('wl.postal_addresses');
//  Scopes.Add('wl.phone_numbers');
//  Scopes.Add('wl.contacts_update');
end;

destructor TAdvLiveContacts.Destroy;
begin
  FItems.Free;
  inherited;
end;

procedure TAdvLiveContacts.GetContacts;
var
  url, gender, bd, bm: string;
  o, fo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  di: TLiveContactItem;
begin
  url := APIBase + 'me/contacts/?';
  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;

        di := Items.Add;
        di.FID := GetJSONProp(fo,'id');
        di.FFirstName := GetJSONProp(fo,'first_name');
        di.FLastName := GetJSONProp(fo,'last_name');
        di.FFullName := GetJSONProp(fo,'name');

        gender := GetJSONProp(fo,'gender');
        if gender = 'female' then
          di.FGender := geFemale
        else if gender = 'male' then
          di.FGender := geMale
        else
          di.FGender := geNotSpecified;

        di.FIsFriend := GetJSONValue(fo,'is_friend') is TJSONTrue;
        di.FIsFavorite := GetJSONValue(fo,'is_favorite') is TJSONTrue;
        di.FUserID := GetJSONProp(fo,'user_id');

        bd := GetJSONProp(fo,'birth_day');
        if not (bd = EmptyStr) then
          di.FBirthDay := StrToInt(bd);

        bm := GetJSONProp(fo,'birth_month');
        if not (bm = EmptyStr) then
          di.FBirthMonth := StrToInt(bm);
      end;
//      OutputDebugString(pchar(o.ToString));
    end;
  finally
    if Assigned(o) then
      o.Free;
  end;
end;

procedure TAdvLiveContacts.Add(Item: TLiveContactItem);
var
  headers: TCoreCloudHeaders;
  resdat, data: ansistring;
  url: string;
  contact: string;
  isfriend, isfavorite, gen: string;
begin

  case Item.Gender of
    geFemale: gen := 'female';
    geMale: gen := 'male';
  end;

  if Item.IsFriend then
    isfriend := 'true'
  else
    isfriend := 'false';

  if Item.IsFavorite then
    isfavorite := 'true'
  else
    isfavorite := 'false';

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

  contact :=
  '{' + #13#10
  + '    "first_name": "' + Item.FirstName + '",' + #13#10
  + '    "last_name": "' + Item.LastName + '",' + #13#10;

  if Item.Gender <> geNotSpecified then
    contact := contact + '    "gender": "' + gen + '",' + #13#10;

  contact := contact +
    '    "birth_day": ' + IntToStr(Item.BirthDay) + ',' + #13#10
  + '    "birth_month": ' + IntToStr(Item.BirthMonth) + ',' + #13#10
  + '    "is_friend": ' + isfriend + ',' + #13#10
  + '    "is_favorite": ' + isfavorite + '' + #13#10
  + '}';

  data := UTF8Encode(contact);

  url := APIBase + 'me/contacts';

  HttpsPost(ExtractServer(url),RemoveServer(url),headers,data,resdat);
end;


{ TLiveContactItem }

procedure TLiveContactItem.Assign(Source: TPersistent);
begin
  if (Source is TLiveContactItem) then
  begin
    FID := (Source as TLiveContactItem).ID;
    FFirstName := (Source as TLiveContactItem).FirstName;
    FLastName := (Source as TLiveContactItem).LastName;
    FGender := (Source as TLiveContactItem).Gender;
    FIsFriend := (Source as TLiveContactItem).IsFriend;
    FIsFavorite := (Source as TLiveContactItem).IsFavorite;
    FUserID := (Source as TLiveContactItem).UserID;
    FBirthDay := (Source as TLiveContactItem).BirthDay;
    FBirthMonth := (Source as TLiveContactItem).BirthMonth;
  end;
end;

constructor TLiveContactItem.Create(Collection: TCollection);
begin
  inherited;
  FID := EmptyStr;
  FFirstName := 'Item ' + IntToStr(Collection.Count - 1);
  FLastName := EmptyStr;

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

destructor TLiveContactItem.Destroy;
begin
  inherited;
end;

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

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

procedure TLiveContactItem.SetBirthDay(const Value: integer);
begin
  FBirthDay := Value;
end;

procedure TLiveContactItem.SetBirthMonth(const Value: integer);
begin
  FBirthMonth := Value;
end;

procedure TLiveContactItem.SetFirstName(const Value: string);
begin
  FFirstName := Value;
end;

procedure TLiveContactItem.SetGender(const Value: TGender);
begin
  FGender := Value;
end;

procedure TLiveContactItem.SetIsFavorite(const Value: boolean);
begin
  FIsFavorite := Value;
end;

procedure TLiveContactItem.SetIsFriend(const Value: boolean);
begin
  FIsFriend := Value;
end;

procedure TLiveContactItem.SetLastName(const Value: string);
begin
  FLastName := Value;
end;

procedure TLiveContactItem.SetFullName(const Value: string);
begin
  FFullName := Value;
end;

procedure TLiveContactItem.SetUserID(const Value: string);
begin
  FUserID := Value;
end;

{ TLiveContactItems }

function TLiveContactItems.Add: TLiveContactItem;
begin
  Result := TLiveContactItem(inherited Add);
end;

constructor TLiveContactItems.Create(AOwner: TAdvLiveContacts);
begin
  inherited Create(TLiveContactItem);
  FOwner := AOwner;
end;

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

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

function TLiveContactItems.Insert(Index: Integer): TLiveContactItem;
begin
  Result := TLiveContactItem(inherited Insert(Index));
end;

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

procedure TLiveContactItems.Update(Item: TCollectionItem);
begin
  inherited;

end;

end.
