FastReport_2022_VCL/Source/frxIOTransportBoxComIndy.pas

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

unit frxIOTransportBoxComIndy;

interface

{$I frx.inc}

uses
  Classes, Forms, Controls, StdCtrls, ComCtrls,
  frxIOTransportHelpers, frxIOTransportBoxComBase,
  frxBaseTransportConnection, IdHTTP, IdComponent;

type
{$IFDEF DELPHI16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
  TfrxBoxComIOTransportIndy = class(TfrxBaseBoxComIOTransport)
  protected
    function GetListFolder: String; override;
    function GetListFolderContinue(Offset: Integer): String; override;
    procedure CreateFolder(Dir: String); override;
    procedure DeleteFile(Id: String); override;
    procedure DeleteFolder(Id: String); override;

    procedure Upload(const Source: TStream; DestFileName: String = '');
      override;
  public
    function GetConnectorInstance: TfrxBaseTransportConnectionClass; override;
    class function GetDescription: String; override;
    function GetAccessToken(const AuthorizationCode: String; var ErrorMsg: String): String; override;
    procedure TestToken; override;
  end;

implementation

uses
  SysUtils, frxMapHelpers, frxRes, frxJSON, frxTransportIndyConnectorHTTP,
  IdSSLOpenSSL, Variants, StrUtils, IdURI, IdMultipartFormData;

type
  TIdHTTPAccess = class(TIdHTTP)
  end;

{ TfrxBoxComIOTransport }

procedure TfrxBoxComIOTransportIndy.CreateFolder(Dir: String);
var
  Stream: TStringStream;
  IdHTTP: TIdHTTP;
begin
  IdHTTP := TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP;
  IdHTTP.Request.ContentType := 'application/json';
  {$IfNDef Indy9}
  {$IfDef Delphi14}
  IdHTTP.Request.CharSet := 'UTF-8';
  {$EndIf}
  {$EndIf}

  Stream := TStringStream.Create(Format('{"name": "%s", "parent": {"id": "%s"}}',
    {$IfDef Delphi12}[Dir, FDirStack.Top]), TEncoding.UTF8);
    {$Else}          [JsonEncode(Dir), FDirStack.Top]));
    {$EndIf}

  try
    IdHTTP.Post(frx_BoxCom_CreateDir_URL, Stream);
  finally
    Stream.Free;
  end;
end;

procedure TfrxBoxComIOTransportIndy.DeleteFile(Id: String);
begin
// Indy 10.0 don't have TIdHTTP.Delete, Indy 10.6 have it
//  FHTTP.Delete(Format(URL, [Id]));
{$IfNDef Indy9}
{$IfNDef INDY10_1}
  TIdHTTPAccess(TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP)
    .DoRequest('DELETE', Format(frx_BoxCom_DelFile_URL, [Id]), nil, nil, []);
{$EndIf}
{$EndIf}
end;

procedure TfrxBoxComIOTransportIndy.DeleteFolder(Id: String);
begin
// Indy 10.0 don't have TIdHTTP.Delete, Indy 10.6 have it
//  FHTTP.Delete(Format(URL, [Id]));
{$IfNDef Indy9}
{$IfNDef INDY10_1}
  TIdHTTPAccess(TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP)
    .DoRequest('DELETE', Format(frx_BoxCom_DelDir_URL, [Id]), nil, nil, []);
{$EndIf}
{$EndIf}
end;

function TfrxBoxComIOTransportIndy.GetAccessToken(const AuthorizationCode: String; var ErrorMsg: String): String;
var
  IdHttp: TIdHttp;
  Source: TStringStream;
  Res: String;
  frxJSON: TfrxJSON;
