{***************************************************************************}
{ TMS Facebook 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 CloudFacebook;

interface

uses
  Classes, CloudBase, SysUtils, Windows, DBXJSON;

type
  TFaceBookGender = (fbMale, fbFemale);

  TFacebookProfile = class;

  TFacebookProfileItem = class(TCollectionItem)
  private
    FProfile: TFacebookProfile;
    procedure SetProfile(const Value: TFacebookProfile);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Profile: TFacebookProfile read FProfile write SetProfile;
  end;

  TFacebookProfileList = class(TCollection)
  private
    function GetItemProfile(Index: integer): TFacebookProfile;
    procedure SetItemProfile(Index: integer; const Value: TFacebookProfile);
  public
    constructor Create;
    function Find(const ID: integer): TFacebookProfile; overload;
    function Find(const ID: string): TFacebookProfile; overload;
    function Add: TFacebookProfile;
    property Items[Index: integer]: TFacebookProfile read GetItemProfile write SetItemProfile; default;
  end;

  TFacebookObject = class(TPersistent)
  private
    FName: string;
    FID: string;
  public
    procedure Assign(Source: TPersistent); override;
    procedure FromJSON(jo: TJSONObject);
  published
    property ID: string read FID write FID;
    property Name: string read FName write FName;
  end;

  TFacebookObjectItem = class(TCollectionItem)
  private
    FObject: TFacebookObject;
    procedure SetObject(const Value: TFacebookObject);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property FacebookObject: TFacebookObject read FObject write SetObject;
  end;

  TFacebookObjectList = class(TCollection)
  private
    function GetObjectItem(Index: integer): TFacebookObject;
    procedure SetObjectItem(Index: integer; const Value: TFacebookObject);
  public
    constructor Create;
    function Find(const ID: integer): TFacebookObject; overload;
    function Find(const ID: string): TFacebookObject; overload;
    function Add: TFacebookObject;
    property Items[Index: integer]: TFacebookObject read GetObjectItem write SetObjectItem; default;
  end;

  TFacebookPicture = class(TPersistent)
  private
    FCaption: string;
    FID: string;
    FCreatedTime: TDateTime;
    FImageURL: string;
    FLink: string;
    FFrom: TFacebookProfile;
    FUpdatedTime: TDateTime;
  public
    procedure Assign(Source: TPersistent); override;
    procedure FromJSON(jo: TJSONObject);
  published
    property ID: string read FID write FID;
    property Caption: string read FCaption write FCaption;
    property From: TFacebookProfile read FFrom write FFrom;
    property ImageURL: string read FImageURL write FImageURL;
    property Link: string read FLink write FLink;
    property CreatedTime: TDateTime read FCreatedTime write FCreatedTime;
    property UpdatedTime: TDateTime read FUpdatedTime write FUpdatedTime;
  end;

  TFacebookPictureItem = class(TCollectionItem)
  private
    FPicture: TFacebookPicture;
    procedure SetPicture(const Value: TFacebookPicture);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property FacebookPicture: TFacebookPicture read FPicture write SetPicture;
  end;

  TFacebookPictureList = class(TCollection)
  private
    function GetPictureItem(Index: integer): TFacebookPicture;
    procedure SetPictureItem(Index: integer; const Value: TFacebookPicture);
  public
    constructor Create;
    function Find(const ID: integer): TFacebookPicture; overload;
    function Find(const ID: string): TFacebookPicture; overload;
    function Add: TFacebookPicture;
    property Items[Index: integer]: TFacebookPicture read GetPictureItem write SetPictureItem; default;
  end;

  TFacebookAlbum = class(TPersistent)
  private
    FTitle: string;
    FID: string;
    FCreatedTime: TDateTime;
    FLink: string;
    FFrom: TFacebookProfile;
    FUpdatedTime: TDateTime;
    FCoverPhotoID: string;
    FDescription: string;
    FPictures: TFacebookPictureList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure FromJSON(jo: TJSONObject);
  published
    property ID: string read FID write FID;
    property Title: string read FTitle write FTitle;
    property From: TFacebookProfile read FFrom write FFrom;
    property Link: string read FLink write FLink;
    property Description: string read FDescription write FDescription;
    property CoverPhotoID: string read FCoverPhotoID write FCoverPhotoID;
    property CreatedTime: TDateTime read FCreatedTime write FCreatedTime;
    property UpdatedTime: TDateTime read FUpdatedTime write FUpdatedTime;
    property Pictures: TFacebookPictureList read FPictures write FPictures;
  end;

  TFacebookAlbumItem = class(TCollectionItem)
  private
    FAlbum: TFacebookAlbum;
    procedure SetAlbum(const Value: TFacebookAlbum);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property FacebookAlbum: TFacebookAlbum read FAlbum write SetAlbum;
  end;

  TFacebookAlbumList = class(TCollection)
  private
    function GetAlbumItem(Index: integer): TFacebookAlbum;
    procedure SetAlbumItem(Index: integer; const Value: TFacebookAlbum);
  public
    constructor Create;
    function Find(const ID: integer): TFacebookAlbum; overload;
    function Find(const ID: string): TFacebookAlbum; overload;
    function Add: TFacebookAlbum;
    property Items[Index: integer]: TFacebookAlbum read GetAlbumItem write SetAlbumItem; default;
  end;

  TFacebookFeedItem = class(TPersistent)
  private
    FUser: TFacebookProfile;
    FID: string;
    FText: string;
    FSummary: string;
    FStory: string;
    FCreatedTime: TDateTime;
    FImageURL: string;
    FLink: string;
    FLikes: TFacebookProfileList;
    FCaption: string;
    FDescription: string;
    FObjectID: string;
    FToUsers: TFacebookProfileList;
    FUpdatedTime: TDateTime;
    procedure SetUser(const Value: TFacebookProfile);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure FromJSON(jo: TJSONObject);
    property User: TFacebookProfile read FUser write SetUser;
    property ID: string read FID write FID;
    property Text: string read FText write FText;
    property ImageURL: string read FImageURL write FImageURL;
    property Link: string read FLink write FLink;
    property Summary: string read FSummary write FSummary;
    property Caption: string read FCaption write FCaption;
    property Description: string read FDescription write FDescription;
    property CreatedTime: TDateTime read FCreatedTime write FCreatedTime;
    property Story: string read FStory write FStory;
    property ObjectID: string read FObjectID write FObjectID;
    property UpdatedTime: TDateTime read FUpdatedTime write FUpdatedTime;
    property Likes: TFacebookProfileList read FLikes write FLikes;
    property ToUsers: TFacebookProfileList read FToUsers write FToUsers;
  end;

  TFeedItem = class(TCollectionItem)
  private
    FFeedItem: TFacebookFeedItem;
    procedure SetFeedItem(const Value: TFacebookFeedItem);

  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property FeedItem: TFacebookFeedItem read FFeedItem write SetFeedItem;
  end;

  TFeed = class(TCollection)
  private
    function GetFeedItem(Index: integer): TFacebookFeedItem;
    procedure SetFeedItem(Index: integer; const Value: TFacebookFeedItem);
  public
    constructor Create;
    property Items[Index: integer]: TFacebookFeedItem read GetFeedItem write SetFeedItem; default;
    function Add: TFacebookFeedItem;
  end;

  TFacebookProfile = class(TPersistent)
  private
    FFullName: string;
    FLastName: string;
    FGender: TFacebookGender;
    FFirstName: string;
    FLink: string;
    FID: string;
    FEmail: string;
    FBirthDay: string;
    FVerified: boolean;
    FLocale: string;
    FTimeZone: integer;
    FUpdatedTime: TDateTime;
    FUserName: string;
    FMiddleName: string;
    FImageURL: string;
    FLocation: TFacebookObject;
    FRelationShip: string;
    FSignificantOther: TFacebookObject;
    FWebsite: string;
    FHomeTown: TFacebookObject;
    FLikes: TFacebookObjectList;
    FFeed: TFeed;
    FAlbums: TFacebookAlbumList;
  public
    procedure Assign(Source: TPersistent); override;
    procedure FromJSON(jo: TJSONObject);
    constructor Create;
    destructor Destroy; override;
  published
    property ID: string read FID write FID;
    property FullName: string read FFullName write FFullName;
    property FirstName: string read FFirstName write FFirstName;
    property LastName: string read FLastName write FLastName;
    property MiddleName: string read FMiddleName write FMiddleName;
    property Gender: TFacebookGender read FGender write FGender;
    property Link: string read FLink write FLink;
    property UserName: string read FUserName write FUserName;
    property BirthDay: string read FBirthDay write FBirthDay;
    property Email: string read FEmail write FEmail;
    property TimeZone: integer read FTimeZone write FTimeZone;
    property Locale: string read FLocale write FLocale;
    property Verified: boolean read FVerified write FVerified;
    property UpdatedTime: TDateTime read FUpdatedTime write FUpdatedTime;
    property ImageURL: string read FImageURL write FImageURL;
    property HomeTown: TFaceBookObject read FHomeTown write FHomeTown;
    property Location: TFaceBookObject read FLocation write FLocation;
    property RelationShip: string read FRelationShip write FRelationShip;
    property SignificantOther: TFacebookObject read FSignificantOther write FSignificantOther;
    property Website: string read FWebsite write FWebsite;
    property Likes: TFacebookObjectList read FLikes write FLikes;
    property Feed: TFeed read FFeed;
    property Albums: TFacebookAlbumList read FAlbums write FAlbums;
  end;

  TAdvFacebook = class(TCloudBase)
  private
    CallBackURL: string;
    FProfile: TFacebookProfile;
    FFriendList: TFacebookProfileList;
  protected
    {$IF CompilerVersion >= 23.0}
    procedure DoCallBack(ASender: TObject;
      const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure NavigateComplete2(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);
    {$ELSE}
    procedure DoCallBack(ASender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure NavigateComplete2(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
    {$IFEND}

    procedure GetAuthToken;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure DoAuth; override;
    procedure GetUserInfo;
    procedure GetFriends;
    function GetProfileInfo(const ID: string; Profile: TFacebookProfile): boolean;
    function GetLikes(Profile: TFacebookProfile): boolean; overload;
    function GetLikes(FeedItem: TFacebookFeedItem): boolean; overload;
    function GetAlbums(Profile: TFacebookProfile): boolean;
    function GetPictures(Album: TFacebookAlbum): boolean;
    function GetFeed(Profile: TFacebookProfile; Count: integer = 100; Offset: integer = 0;Since: TDateTime = 0): integer;
    function TestTokens: boolean; override;
    function Post(const Msg, Link, Image: string): string;
    function Like(ID: string): string;
    function UnLike(ID: string): string;
    function PostImage(const Msg, FileName: string): string; overload;
    function PostImage(const Msg, FileName: string; Album: TFacebookAlbum): string; overload;
    function GetImageURL(const ImageID: string): string;
    property Profile: TFacebookProfile read FProfile;
    property FriendList: TFacebookProfileList read FFriendList;
  end;

implementation

uses
  Dialogs;

{ TAdvFacebook }

constructor TAdvFacebook.Create(AOwner: TComponent);
begin
  inherited;
  FProfile := TFacebookProfile.Create;
  FFriendLIst := TFacebookProfileList.Create;

  Scopes.Clear;
  Scopes.Add('publish_stream');
  Scopes.Add('publish_actions');
  Scopes.Add('read_stream');
  Scopes.Add('user_photos');
  Scopes.Add('user_about_me');
  Scopes.Add('read_friendlists');
  Scopes.Add('user_hometown');
  Scopes.Add('friends_hometown');
  Scopes.Add('user_location');
  Scopes.Add('friends_location');
  Scopes.Add('user_likes');
  Scopes.Add('friends_likes');
  Scopes.Add('user_website');
  Scopes.Add('friends_website');
  Scopes.Add('user_relationships');
  Scopes.Add('friends_relationships');
  Scopes.Add('user_photos');
  Scopes.Add('friends_photos');
  Scopes.Add('user_birthday');
  Scopes.Add('friends_birthday');
end;

destructor TAdvFacebook.Destroy;
begin
  FProfile.Free;
  FFriendList.Free;
  inherited;
end;

procedure TAdvFacebook.DoAuth;
var
  url: string;
begin
  CallBackURL := 'https://www.facebook.com/connect/login_success.html';

  url := 'https://www.facebook.com/dialog/oauth'
    + '?client_id=' + App.Key + '&redirect_uri=' + URLEncode(CallBackURL)
    + '&response_type=token'
//    + '&scope=publish_stream,read_stream,user_photos,user_about_me,read_friendlists'
    + '&scope=' + ScopeParamText(',',true)
    ;

  if Assigned(AuthBrowser) then
  begin
    AuthBrowser.OnBeforeNavigate2 := DoCallBack;
    AuthBrowser.OnNavigateComplete2 := NavigateComplete2;
    AuthBrowser.Navigate(url);
  end
  else
  begin
    CreateOAuthForm(url, DoCallBack, NavigateComplete2);
  end;
end;

{$IF CompilerVersion >= 23.0}
procedure TAdvFacebook.DoCallBack(ASender: TObject; const pDisp: IDispatch;
  const URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
  var Cancel: WordBool);
{$else}
procedure TAdvFacebook.DoCallBack(ASender: TObject; const pDisp: IDispatch;
  var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
  var Cancel: WordBool);
{$ifend}
//var
//  s:string;
begin
//  s := URL;
//  if pos(CallBackURL,s) > 0 then
//  begin
//    CloseOAuthForm;
//    GetAuthToken;
//  end;
end;

procedure TAdvFacebook.GetAuthToken;
begin
  DoReceivedAccessToken;
end;

function TAdvFacebook.GetFeed(Profile: TFacebookProfile; Count, Offset: integer; Since: TDateTime): integer;
var
  url: string;
  resdat: ansistring;
  jv,jva: TJSONValue;
  jo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  FeedItem: TFacebookFeedItem;
begin
  Result := 0;

  url := 'https://graph.facebook.com/' + Profile.ID + '/feed?access_token=' + Token_Auth;

  if Count > 0 then
    url := url + '&limit=' + IntToStr(Count+Offset);
  if Since > 0 then
    url := url + '&since=' + DateTimeToStr(Since);
  if Offset > 0 then
    url := url + '&offset=' + IntToStr(Offset);

  resdat := HttpsGet(url);

//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jva := GetJSONValue(jv as TJSONObject,'data');
        if Assigned(jva) and (jva is TJSONArray) then
        begin
          // reset list
          if Offset = 0 then
            Profile.Feed.Clear;
          ja := jva as TJSONArray;

          for i := 0 to ja.Size - 1 do
          begin
            jo := ja.Get(i) as TJSONObject;

            FeedItem := Profile.Feed.Add;
            FeedItem.FromJSON(jo);
          end;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;

procedure TAdvFacebook.GetFriends;
var
  url: string;
  resdat: ansistring;
  jv,jva: TJSONValue;
  jo: TJSONObject;
  ja: TJSONArray;
  i: integer;
begin
  url := 'https://graph.facebook.com/me/friends?access_token='  + Token_Auth;

  resdat := HttpsGet(url);

//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jva := GetJSONValue(jv as TJSONObject,'data');
        if Assigned(jva) and (jva is TJSONArray) then
        begin
          // reset list
          FFriendList.Clear;
          ja := jva as TJSONArray;

          for i := 0 to ja.Size - 1 do
          begin
            jo := ja.Get(i) as TJSONObject;
            with FFriendList.Add do
            begin
              FullName := GetJSONProp(jo,'name');
              ID := GetJSONProp(jo,'id');
            end;
          end;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;

{$IF CompilerVersion >= 23.0}
procedure TAdvFacebook.NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
{$else}
procedure TAdvFacebook.NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
{$ifend}
var
  s: string;
begin
  s := url;
//  outputdebugstring(pchar('complete:'+s));

  if pos(CallBackURL,s) > 0 then
  begin
    CloseOAuthForm;
    if pos('access_token', s) > 0 then
    begin
      Token_Auth := Copy(s, Pos('=', s) + 1, Pos('&', s) - Pos('=', s) - 1);
      GetAuthToken;
    end;
  end;
end;

function TAdvFacebook.Post(const Msg, Link, Image: string): string;
var
  resdat: ansistring;
  jv: TJSONValue;
  jo: TJSONObject;
  server, action, data: string;
begin
  if Token_Auth <> '' then
  begin
    server := 'graph.facebook.com';
    action := '/me/feed';
    data := 'access_token=' + Token_Auth;

    if Msg <> '' then
      data := data + '&message=' + URLEncode(Msg);

    if Link <> '' then
      data := data + '&link=' + URLEncode(Link);

    if Image <> '' then
      data := data + '&picture=' + URLEncode(Image);

    HttpsPost(server, action, nil, ansistring(data), resdat);

    if resdat <> '' then
    begin
//      OutputDebugString(pchar(string(resdat)));
      jv := TJSONOBject.ParseJSONValue(string(resdat));
      if Assigned(jv) then
      begin
        try
          jo := jv as TJSONObject;
          Result := GetJSONProp(jo,'id');
        finally
          jv.Free;
        end;
      end;
    end;
  end;
end;

function TAdvFacebook.Like(ID: string): string;
var
  resdat: ansistring;
  server, action, data: string;
begin
  if Token_Auth <> '' then
  begin
    server := 'graph.facebook.com';
    action := '/' + ID + '/likes';
    data := 'access_token=' + Token_Auth;

    HttpsPost(server, action, nil, ansistring(data), resdat);

    if resdat <> '' then
    begin
//      OutputDebugString(pchar(string(resdat)));
      Result := string(resdat);
    end;
  end;
end;

function TAdvFacebook.UnLike(ID: string): string;
var
  resdat: ansistring;
  server, action, data: string;
begin
  if Token_Auth <> '' then
  begin
    server := 'graph.facebook.com';
    action := '/' + ID + '/likes';
    data := 'access_token=' + Token_Auth + '&method=delete';

    HttpsPost(server, action, nil, ansistring(data), resdat);

    if resdat <> '' then
    begin
//      OutputDebugString(pchar(string(resdat)));
      Result := string(resdat);
    end;
  end;
end;

function TAdvFacebook.PostImage(const Msg, FileName: string): string;
begin
  Result := PostImage(Msg, FileName, nil);
end;

function TAdvFacebook.PostImage(const Msg, FileName: string; Album: TFacebookAlbum): string;
var
  resdat, postdata: ansistring;
  url, albumid: string;
  jv: TJSONValue;
  jo: TJSONObject;
begin
  albumid := 'me';
  if Album <> nil then
    albumid := Album.ID;

  url := 'https://graph.facebook.com/' + albumid + '/photos';

  url := url
    + '?access_token='+ Token_Auth;

  postdata := ''
    +'Content-Disposition: form-data; name="message"'#13#10
    + #13#10
    + UTF8Encode(Msg) + #13#10
    + '--AaB03x'#13#10
    +'Content-Disposition: form-data; name="source"; filename="' + ansistring(ExtractFileName(FileName)) + '"'#13#10
//    +'Content-Disposition: form-data; name="picture"; filename="' + ExtractFileName(FileName) + '"'#13#10
    +'Content-Type: application/octet-stream'#13#10
    + #13#10;

  resdat := HttpsPut(url,ExtractFilePath(FileName),ExtractFileName(FileName),nil,postdata,hcPostMultiPart);

  if resdat <> '' then
  begin
    //OutputDebugString(pchar(string(resdat)));
    jv := TJSONOBject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jo := jv as TJSONObject;
        Result := GetJSONProp(jo,'id');
      finally
        jv.Free;
      end;
    end;
  end;
end;

function TAdvFacebook.TestTokens: boolean;
var
  url: string;
  resdat: ansistring;
  jv,jve: TJSONValue;
begin
  Result := false;
  url := 'https://graph.facebook.com/me?access_token='  + Token_Auth;

  resdat := HttpsGet(url);

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jve := GetJSONValue(jv as TJSONObject,'error');
        Result := not Assigned(jve);
        if not Result then
          jve.Free;
      finally
//        jv.Free;
      end;
    end;
  end;
end;

function TAdvFacebook.GetImageURL(const ImageID: string): string;
var
  resdat: ansistring;
  url: string;
  jv: TJSONValue;
  jo: TJSONObject;
begin
  url := 'https://graph.facebook.com/' + ImageID + '?fields=id,source&access_token=' + Token_Auth;
  resdat := HttpsGet(url);

  if resdat <> '' then
  begin
//    OutputDebugString(pchar(string(resdat)));
    jv := TJSONOBject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jo := jv as TJSONObject;
        Result := GetJSONProp(jo,'source');
      finally
        jv.Free;
      end;
    end;
  end;
end;

function TAdvFacebook.GetPictures(Album: TFacebookAlbum): boolean;
var
  url: string;
  resdat: ansistring;
  jv,jva: TJSONValue;
  jo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  ObjectItem: TFacebookAlbum;
  PictureItem: TFacebookPicture;
begin
  Result := false;

  url := 'https://graph.facebook.com/' + Album.ID + '/photos?access_token='  + Token_Auth;

  resdat := HttpsGet(url);

//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jva := GetJSONValue(jv as TJSONObject,'data');
        if Assigned(jva) and (jva is TJSONArray) then
        begin
          Result := true;

          // reset list
          Album.Pictures.Clear;
          ObjectItem := Album;
          ja := jva as TJSONArray;

          for i := 0 to ja.Size - 1 do
          begin
            jo := ja.Get(i) as TJSONObject;
            if Assigned(jo) then
            begin
              PictureItem := ObjectItem.Pictures.Add;
              PictureItem.FromJSON(jo);
            end;
          end;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;

function TAdvFacebook.GetProfileInfo(const ID: string;
  Profile: TFacebookProfile): boolean;
var
  url: string;
  resdat: ansistring;
  jv,jve: TJSONValue;
begin
  Result := false;
  url := 'https://graph.facebook.com/' + ID + '?access_token='  + Token_Auth;

  resdat := HttpsGet(url);
//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jve := GetJSONValue(jv as TJSONObject,'error');
        if not Assigned(jve) then
        begin
          Profile.FromJSON(jv as TJSONObject);
          Result := true;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;

procedure TAdvFacebook.GetUserInfo;
begin
  GetProfileInfo('me', Profile);
end;

function TAdvFacebook.GetLikes(Profile: TFacebookProfile): boolean;
var
  url: string;
  resdat: ansistring;
  jv,jva: TJSONValue;
  jo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  ObjectItem: TFacebookObject;
begin
  Result := false;

  url := 'https://graph.facebook.com/' + Profile.ID + '/likes?access_token='  + Token_Auth;

  resdat := HttpsGet(url);

//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jva := GetJSONValue(jv as TJSONObject,'data');
        if Assigned(jva) and (jva is TJSONArray) then
        begin
          // reset list
          Profile.Likes.Clear;
          ja := jva as TJSONArray;

          for i := 0 to ja.Size - 1 do
          begin
            jo := ja.Get(i) as TJSONObject;

            ObjectItem := Profile.Likes.Add;
            ObjectItem.FromJSON(jo);
          end;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;

function TAdvFacebook.GetLikes(FeedItem: TFacebookFeedItem): boolean;
var
  url: string;
  resdat: ansistring;
  jv,jva: TJSONValue;
  jo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  ObjectItem: TFacebookProfile;
begin
  Result := false;

  url := 'https://graph.facebook.com/' + FeedItem.ID + '/likes?access_token='  + Token_Auth;

  resdat := HttpsGet(url);

//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jva := GetJSONValue(jv as TJSONObject,'data');
        if Assigned(jva) and (jva is TJSONArray) then
        begin
          // reset list
          FeedItem.Likes.Clear;;
          ja := jva as TJSONArray;

          for i := 0 to ja.Size - 1 do
          begin
            jo := ja.Get(i) as TJSONObject;

            ObjectItem := FeedItem.Likes.Add;
            ObjectItem.FromJSON(jo);
          end;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;

function TAdvFacebook.GetAlbums(Profile: TFacebookProfile): boolean;
var
  url: string;
  resdat: ansistring;
  jv,jva: TJSONValue;
  jo: TJSONObject;
  ja: TJSONArray;
  i: integer;
  ObjectItem: TFacebookAlbum;
begin
  Result := false;

  url := 'https://graph.facebook.com/' + Profile.ID + '/albums?access_token='  + Token_Auth;

  resdat := HttpsGet(url);

//  OutputDebugString(pchar(string(resdat)));

  if (resdat <> '') then
  begin
    jv := TJSONObject.ParseJSONValue(string(resdat));
    if Assigned(jv) then
    begin
      try
        jva := GetJSONValue(jv as TJSONObject,'data');
        if Assigned(jva) and (jva is TJSONArray) then
        begin
          // reset list
          Profile.Albums.Clear;
          ja := jva as TJSONArray;

          for i := 0 to ja.Size - 1 do
          begin
            jo := ja.Get(i) as TJSONObject;

            ObjectItem := Profile.Albums.Add;
            ObjectItem.FromJSON(jo);
          end;
        end;
      finally
        jv.Free;
      end;
    end;
  end;
end;


{ TFacebookProfile }

procedure TFacebookProfile.Assign(Source: TPersistent);
begin
 // inherited;

end;

function GetJSONPropCheck(jo: TJSONObject; PropName: string): string;
begin
  Result := '';
  if (Pos('"' + PropName + '":', jo.ToString) > 0) then
    Result := TCloudBase.GetJSONProp(jo,PropName);
end;

constructor TFacebookProfile.Create;
begin
  inherited;
  FHomeTown := TFacebookObject.Create;
  FLocation := TFacebookObject.Create;
  FSignificantOther := TFacebookObject.Create;
  FLikes := TFacebookObjectList.Create;
  FFeed := TFeed.Create;
  FAlbums := TFacebookAlbumList.Create;
end;

destructor TFacebookProfile.Destroy;
begin
  FHomeTown.Free;
  FLocation.Free;
  FSignificantOther.Free;
  FLikes.Free;
  FFeed.Free;
  FAlbums.Free;
  inherited;
end;

procedure TFacebookProfile.FromJSON(jo: TJSONObject);
var
  jv: TJSONValue;
begin
  FFullName := GetJSONPropCheck(jo,'name');
  FFirstName := GetJSONPropCheck(jo,'first_name');
  FLastName := GetJSONPropCheck(jo,'last_name');
  FMiddleName := GetJSONPropCheck(jo,'middle_name');
  FLink := GetJSONPropCheck(jo,'link');
  FID := GetJSONPropCheck(jo,'id');
  if GetJSONPropCheck(jo,'gender') = 'male' then
    FGender := fbMale
  else
    FGender := fbFemale;

  FUserName := GetJSONPropCheck(jo, 'username');
  if FUserName <> '' then
    FImageURl := 'http://graph.facebook.com/' + FUserName + '/picture';

  FBirthday := GetJSONPropCheck(jo,'birthday');

  FEmail := GetJSONPropCheck(jo,'email');
  FWebsite := GetJSONPropCheck(jo,'website');
  FRelationShip := GetJSONPropCheck(jo,'relationship_status');

  if GetJSONPropCheck(jo,'timezone') <> '' then
    FTimeZone := StrToInt(GetJSONPropCheck(jo,'timezone'))
  else
    FTimeZone := -1;

  FLocale := GetJSONPropCheck(jo,'locale');
  if GetJSONPropCheck(jo,'verified') = 'true' then
    FVerified := True
  else
    FVerified := False;

  if GetJSONPropCheck(jo,'updated_time') <> '' then
    FUpdatedTime := TCloudBase.IsoToDateTime(GetJSONPropCheck(jo,'updated_time'));

  jv := TCloudBase.GetJSONValue(jo,'location');
  if Assigned(jv) then
    Location.FromJSON(jv as TJSONObject);

  jv := TCloudBase.GetJSONValue(jo,'hometown');
  if Assigned(jv) then
    Location.FromJSON(jv as TJSONObject);

  jv := TCloudBase.GetJSONValue(jo,'significant_other');
  if Assigned(jv) then
    SignificantOther.FromJSON(jv as TJSONObject);
end;



{ TFacebookProfileItem }

procedure TFacebookProfileItem.Assign(Source: TPersistent);
begin
  //inherited;

end;

constructor TFacebookProfileItem.Create(Collection: TCollection);
begin
  inherited;
  FProfile := TFacebookProfile.Create;
end;

destructor TFacebookProfileItem.Destroy;
begin
  FProfile.Free;
  inherited;
end;

procedure TFacebookProfileItem.SetProfile(const Value: TFacebookProfile);
begin
  FProfile.Assign(Value);
end;

{ TFacebookProfileList }

function TFacebookProfileList.Add: TFacebookProfile;
begin
  Result := TFacebookProfileItem(inherited Add).Profile;
end;

constructor TFacebookProfileList.Create;
begin
  inherited Create(TFacebookProfileItem);
end;

function TFacebookProfileList.Find(const ID: integer): TFacebookProfile;
begin
  Result := Find(IntToStr(ID));
end;

function TFacebookProfileList.Find(const ID: string): TFacebookProfile;
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 TFacebookProfileList.GetItemProfile(Index: integer): TFacebookProfile;
begin
  Result := TFacebookProfileItem(inherited Items[Index]).Profile;
end;

procedure TFacebookProfileList.SetItemProfile(Index: integer;
  const Value: TFacebookProfile);
begin
  TFacebookProfileItem(inherited Items[Index]).Profile.Assign(Value);
end;



{ TFacebookFeedItem }

procedure TFacebookFeedItem.Assign(Source: TPersistent);
begin
  if (Source is TFacebookFeedItem) then
  begin
    FText := (Source as TFacebookFeedItem).Text;
    FID := (Source as TFacebookFeedItem).ID;
  end;
end;

constructor TFacebookFeedItem.Create;
begin
  inherited;
  FUser := TFacebookProfile.Create;
  FLikes := TFacebookProfileList.Create;
  FToUsers := TFacebookProfileList.Create;
end;

destructor TFacebookFeedItem.Destroy;
begin
  FUser.Free;
  FLikes.Free;
  FToUsers.Free;
  inherited;
end;

procedure TFacebookFeedItem.FromJSON(jo: TJSONObject);
var
  jvo, joa: TJSONObject;
  jv, jva: TJSONValue;
  ja: TJSONArray;
  I: integer;
  UserProfile: TFacebookProfile;
begin
  Text := TCloudBase.GetJSONProp(jo,'message');
  ID := TCloudBase.GetJSONProp(jo,'id');
  ImageURL := TCloudBase.GetJSONProp(jo,'picture');
  Link := TCloudBase.GetJSONProp(jo,'link');
  Summary := TCloudBase.GetJSONProp(jo,'name');
  Caption := TCloudBase.GetJSONProp(jo,'caption');
  Description := TCloudBase.GetJSONProp(jo,'description');

  if TCloudBase.GetJSONProp(jo,'created_time') <> '' then
    CreatedTime := TCloudBase.IsoToDateTime(TCloudBase.GetJSONProp(jo,'created_time'));
  if TCloudBase.GetJSONProp(jo,'updated_time') <> '' then
    UpdatedTime := TCloudBase.IsoToDateTime(TCloudBase.GetJSONProp(jo,'updated_time'));

  Story := TCloudBase.GetJSONProp(jo,'story');
  ObjectID := TCloudBase.GetJSONProp(jo,'object_id');

//  OutputDebugString(pchar('FEEDITEM: ' + jo.ToString));

  jva := TCloudBase.GetJSONValue(jo,'likes');
  if Assigned(jva) then
  begin
    // reset list
    Likes.Clear;

    joa := jva as TJSONObject;

    ja := TCloudBase.GetJSONValue(joa,'data') as TJSONArray;

    for i := 0 to ja.Size - 1 do
    begin
      jvo := ja.Get(i) as TJSONObject;

      UserProfile := Likes.Add;
      UserProfile.FromJSON(jvo);
    end;
  end;

  jva := TCloudBase.GetJSONValue(jo,'to');

  if Assigned(jva) then
  begin
    // reset list
    ToUsers.Clear;

    joa := jva as TJSONObject;
    ja := TCloudBase.GetJSONValue(joa,'data') as TJSONArray;

    for i := 0 to ja.Size - 1 do
    begin
      jvo := ja.Get(i) as TJSONObject;

//      OutputDebugString(pchar('TO USERS: ' + jvo.ToString));

      UserProfile := ToUsers.Add;
      UserProfile.FromJSON(jvo);
    end;
  end;

  jv := TCloudBase.GetJSONValue(jo,'from');
  if Assigned(jv) then
    User.FromJSON(jv as TJSONObject);
end;

procedure TFacebookFeedItem.SetUser(const Value: TFacebookProfile);
begin
  FUser.Assign(Value);
end;

{ TFeedItem }

constructor TFeedItem.Create(Collection: TCollection);
begin
  inherited;
  FFeedItem := TFacebookFeedItem.Create;
end;

destructor TFeedItem.Destroy;
begin
  FFeedItem.Free;
  inherited;
end;

procedure TFeedItem.SetFeedItem(const Value: TFacebookFeedItem);
begin
  FFeedItem.Assign(Value);
end;

{ TFeed }

function TFeed.Add: TFacebookFeedItem;
begin
  Result := TFeedItem(inherited Add).FeedItem;
end;

constructor TFeed.Create;
begin
  inherited Create(TFeedItem);
end;

function TFeed.GetFeedItem(Index: integer): TFacebookFeedItem;
begin
  Result := TFeedItem(inherited Items[Index]).FeedItem;
end;

procedure TFeed.SetFeedItem(Index: integer; const Value: TFacebookFeedItem);
begin
  TFeedItem(inherited Items[Index]).FeedItem.Assign(Value);
end;

{ TFacebookObject }

procedure TFacebookObject.Assign(Source: TPersistent);
begin
  inherited;

end;

procedure TFacebookObject.FromJSON(jo: TJSONObject);
begin
  ID := TCloudBase.GetJSONProp(jo,'id');
  Name := TCloudBase.GetJSONProp(jo,'name');
end;


{ TFacebookObjectItem }

procedure TFacebookObjectItem.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor TFacebookObjectItem.Create(Collection: TCollection);
begin
  inherited;
  FObject := TFacebookObject.Create;
end;

destructor TFacebookObjectItem.Destroy;
begin
  FObject.Free;
  inherited;
end;

procedure TFacebookObjectItem.SetObject(const Value: TFacebookObject);
begin
  FObject.Assign(Value);
end;


{ TFacebookObjectList }

function TFacebookObjectList.Add: TFacebookObject;
begin
  Result := TFacebookObjectItem(inherited Add).FObject;
end;

constructor TFacebookObjectList.Create;
begin
  inherited Create(TFacebookObjectItem);
end;

function TFacebookObjectList.Find(const ID: string): TFacebookObject;
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 TFacebookObjectList.Find(const ID: integer): TFacebookObject;
begin
  Result := Find(IntToStr(ID));
end;

function TFacebookObjectList.GetObjectItem(Index: integer): TFacebookObject;
begin
  Result := TFacebookObjectItem(inherited Items[Index]).FObject;
end;

procedure TFacebookObjectList.SetObjectItem(Index: integer;
  const Value: TFacebookObject);
begin
  TFacebookObjectItem(inherited Items[Index]).FObject.Assign(Value);
end;

{ TFacebookAlbum }

procedure TFacebookAlbum.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor TFacebookAlbum.Create;
begin
  Pictures := TFacebookPictureList.Create;
end;

destructor TFacebookAlbum.Destroy;
begin
  FPictures.Free;
  inherited;
end;

procedure TFacebookAlbum.FromJSON(jo: TJSONObject);
begin
  ID := TCloudBase.GetJSONProp(jo,'id');
  Title := TCloudBase.GetJSONProp(jo,'name');
  CoverPhotoID := TCloudBase.GetJSONProp(jo,'cover_photo');
  Link := TCloudBase.GetJSONProp(jo,'link');
  Description := TCloudBase.GetJSONProp(jo,'description');

  if GetJSONPropCheck(jo,'created_time') <> '' then
    CreatedTime := TCloudBase.IsoToDateTime(GetJSONPropCheck(jo,'created_time'));
  if GetJSONPropCheck(jo,'updated_time') <> '' then
    UpdatedTime := TCloudBase.IsoToDateTime(GetJSONPropCheck(jo,'updated_time'));
end;

{ TFacebookAlbumItem }

procedure TFacebookAlbumItem.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor TFacebookAlbumItem.Create(Collection: TCollection);
begin
  inherited;
  FAlbum := TFacebookAlbum.Create;
end;

destructor TFacebookAlbumItem.Destroy;
begin
  FAlbum.Free;
  inherited;
end;

procedure TFacebookAlbumItem.SetAlbum(const Value: TFacebookAlbum);
begin
  FAlbum.Assign(Value);
end;

{ TFacebookAlbumList }

function TFacebookAlbumList.Add: TFacebookAlbum;
begin
  Result := TFacebookAlbumItem(inherited Add).FAlbum;
end;

constructor TFacebookAlbumList.Create;
begin
  inherited Create(TFacebookAlbumItem);
end;

function TFacebookAlbumList.Find(const ID: string): TFacebookAlbum;
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 TFacebookAlbumList.Find(const ID: integer): TFacebookAlbum;
begin
  Result := Find(IntToStr(ID));
end;

function TFacebookAlbumList.GetAlbumItem(Index: integer): TFacebookAlbum;
begin
  Result := TFacebookAlbumItem(inherited Items[Index]).FAlbum;
end;

procedure TFacebookAlbumList.SetAlbumItem(Index: integer;
  const Value: TFacebookAlbum);
begin
  TFacebookAlbumItem(inherited Items[Index]).FAlbum.Assign(Value);
end;

{ TFacebookPicture }

procedure TFacebookPicture.Assign(Source: TPersistent);
begin
  inherited;

end;

procedure TFacebookPicture.FromJSON(jo: TJSONObject);
begin
  ID := GetJSONPropCheck(jo,'id');
  Caption := GetJSONPropCheck(jo,'name');
  Link := GetJSONPropCheck(jo,'link');
  ImageURL := GetJSONPropCheck(jo,'picture');

  if GetJSONPropCheck(jo,'created_time') <> '' then
    CreatedTime := TCloudBase.IsoToDateTime(GetJSONPropCheck(jo,'created_time'));
//  if GetJSONPropCheck(jo,'updated_time') <> '' then
//    UpdatedTime := TCloudBase.IsoToDateTime(GetJSONPropCheck(jo,'updated_time'));
end;

{ TFacebookPictureItem }

procedure TFacebookPictureItem.Assign(Source: TPersistent);
begin
  inherited;

end;

constructor TFacebookPictureItem.Create(Collection: TCollection);
begin
  inherited;
  FPicture := TFacebookPicture.Create;
end;

destructor TFacebookPictureItem.Destroy;
begin
  FPicture.Free;
  inherited;
end;

procedure TFacebookPictureItem.SetPicture(const Value: TFacebookPicture);
begin
  FPicture.Assign(Value);
end;

{ TFacebookPictureList }

function TFacebookPictureList.Add: TFacebookPicture;
begin
  Result := TFacebookPictureItem(inherited Add).FPicture;
end;

constructor TFacebookPictureList.Create;
begin
  inherited Create(TFacebookAlbumItem);
end;

function TFacebookPictureList.Find(const ID: string): TFacebookPicture;
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 TFacebookPictureList.Find(const ID: integer): TFacebookPicture;
begin
  Result := Find(IntToStr(ID));
end;

function TFacebookPictureList.GetPictureItem(Index: integer): TFacebookPicture;
begin
  Result := TFacebookPictureItem(inherited Items[Index]).FPicture;
end;

procedure TFacebookPictureList.SetPictureItem(Index: integer;
  const Value: TFacebookPicture);
begin
  TFacebookPictureItem(inherited Items[Index]).FPicture.Assign(Value);
end;

end.

