FastReport_2022_VCL/LibD28x64/frxIOTransportBoxComBase.pas

{******************************************}
{                                          }
{              FastReport v6.0             }
{            BoxCom Save Filter            }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxIOTransportBoxComBase;

interface

{$I frx.inc}

uses
  Classes, Forms, Controls, StdCtrls, ComCtrls,
  frxIOTransportHelpers, frxBaseTransportConnection, frxIOTransportOAuthDialog;

const
  frx_BoxCom_CreateDir_URL = 'https://api.box.com/2.0/folders';
  frx_BoxCom_DelFile_URL = 'https://api.box.com/2.0/files/%s';
  frx_BoxCom_DelDir_URL = 'https://api.box.com/2.0/folders/%s?recursive=true';
  frx_BoxCom_GetToken_URL = 'https://api.box.com/oauth2/token';
  frx_BoxCom_ListDir_URL = 'https://api.box.com/2.0/folders/%s/items?fields=type,name';
  frx_BoxCom_ListDirContinue_URL = 'https://api.box.com/2.0/folders/%s/items?fields=type,name&offset=%u';
  frx_BoxCom_Upload_URL = 'https://upload.box.com/api/2.0/files/content';

type
  TfrxBoxComIOTransportForm = class(TfrxOAuthTransportDialog)
  protected
    function GetHelpLink: String; override;
  public
    procedure UpdateResouces; override;
  end;

{$IFDEF DELPHI16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
  TfrxBaseBoxComIOTransport = class(TfrxHTTPIOTransport)
  protected
    FDirStack: TDirStack;
    function FilterSection: String; override;
    procedure DialogDirChange(Name, Id: String; DirItems: TStrings); override;
    procedure DialogDirCreate(Name: String; DirItems: TStrings); override;
    procedure DialogFileDelete(Name, Id: String; DirItems: TStrings); override;
    procedure DialogDirDelete(Name, Id: String; DirItems: TStrings); override;

    function GetListFolder: String; virtual; abstract;
    function GetListFolderContinue(Offset: Integer): String; virtual; abstract;
    procedure CreateFolder(Dir: String); virtual; abstract;
    procedure DeleteFile(Id: String); virtual; abstract;
    procedure DeleteFolder(Id: String); virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetDescription: String; override;
    class function TransportDialogClass: TfrxBaseTransportDialogClass; override;
    procedure GetDirItems(DirItems: TStrings; aFilter: String = ''); override;
    function GetOAuthURI: String; override;
  end;

implementation

uses
  Windows, SysUtils, Graphics,
  frxMapHelpers, frxRes, frxSaveFilterBrowser, frxUtils,
  frxJSON;

const
  // https://docs.box.com/v2.0/reference#authorize
  MY_SECURITY_TOKEN = 'FUyabdy9G81Y';
  // The root folder of a Box account is always represented by the id <20>0<EFBFBD>.
  RootFolderId = '0';

{ TfrxBoxComIOTransport }

constructor TfrxBaseBoxComIOTransport.Create(AOwner: TComponent);
begin
  inherited;
  FDirStack := TDirStack.Create(RootFolderId);
end;

destructor TfrxBaseBoxComIOTransport.Destroy;
begin
  FDirStack.Free;
  inherited;
end;

procedure TfrxBaseBoxComIOTransport.DialogDirChange(Name, Id: String;
  DirItems: TStrings);
begin
  if Name = '..' then
    FDirStack.Pop
  else
    FDirStack.Push(Id);
  GetDirItems(DirItems);
end;

procedure TfrxBaseBoxComIOTransport.DialogDirCreate(Name: String;
  DirItems: TStrings);
begin
  CreateFolder(Name);
  GetDirItems(DirItems);
end;

procedure TfrxBaseBoxComIOTransport.DialogDirDelete(Name, Id: String;
  DirItems: TStrings);
begin
  DeleteFolder(Id);
  GetDirItems(DirItems);
end;

procedure TfrxBaseBoxComIOTransport.DialogFileDelete(Name, Id: String;
  DirItems: TStrings);
begin
  DeleteFile(Id);
  GetDirItems(DirItems);
end;

function TfrxBaseBoxComIOTransport.FilterSection: String;
begin
  Result := 'BoxComFilter';
end;

class function TfrxBaseBoxComIOTransport.GetDescription: String;
begin
  Result := frxResources.Get('BoxComIOTransport');
end;

procedure TfrxBaseBoxComIOTransport.GetDirItems(DirItems: TStrings; aFilter: String);
var
  HasMore: Boolean;
  Offset, TotalCount: integer;

  procedure FillDirItems(frxJSONArray: TfrxJSONArray);
  var
    i: Integer;
  begin
    if FDirStack.Top <> RootFolderId then // Up directory
      AddToDirItems(DirItems, True, False, '..', FDirStack.Top);

    for i := 0 to frxJSONArray.Count - 1 do
      with frxJSONArray.Get(i) do
        try
          AddToDirItems(DirItems,
            ValueByName('type') = 'folder', ValueByName('type') = 'file',
            ValueByName('name'),            ValueByName('id'));
        finally
          Free;
        end;
    frxJSONArray.Free;
  end;

  procedure GetJSONList(frxJSON: TfrxJSON);
  begin
    if not Assigned(frxJSON) then
      raise Exception.Create('Non valid JSON data');

    FillDirItems(TfrxJSONArray.Create(frxJSON.ObjectByName('entries')));

    Offset := Offset + StrToInt(frxJSON.ValueByName('limit'));
    TotalCount := StrToInt(frxJSON.ValueByName('total_count'));
    HasMore := Offset < TotalCount;
    frxJSON.Free;
  end;

begin
  DirItems.BeginUpdate;
  ClearWithObjects(DirItems);
  Offset := 0;
  GetJSONList(TfrxJSON.Create(GetListFolder));
  while HasMore do
    GetJSONList(TfrxJSON.Create(GetListFolderContinue(Offset)));
  DirItems.EndUpdate;
end;

function TfrxBaseBoxComIOTransport.GetOAuthURI: String;
begin
  Result := 'https://account.box.com/api/oauth2/authorize?' +
                       'response_type=code' + '&' +
                       'client_id=' + ClientID + '&' +
                       'redirect_uri=' + GetRedirectURI + '&' +
                       'state=' + MY_SECURITY_TOKEN;
end;

class function TfrxBaseBoxComIOTransport.TransportDialogClass: TfrxBaseTransportDialogClass;
begin
  Result := TfrxBoxComIOTransportForm;
end;

{ TfrxBoxComIOTransportForm }

function TfrxBoxComIOTransportForm.GetHelpLink: String;
begin
  Result := 'https://app.box.com/developers/console';
end;

procedure TfrxBoxComIOTransportForm.UpdateResouces;
begin
  Tag := 6510;
  ClientIDLabel.Tag := 6511;
  ClientSecLabel.Tag := 6512;
  inherited;
end;

end.