begin
  Source := TStringStream.Create('');
  Source.WriteString('grant_type=authorization_code&');
  Source.WriteString('code=' + AuthorizationCode + '&');
  Source.WriteString('client_id=' + ClientId + '&');
  Source.WriteString('client_secret=' + ClientSecret);
  try
    IdHTTP := TIdHTTP.Create(nil);
{$IFDEF Indy9}
    IdHTTP.IOHandler := TIdSSLIOHandlerSocket.Create(IdHTTP);
    TIdSSLIOHandlerSocket(IdHTTP.IOHandler).SSLOptions.Method := sslvTLSv1;
    IdHTTP.Request.CustomHeaders.FoldLength := MaxInt;
{$ELSE}
    IdHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
{$ENDIF}
    //IdHTTP.Request.BasicAuthentication := False;
    IdHTTP.Request.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9';
    IdHTTP.Request.ContentType := 'application/x-www-form-urlencoded';
{$IfNDef Indy9}
{$IfNDef INDY10_1}
    IdHTTP.Request.CharSet:='';
{$EndIf}
{$EndIf}
    try
      Res := IdHTTP.Post(frx_BoxCom_GetToken_URL, Source);
      frxJSON := TfrxJSON.Create(Res);
      try
        if      frxJSON.IsNameExists('access_token') then
          Result := frxJSON.ValueByName('access_token')
        else if frxJSON.IsNameValueExists('type', 'error') then
          ErrorMsg := 'Error: ' + frxJSON.ValueByName('status') + '; ' +
            frxJSON.ValueByName('message');
      finally
        frxJSON.Free;
      end;
    finally
      IdHTTP.Free;
    end;
  finally
    Source.Free;
  end;
end;

function TfrxBoxComIOTransportIndy.GetConnectorInstance: TfrxBaseTransportConnectionClass;
begin
  Result := TfrxTransportIndyConnectorHTTP;
end;

class function TfrxBoxComIOTransportIndy.GetDescription: String;
begin
  Result :=  '(Indy)' + inherited GetDescription;
end;

function TfrxBoxComIOTransportIndy.GetListFolder: String;
begin
  Result := TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP.Get(Format(frx_BoxCom_ListDir_URL, [FDirStack.Top]));
end;

function TfrxBoxComIOTransportIndy.GetListFolderContinue(Offset: Integer): String;
begin
  Result := TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP.Get(Format(frx_BoxCom_ListDirContinue_URL, [FDirStack.Top, Offset]));
end;

procedure TfrxBoxComIOTransportIndy.TestToken;
begin
  frxTestTokenIndy('https://api.box.com/2.0/folders/%s/items?fields=type,name', FAccessToken, False);
end;

procedure TfrxBoxComIOTransportIndy.Upload(const Source: TStream;
  DestFileName: String);
var
  MultipartData: TIdMultipartFormDataStream;
  IdHTTP: TIdHTTP;
begin
  inherited;
  IdHTTP := TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP;
  MultipartData := TIdMultipartFormDataStream.Create;
  try
    MultipartData.AddFormField('metadata',
      Format('{"name": "%s", "parent": {"id": "%s"}}',
             [SureUTF8(DestFileName), FDirStack.Top])
    {$IfDef INDY10_1}
                   );
    {$Else}
    {$IfDef Indy9} );
    {$Else}        , 'utf-8', 'application/json').ContentTransfer := '8bit';
    {$EndIf}
    {$EndIf}
    //MultipartData.AddFile('content', SourceFileName, 'application/octet-stream');
{$IfDef Indy9}
    MultipartData.AddObject('content', 'application/octet-stream', Source, '');
{$Else}
{$IfDef INDY10_1}
{$IFDEF DELPHI15}
    MultipartData.AddObject('content', 'application/octet-stream', 'utf-8', Source, '');
{$ELSE}
    MultipartData.AddObject('content', 'application/octet-stream', Source, '');
{$EndIf}
{$Else}
    MultipartData.AddFormField('content', 'application/octet-stream', '', Source);
{$EndIf}
{$EndIf}
    IdHTTP.Post(frx_BoxCom_Upload_URL, MultipartData);
  finally
    MultipartData.Free;
  end;
end;

end.