{******************************************} { } { FastReport v6.0 } { GoogleDrive Save Filter } { } { Copyright (c) 1998-2021 } { by Fast Reports Inc. } { } {******************************************} unit frxIOTransportGoogleDriveIndy; interface {$I frx.inc} uses Classes, Forms, Controls, StdCtrls, ComCtrls, frxIOTransportHelpers, frxIOTransportGoogleDriveBase, frxBaseTransportConnection, IdHTTP, IdComponent; type {$IFDEF DELPHI16} [ComponentPlatformsAttribute(pidWin32 or pidWin64)] {$ENDIF} TfrxGoogleDriveIOTransportIndy = class(TfrxBaseGoogleDriveIOTransport) protected function GetListFolder(aFilter: String = ''): String; override; function GetListFolderContinue(NextPageToken: String; aFilter: String = ''): String; override; procedure CreateFolder(Dir: String); override; procedure DeleteFileOrFolder(const Id: String); override; procedure Upload(const Source: TStream; DestFileName: String = ''); override; procedure Download(const SourceFileName: String; const Source: TStream); 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; { TfrxGoogleDriveIOTransport } procedure TfrxGoogleDriveIOTransportIndy.CreateFolder(Dir: String); var Stream: TStringStream; IdHTTP: TIdHTTP; begin IdHTTP := TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP; IdHTTP.Request.ContentType := 'application/json'; {$IfNDef Indy9} {$IfNDef INDY10_1} IdHTTP.Request.CharSet:='UTF-8'; {$EndIf} {$EndIf} Stream := TStringStream.Create( Format('{"mimeType": "%s", "name": "%s", "parents": ["%s"]}', {$IfDef Delphi12}[frx_GoogleDrive_MimeFolder, Dir, FDirStack.Top]), TEncoding.UTF8); {$Else} [frx_GoogleDrive_MimeFolder, JsonEncode(Dir), FDirStack.Top])); {$EndIf} try IdHTTP.Post(frx_GoogleDrive_CreateDir_URL, Stream); finally Stream.Free; end; end; procedure TfrxGoogleDriveIOTransportIndy.DeleteFileOrFolder(const 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_GoogleDrive_Delete_URL, [Id]), nil, nil, []); {$EndIf} {$EndIf} end; procedure TfrxGoogleDriveIOTransportIndy.Download(const SourceFileName: String; const Source: TStream); var sList: TStringList; sID: String; Index: Integer; begin inherited; sID := ''; SList := TStringList.Create; GetDirItems(SList, SourceFileName); Index := sList.IndexOf(SourceFileName); if Index = -1 then Exit; sID := TIdObject(sList.Objects[Index]).Id; try TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP.Get(Format(frx_GoogleDrive_Download_URL, [sID]), Source); finally ClearWithObjects(SList); SList.Free; end; end; function TfrxGoogleDriveIOTransportIndy.GetAccessToken(const AuthorizationCode: String; var ErrorMsg: String): String; var IdHTTP: TIdHTTP; Source: TStringStream; Res: String; frxJSON: TfrxJSON; begin Source := TStringStream.Create(''); Source.WriteString('code=' + AuthorizationCode + '&'); Source.WriteString('client_id=' + ClientId + '&'); Source.WriteString('client_secret=' + ClientSecret + '&'); Source.WriteString('redirect_uri=' + GetRedirectURI + '&'); Source.WriteString('grant_type=authorization_code'); try IdHttp := TIdHttp.Create(nil); try {$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'; Res := IdHttp.Post(frx_GoogleDrive_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 TfrxGoogleDriveIOTransportIndy.GetConnectorInstance: TfrxBaseTransportConnectionClass; begin Result := TfrxTransportIndyConnectorHTTP; end; class function TfrxGoogleDriveIOTransportIndy.GetDescription: String; begin Result := '(Indy)' + inherited GetDescription; end; function TfrxGoogleDriveIOTransportIndy.GetListFolder(aFilter: String): String; begin if aFilter <> '' then aFilter := Format('+and+name=''%s''', [aFilter]); Result := TfrxTransportIndyConnectorHTTP(FHTTP) .GetIdHTTP.Get(Format(frx_GoogleDrive_ListDir_URL, [FDirStack.Top, aFilter])); end; function TfrxGoogleDriveIOTransportIndy.GetListFolderContinue(NextPageToken: String; aFilter: String): String; begin if aFilter <> '' then aFilter := Format('+and+name=''%s''', [aFilter]); Result := TfrxTransportIndyConnectorHTTP(FHTTP) .GetIdHTTP.Get(Format(frx_GoogleDrive_ListDirContinue_URL, [FDirStack.Top, aFilter, NextPageToken])); end; procedure TfrxGoogleDriveIOTransportIndy.TestToken; begin frxTestTokenIndy('https://www.googleapis.com/drive/v3/files?q=''root''+in+parents+and+name=''testaccesstokenconnection.fastreport''', FAccessToken, False); end; procedure TfrxGoogleDriveIOTransportIndy.Upload(const Source: TStream; DestFileName: String); const Boundary = '560310243403'; var MemoryStream: TMemoryStream; IdHTTP: TIdHTTP; procedure Put(str: AnsiString); begin MemoryStream.Write(str[1], Length(str)); end; procedure PutLn(str: AnsiString = ''); begin Put(str + #13#10); end; begin inherited; IdHTTP := TfrxTransportIndyConnectorHTTP(FHTTP).GetIdHTTP; idHTTP.Request.ContentType := Format('multipart/related; boundary="%s"', [Boundary]); {$IfNDef Indy9} {$IfNDef INDY10_1} idHTTP.Request.CharSet:=''; {$EndIf} {$EndIf} MemoryStream := TMemoryStream.Create; PutLn('--' + Boundary); PutLn('Content-ID: '); PutLn('Content-Type: application/json'); PutLn; PutLn(SureAnsi(Format( '{"name": "%s", "parents": ["%s"]}', [SureUTF8(DestFileName), FDirStack.Top]))); PutLn('--' + Boundary); PutLn('Content-ID: '); PutLn('Content-Type: application/octet-stream'); PutLn; MemoryStream.CopyFrom(Source, Source.Size); PutLn; Put('--' + Boundary + '--'); try idHTTP.Post(frx_GoogleDrive_Upload_URL, MemoryStream); finally MemoryStream.Free; end; end; end.