FastReport_2022_VCL/LibD28/frxIOTransportDropbox.pas

{******************************************}
{                                          }
{              FastReport v6.0             }
{            Dropbox Save Filter           }
{                                          }
{         Copyright (c) 1998-2021          }
{                                          }
{******************************************}

unit frxIOTransportDropbox;

interface

{$I frx.inc}

uses
  Classes, frxIOTransportDropboxBase, frxIOTransportHelpers,
  frxBaseTransportConnection;

type
{$IFDEF DELPHI16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
  TfrxDropboxIOTransport = class(TfrxBaseDropboxIOTransport)
  protected
    function FolderAPI(const URL, Source: String): String; override;
    procedure Upload(const Source: TStream; DestFileName: String = ''); override;
    procedure Download(const SourceFileName: String; const Source: TStream); override;
  public
    function GetAccessToken(const AuthorizationCode: String; var ErrorMsg: String): String; override;
    function GetConnectorInstance: TfrxBaseTransportConnectionClass; override;
    procedure TestToken; override;
  end;

implementation

uses
  SysUtils, frxJSON, frxTransportHTTP, frxNetUtils;

{ TfrxDropboxIOTransport }

procedure TfrxDropboxIOTransport.Download(const SourceFileName: String;
  const Source: TStream);
var
  FileName: String;
  THTTP: TfrxTransportHTTP;
begin
  inherited;
  THTTP := TfrxTransportHTTP(FHTTP);
  FileName := RemoteDir + SourceFileName;
  if (Length(FileName) > 0) and (FileName[1] <> '/') then
    FileName := '/' + FileName;
  THTTP.HTTPRequest.Encoding := '';
  THTTP.HTTPRequest.DefAcceptTypes := htcDefaultXML;
  THTTP.HTTPRequest.ContentType := '';
  THTTP.HTTPRequest.CustomHeader.Add('Dropbox-API-Arg: ' + Format('{ "path": "%s"}',
        {$IfDef Delphi12}[JsonEncode(FileName)]));
        {$Else}          [AnsiToUtf8(FileName)]));
        {$EndIf}
  try
    THTTP.Get(FRX_DBOX_DL_URL, Source);
    if THTTP.Errors.Count > 0 then
      raise Exception.Create(THTTP.Errors.Text);
  finally
    THTTP.HTTPRequest.CustomHeader.Clear;
  end;
end;

function TfrxDropboxIOTransport.FolderAPI(const URL, Source: String): String;
var
  Stream: TStringStream;
  THTTP: TfrxTransportHTTP;
begin
  THTTP := TfrxTransportHTTP(FHTTP);
  THTTP.HTTPRequest.ContentType := 'application/json';
  THTTP.HTTPRequest.Encoding := 'UTF-8';
  Stream := TStringStream.Create(Source{$IfDef Delphi12}, TEncoding.UTF8{$EndIf});
  try
    Result := THTTP.Post(URL, Stream);
    if THTTP.Errors.Count > 0 then
      raise Exception.Create(THTTP.Errors.Text);
  finally
    Stream.Free;
  end;
end;

function TfrxDropboxIOTransport.GetAccessToken(const AuthorizationCode: String; var ErrorMsg: String): String;
var
  tHTTP: TfrxTransportHTTP;
  Source: TStringStream;
  Res: String;
  frxJSON: TfrxJSON;
begin
  Source := TStringStream.Create('');
  Source.WriteString('code=' + AuthorizationCode + '&');
  Source.WriteString('grant_type=authorization_code&');
  Source.WriteString('redirect_uri=' + GetRedirectURI);

  try
    tHTTP := TfrxTransportHTTP.Create(nil);
    try
      if BlockedType then
        tHTTP.SocketType := fstBlocking;
      tHTTP.HTTPRequest.Encoding := '';
      tHTTP.HTTPRequest.DefAcceptTypes := htcDefaultXML;
      tHTTP.HTTPRequest.Authorization := 'Basic ' + Base64Encode(AnsiString(ClientId + ':' + ClientSecret));
      tHTTP.HTTPRequest.ContentType := 'application/x-www-form-urlencoded';
      Res := tHTTP.Post('https://api.dropboxapi.com/oauth2/token', Source);
      if Res = '' then
      begin
        ErrorMsg := 'Error: Not connected';
        Exit;
      end;
      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')
        else
          ErrorMsg := 'Error: Answer code: ' + IntToStr(tHTTP.ServerFields.AnswerCode) + ' Result: ' + Res;
      finally
        frxJSON.Free;
      end;
    finally
      tHTTP.Free;
    end;
  finally
    Source.Free;
  end;
end;

function TfrxDropboxIOTransport.GetConnectorInstance: TfrxBaseTransportConnectionClass;
begin
  Result := TfrxTransportHTTP;
end;

procedure TfrxDropboxIOTransport.TestToken;
begin
  frxTestToken('https://api.dropboxapi.com/2/users/get_space_usage', FAccessToken, True);
end;

procedure TfrxDropboxIOTransport.Upload(const Source: TStream;
  DestFileName: String);
var
  Res: String;
  FileName: String;
  THTTP: TfrxTransportHTTP;
begin
  inherited;
  FileName := RemoteDir + DestFileName;
  if (Length(FileName) > 0) and (FileName[1] <> '/') then
    FileName := '/' + FileName;

  THTTP := TfrxTransportHTTP(FHTTP);
  THTTP.HTTPRequest.ContentType := 'application/octet-stream';
  THTTP.HTTPRequest.Encoding := '';
  try
    THTTP.HTTPRequest.CustomHeader.Add('Dropbox-API-Arg: ' +
      Format('{ "path": "%s", "mode": "overwrite"}',
        {$IfDef Delphi12}[JsonEncode(FileName)]));
        {$Else}          [AnsiToUtf8(FileName)]));
        {$EndIf}
    Res := THTTP.Post(FRX_DBOX_UL_URL, Source);
    if THTTP.Errors.Count > 0 then
      raise Exception.Create(THTTP.Errors.Text);
  finally
    THTTP.HTTPRequest.CustomHeader.Clear;
  end;
end;

end.