1248 lines
33 KiB
ObjectPascal
1248 lines
33 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v6.0 }
|
|
{ Save Filter Helpers }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxIOTransportHelpers;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
frxClass, frxProgress, Classes, IniFiles, Controls, Forms, StdCtrls,
|
|
frxBaseTransportConnection, frxBaseForm, frxProtocolFactory,
|
|
frxBaseTransportDialogForm;
|
|
|
|
const
|
|
frxTransportTokenName = 'AccessToken';
|
|
|
|
type
|
|
TfrxInternetIOTransport = class;
|
|
|
|
TfrxBaseTransportDialog = class(TfrxBaseForm)
|
|
protected
|
|
FIni: TCustomIniFile;
|
|
FFilter: TfrxInternetIOTransport;
|
|
function GetIniFile(TransportFilter: TfrxInternetIOTransport): TCustomIniFile;
|
|
procedure InitDialog; virtual;
|
|
function Decode64(Text: String): String;
|
|
function Encode64(Text: String): String;
|
|
procedure IniLoadComboBox(ComboBox: TComboBox);
|
|
procedure IniLoadComboBoxWithItems(ComboBox: TComboBox);
|
|
procedure IniLoadEdit(Edit: TEdit);
|
|
procedure IniLoadCheckBox(CheckBox: TCheckBox);
|
|
procedure IniSaveComboBoxItem(ComboBox: TComboBox);
|
|
procedure IniSaveComboBox(ComboBox: TComboBox);
|
|
procedure IniSaveEdit(Edit: TEdit);
|
|
procedure IniSaveCheckBox(CheckBox: TCheckBox);
|
|
public
|
|
destructor Destroy; override;
|
|
procedure UpdateResouces; override;
|
|
procedure InitControlsFromFilter(TransportFilter: TfrxInternetIOTransport); virtual;
|
|
procedure InitFilterFromDialog(TransportFilter: TfrxInternetIOTransport); virtual;
|
|
end;
|
|
|
|
TfrxBaseOAuthTransportDialog = class(TfrxBaseTransportDialog)
|
|
protected
|
|
FErrorMessage: String;
|
|
FRedirectURI: String;
|
|
function GetTokenDialog: Boolean; virtual;
|
|
function GetClientID: String; virtual; abstract;
|
|
function GetClientSecret: String; virtual; abstract;
|
|
function IniLoadStringCrypt(const SectionName: String): String;
|
|
procedure IniSaveStringCrypt(const SectionName, Data: String);
|
|
public
|
|
procedure InitControlsFromFilter(TransportFilter: TfrxInternetIOTransport); override;
|
|
property ErrorMessage: String read FErrorMessage;
|
|
end;
|
|
|
|
|
|
TfrxBaseTransportDialogClass = class of TfrxBaseTransportDialog;
|
|
TfrxBaseFormClass = class of TfrxBaseTransportDialogForm;
|
|
|
|
TfrxInternetIOTransport = class(TfrxCustomIOTransport)
|
|
private
|
|
FUseIniFile: Boolean;
|
|
FShowProgress: Boolean;
|
|
procedure ConnectionWorkBegin(Sender: TObject; AWorkMode: TfrxHTTPWorkMode; AWorkCount: Int64);
|
|
procedure ConnectionWork(Sender: TObject; AWorkMode: TfrxHTTPWorkMode; AWorkCount: Int64);
|
|
protected
|
|
FIsFilterOpened: Boolean;
|
|
FProgress: TfrxProgress;
|
|
FWorkBeginPosition: Int64;
|
|
FDefaultProxyPort: Integer;
|
|
FProxyHost: String;
|
|
FProxyPort: integer;
|
|
FProxyUserName: String;
|
|
FProxyPassword: String;
|
|
FUserName: String;
|
|
FPassword: String;
|
|
function Connection: TfrxBaseTransportConnection; virtual; abstract;
|
|
function FormShowModal: TModalResult;
|
|
procedure CreateProgress(ProgressCaption: String);
|
|
|
|
function FilterSection: String; virtual; abstract;
|
|
function PropertiesSection: String;
|
|
procedure ProcessFiles;
|
|
|
|
function SizeOfFiles: Int64;
|
|
function IsSelectFileName: Boolean;
|
|
function IsSelectDirectory: Boolean;
|
|
function SendFiles: String;
|
|
|
|
function DoCreateStream(var aFullFilePath: String; aFileName: String): TStream; override;
|
|
class function GetProtocolClass: TfrxCustomDataLinkProtocolClass; virtual;
|
|
{ connector }
|
|
{ initialize connector - called before sending files }
|
|
function CreateConnector: Boolean; virtual; abstract;
|
|
{ free connector }
|
|
procedure DisposeConnector; virtual; abstract;
|
|
{ establish connection }
|
|
function DoConnectorConncet: Boolean; virtual; abstract;
|
|
{ prepare connection for file sending }
|
|
function DoBeforeSent: Boolean; virtual;
|
|
{ send file stream }
|
|
procedure Upload(const Source: TStream; DestFileName: String = ''); virtual; abstract;
|
|
procedure Download(const SourceFileName: String; const Source: TStream); virtual;
|
|
{ creates remote directory }
|
|
procedure CreateRemoteDir(DirName: String; ChangeDir: Boolean = True); virtual;
|
|
{ change current directory to parent }
|
|
procedure ChangeDirUP; virtual;
|
|
|
|
function IsDeleteSupported: Boolean; virtual;
|
|
|
|
procedure SetName(const NewName: TComponentName); override;
|
|
|
|
{ Dialog callback's }
|
|
procedure DialogDirChange(Name, Id: String; DirItems: TStrings); virtual; abstract;
|
|
procedure DialogDirCreate(Name: String; DirItems: TStrings); virtual; abstract;
|
|
procedure DialogDirDelete(Name, Id: String; DirItems: TStrings); virtual; abstract;
|
|
procedure DialogFileDelete(Name, Id: String; DirItems: TStrings); virtual; abstract;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure AssignFilter(Source: TfrxCustomIOTransport); override;
|
|
function OpenFilter: Boolean; override;
|
|
procedure CloseFilter; override;
|
|
{ get directory items }
|
|
function GetConnectorInstance: TfrxBaseTransportConnectionClass; virtual; abstract;
|
|
procedure GetDirItems(DirItems: TStrings; aFilter: String = ''); virtual; abstract;
|
|
class function TransportDialogClass: TfrxBaseTransportDialogClass; virtual;
|
|
class function TransportPostDialogClass(DM: TfrxIOInternetDialogMode): TfrxBaseFormClass; virtual;
|
|
procedure TestToken; virtual;
|
|
procedure SilentAuthorize; virtual;
|
|
published
|
|
property UseIniFile: Boolean read FUseIniFile write FUseIniFile;
|
|
property ShowProgress: Boolean read FShowProgress write FShowProgress;
|
|
property DefaultProxyPort: Integer read FDefaultProxyPort;
|
|
property ProxyHost: String read FProxyHost write FProxyHost;
|
|
property ProxyPort: integer read FProxyPort write FProxyPort;
|
|
property ProxyUserName: String read FProxyUserName write FProxyUserName;
|
|
property ProxyPassword: String read FProxyPassword write FProxyPassword;
|
|
property UserName: String read FUserName write FUserName;
|
|
property Password: String read FPassword write FPassword;
|
|
end;
|
|
// TODO: split to HTTP and OAuth
|
|
TfrxHTTPIOTransport = class(TfrxInternetIOTransport)
|
|
private
|
|
FClientID: String;
|
|
FUseProxyServer: Boolean;
|
|
FConnected: Boolean;
|
|
FClientSecret: String;
|
|
FEncryptionKey: AnsiString;
|
|
FBlockedType: Boolean;
|
|
protected
|
|
FHTTP: TfrxBaseTransportConnection;
|
|
FAccessToken: String;
|
|
FRemoteDir: String;
|
|
FAccessTokens: TStrings;
|
|
FListenerPort: Integer;
|
|
function Connection: TfrxBaseTransportConnection; override;
|
|
procedure SetProxy;
|
|
procedure Upload(const Source: TStream; DestFileName: String = ''); override;
|
|
procedure ChangeDirUP; override;
|
|
procedure TestRemoteDir; virtual; // Empty
|
|
function CreateConnector: Boolean; override;
|
|
procedure DisposeConnector; override;
|
|
function DoConnectorConncet: Boolean; override;
|
|
procedure AddToDirItems(DirItems: TStrings; IsFolder, IsFile: Boolean;
|
|
Name: String; Id: String = ''); virtual;
|
|
procedure SetRemoteDir(const Value: String); virtual;
|
|
function GetRemoteDir: String; virtual;
|
|
function LoadTokenFromIni: Boolean;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure AssignSharedProperties(Source: TfrxCustomIOTransport); override;
|
|
procedure AssignFilter(Source: TfrxCustomIOTransport); override;
|
|
procedure DownloadToStream(const SourceFileName: String; const Source: TStream);
|
|
function OpenFilter: Boolean; override;
|
|
function GetRedirectURI: String; virtual;
|
|
function GetOAuthURI: String; virtual; abstract;
|
|
function GetAccessToken(const AuthorizationCode: String; var ErrorMsg: String): String; virtual; abstract;
|
|
function IsFinalURLTest(const URL: String; var Errors: String): Boolean; virtual;
|
|
property RemoteDir: String read GetRemoteDir write SetRemoteDir;
|
|
property EncryptionKey: AnsiString read FEncryptionKey write FEncryptionKey;
|
|
property BlockedType: Boolean read FBlockedType write FBlockedType;
|
|
published
|
|
property AccessToken: String read FAccessToken write FAccessToken;
|
|
property ClientID: String read FClientID write FClientID;
|
|
property ClientSecret: String read FClientSecret write FClientSecret;
|
|
property UseProxyServer: Boolean read FUseProxyServer write FUseProxyServer;
|
|
property ListenerPort: Integer read FListenerPort write FListenerPort default 9898;
|
|
end;
|
|
|
|
TIdObject = class
|
|
private
|
|
FId: String;
|
|
public
|
|
constructor Create(AId: String);
|
|
property Id: String read FId;
|
|
end;
|
|
|
|
TDirStack = class
|
|
private
|
|
StringList: TStringList;
|
|
public
|
|
constructor Create(st: String);
|
|
destructor Destroy; override;
|
|
|
|
procedure Push(st: String);
|
|
function Pop: String;
|
|
function Top: String;
|
|
function Full: String;
|
|
function FullWOFirst: String;
|
|
end;
|
|
|
|
procedure ClearLabelsFontStyle(Form: TForm);
|
|
function CopySubstring(const Source: String; Left, Right: Array of String): String;
|
|
function JsonEncode(str: String): String;
|
|
function SureUTF8(str: String): String;
|
|
function SureAnsi(str: String): AnsiString;
|
|
function PathFirstSlash(const Path: String): String;
|
|
function PathChangeDir(const Path, Dir: String): String;
|
|
procedure ClearWithObjects(DirItems: TStrings);
|
|
|
|
implementation
|
|
|
|
uses
|
|
Registry, SysUtils, Graphics, StrUtils, frxSaveFilterBrowser,
|
|
frxNetUtils, frxFileUtils, frxUtils, frxRes, rc_Crypt,
|
|
frxHTTPTransportsProtocol, frxIOTransportIntDialog
|
|
{$IFDEF DELPHI12}
|
|
, AnsiStrings
|
|
{$ENDIF}
|
|
;
|
|
|
|
{ Functions }
|
|
|
|
procedure ClearWithObjects(DirItems: TStrings);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to DirItems.Count - 1 do
|
|
DirItems.Objects[i].Free;
|
|
DirItems.Clear;
|
|
end;
|
|
|
|
function PathChangeDir(const Path, Dir: String): String;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if Dir = '..' then
|
|
begin
|
|
i := Length(Path);
|
|
if Path[i] = '/' then Dec(i);
|
|
while Path[i] <> '/' do
|
|
Dec(i);
|
|
Result := Copy(Path, 1, i - 1);
|
|
end
|
|
else
|
|
Result := Path + '/' + Dir;
|
|
end;
|
|
|
|
function PathFirstSlash(const Path: String): String;
|
|
begin
|
|
if (Path <> '') and (Path[1] <> '/') then
|
|
Result := '/' + Path
|
|
else
|
|
Result := Path;
|
|
end;
|
|
|
|
function SureAnsi(str: String): AnsiString;
|
|
begin
|
|
{$IfDef Delphi12} Result := AnsiString(Utf8Encode(str));
|
|
{$Else} Result := str;
|
|
{$EndIf}
|
|
end;
|
|
|
|
function SureUTF8(str: String): String;
|
|
begin
|
|
{$IfDef Delphi12} Result := str;
|
|
{$Else} Result := AnsiToUtf8(str);
|
|
{$EndIf}
|
|
end;
|
|
|
|
function JsonEncode(str: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to Length(str) do
|
|
if Ord(WideString(str[i])[1]) > 127 then
|
|
Result := Result + '\u' + Format('%.4x', [Ord(WideString(str[i])[1])])
|
|
else
|
|
Result := Result + str[i];
|
|
end;
|
|
|
|
// Left = '' => LineStart; Right = '' => LineEnd
|
|
|
|
function CopySubstring(const Source: String; Left, Right: Array of String): String;
|
|
var
|
|
PosLeft, PosRight, i, lx, nLen: Integer;
|
|
|
|
function FindPos(const SubStr: String; Sign: Integer): Integer;
|
|
var
|
|
j: Integer;
|
|
bFound: Boolean;
|
|
begin
|
|
Result := -1;
|
|
bFound := False;
|
|
for j := 1 to Length(SubStr) do
|
|
if SubStr[j] = Source[i + (j - 1)] then
|
|
bFound := True
|
|
else
|
|
begin
|
|
bFound := False;
|
|
break;
|
|
end;
|
|
if bFound then
|
|
Result := i + Length(SubStr) * Sign;
|
|
end;
|
|
|
|
begin
|
|
Result := '';
|
|
PosLeft := -1;
|
|
PosRight := -1;
|
|
nLen := Length(Source);
|
|
for i := 1 to nLen do
|
|
begin
|
|
if PosLeft = -1 then
|
|
for lx := Low(Left) to High(Left) do
|
|
begin
|
|
PosLeft := FindPos(Left[lx], 1);
|
|
if PosLeft <> -1 then Break;
|
|
end
|
|
else if PosRight = -1 then
|
|
for lx := Low(Right) to High(Right) do
|
|
begin
|
|
PosRight := FindPos(Right[lx], -1);
|
|
if PosRight <> -1 then Break;
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
if PosLeft = -1 then Exit;
|
|
if PosRight = -1 then
|
|
PosRight := nLen;
|
|
Result := Copy(Source, PosLeft, PosRight - PosLeft + 1);
|
|
end;
|
|
|
|
procedure ClearLabelsFontStyle(Form: TForm);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with Form do
|
|
for i := 0 to ComponentCount - 1 do
|
|
if Components[i] is TLabel then
|
|
with TLabel(Components[i]) do
|
|
begin
|
|
Font.Style := [];
|
|
Font.Color := clWindowText;
|
|
end;
|
|
end;
|
|
|
|
{ TfrxInternetIOTransport }
|
|
|
|
procedure TfrxInternetIOTransport.AssignFilter(Source: TfrxCustomIOTransport);
|
|
var
|
|
lFilter: TfrxInternetIOTransport;
|
|
begin
|
|
inherited;
|
|
if Source is TfrxInternetIOTransport then
|
|
begin
|
|
lFilter := TfrxInternetIOTransport(Source);
|
|
FDefaultProxyPort := lFilter.FDefaultProxyPort;
|
|
FProxyHost := lFilter.FProxyHost;
|
|
FProxyPort := lFilter.FProxyPort;
|
|
FProxyUserName := lFilter.FProxyUserName;
|
|
FProxyPassword := lFilter.FProxyPassword;
|
|
FUserName := lFilter.FUserName;
|
|
FPassword := lFilter.FPassword;
|
|
FShowProgress := lFilter.FShowProgress
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.ChangeDirUP;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.CloseFilter;
|
|
var
|
|
SendError: String;
|
|
begin
|
|
if not FIsFilterOpened Then Exit;
|
|
try
|
|
if FilterAccess <> faRead then
|
|
SendError := IfStr(FIsFilterOpened, SendFiles);
|
|
finally
|
|
inherited;
|
|
end;
|
|
if (SendError <> '') and (Report <> nil) then
|
|
case Report.EngineOptions.NewSilentMode of
|
|
simSilent:
|
|
Report.Errors.Add(SendError);
|
|
simMessageBoxes:
|
|
frxErrorMsg(SendError);
|
|
simReThrow:
|
|
raise Exception.Create(SendError);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.ConnectionWork(Sender: TObject; AWorkMode: TfrxHTTPWorkMode; AWorkCount: Int64);
|
|
begin
|
|
if FProgress.Terminated then
|
|
begin
|
|
Connection.OnWorkBegin := nil;
|
|
Connection.OnWork := nil;
|
|
Connection.OnWorkEnd := nil;
|
|
Connection.Disconnect;
|
|
end
|
|
else if AWorkMode = hwmWrite then
|
|
FProgress.Position := FWorkBeginPosition + AWorkCount;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.ConnectionWorkBegin(Sender: TObject; AWorkMode: TfrxHTTPWorkMode; AWorkCount: Int64);
|
|
begin
|
|
if AWorkMode = hwmWrite then
|
|
FWorkBeginPosition := FProgress.Position;
|
|
end;
|
|
|
|
constructor TfrxInternetIOTransport.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FUseIniFile := True;
|
|
FShowProgress := True;
|
|
FProgress := nil;
|
|
ShowDialog := True;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.CreateProgress(ProgressCaption: String);
|
|
begin
|
|
if ShowProgress and ShowDialog then
|
|
begin
|
|
FProgress := TfrxProgress.Create(nil);
|
|
FProgress.Execute(SizeOfFiles, ProgressCaption,
|
|
{ Canceled: } True, { Progress: } True);
|
|
Connection.OnWorkBegin := ConnectionWorkBegin;
|
|
Connection.OnWork := ConnectionWork;
|
|
end
|
|
else
|
|
FProgress := nil;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.CreateRemoteDir(DirName: String;
|
|
ChangeDir: Boolean);
|
|
begin
|
|
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.FormShowModal: TModalResult;
|
|
var
|
|
fDialog: TfrxBaseTransportDialog;
|
|
begin
|
|
if not ShowDialog then
|
|
begin
|
|
SilentAuthorize;
|
|
Result := mrOK;
|
|
Exit;
|
|
end;
|
|
fDialog := TfrxBaseTransportDialog(TransportDialogClass.NewInstance);
|
|
fDialog.Create(nil);
|
|
try
|
|
fDialog.InitControlsFromFilter(Self);
|
|
Result := fDialog.ShowModal;
|
|
if Result = mrOK then
|
|
begin
|
|
fDialog.InitFilterFromDialog(Self);
|
|
end;
|
|
finally
|
|
fDialog.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TfrxInternetIOTransport.GetProtocolClass: TfrxCustomDataLinkProtocolClass;
|
|
begin
|
|
Result := TfrxHTTPTransportsDatalinkProtocol;
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.DoBeforeSent: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.DoCreateStream(var aFullFilePath: String; aFileName: String): TStream;
|
|
var
|
|
fName: String;
|
|
i: Integer;
|
|
OldFilterAccess: TfrxFilterAccess;
|
|
begin
|
|
Result := nil;
|
|
fName := aFullFilePath;
|
|
i := PosEx(BasePath, fName, 1);
|
|
if i = 1 then
|
|
fName := Copy(fName, Length(BasePath), Length(fName));
|
|
|
|
// if ExtractFilePath(aFileName) = '' then
|
|
// fName := GetTempFile + ExtractFileExt(aFileName);
|
|
|
|
if (fName = '') and (FilterAccess = faRead) then
|
|
if IsSelectFileName then
|
|
fName := Filename;
|
|
|
|
if (fName <> '') then
|
|
begin
|
|
OldFilterAccess := FilterAccess;
|
|
FilterAccess := faWrite;
|
|
InternalFilter.FilterAccess := faWrite;
|
|
InternalFilter.CreateTempContainer;
|
|
Result := InternalFilter.GetStream(InternalFilter.BasePath + PathDelim +
|
|
fName); // TFileStream.Create(fName, fmCreate);
|
|
FilterAccess := OldFilterAccess;
|
|
end;
|
|
|
|
if FilterAccess = faRead then
|
|
begin
|
|
{ TODO: Move to Filter.Open }
|
|
if aFullFilePath = '' then
|
|
begin
|
|
aFullFilePath := fName;
|
|
aFileName := fName;
|
|
end;
|
|
// DoReadRemoteContent(aFullFilePath, Result);
|
|
if not CreateConnector or (Result = nil) then
|
|
Exit;
|
|
Download(aFullFilePath, Result);
|
|
InternalFilter.FreeStream(Result);
|
|
OldFilterAccess := InternalFilter.FilterAccess;
|
|
InternalFilter.FilterAccess := faRead;
|
|
Result := InternalFilter.GetStream(InternalFilter.BasePath +
|
|
PathDelim + fName);
|
|
InternalFilter.FilterAccess := OldFilterAccess;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.Download(const SourceFileName: String;
|
|
const Source: TStream);
|
|
begin
|
|
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.IsDeleteSupported: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.IsSelectDirectory: Boolean;
|
|
begin
|
|
Result := True;
|
|
if not ShowDialog then Exit;
|
|
with TransportPostDialogClass(idmDir).Create(nil) do
|
|
try
|
|
DialogMode := idmDir;
|
|
if not IsDeleteSupported then
|
|
DisableDelete;
|
|
OnDirChange := DialogDirChange;
|
|
OnDirCreate := DialogDirCreate;
|
|
OnDirDelete := DialogDirDelete;
|
|
OnFileDelete := DialogFileDelete;
|
|
|
|
//GetDirItems(DirItems);
|
|
IOTransport := Self;
|
|
Result := ShowModal = mrOK;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.IsSelectFileName: Boolean;
|
|
var
|
|
fNode: TfrxNode;
|
|
DM: TfrxIOInternetDialogMode;
|
|
begin
|
|
Result := False;
|
|
if not CreateConnector or not DoConnectorConncet then Exit;
|
|
Result := True;
|
|
if not ShowDialog then Exit;
|
|
if FilterAccess = faWrite then
|
|
DM := idmSave
|
|
else
|
|
DM := idmOpen;
|
|
with TransportPostDialogClass(DM).Create(nil) do
|
|
try
|
|
if not IsDeleteSupported then
|
|
DisableDelete;
|
|
OnDirChange := DialogDirChange;
|
|
OnDirCreate := DialogDirCreate;
|
|
OnDirDelete := DialogDirDelete;
|
|
OnFileDelete := DialogFileDelete;
|
|
|
|
//GetDirItems(DirItems);
|
|
IOTransport := Self;
|
|
fNode := GetFileNode;
|
|
|
|
if fNode <> nil then
|
|
DialogFileName := fNode.Name
|
|
else
|
|
DialogFileName := FileName;
|
|
//ExtractFileName(FFiles.Names[0]);
|
|
Result := ShowModal = mrOK;
|
|
if Result then
|
|
if fNode <> nil then
|
|
fNode.Name := DialogFileName
|
|
else
|
|
begin
|
|
FileName := DialogFileName;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.OpenFilter: Boolean;
|
|
begin
|
|
FIsFilterOpened := (FormShowModal = mrOK);
|
|
if (FilterAccess = faRead) and FIsFilterOpened then
|
|
FIsFilterOpened := (SendFiles = '');
|
|
Result := FIsFilterOpened;
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.PropertiesSection: String;
|
|
begin
|
|
Result := FilterSection + '.Properties';
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.ProcessFiles;
|
|
|
|
procedure DoItem(aItem: TfrxNode);
|
|
var
|
|
lItem: tfrxNode;
|
|
i: Integer;
|
|
// sName: String;
|
|
begin
|
|
for i := 0 to aItem.Count - 1 do
|
|
begin
|
|
lItem := aItem.Items[i];
|
|
if Assigned(FProgress) and FProgress.Terminated then Exit;
|
|
if Assigned(lItem.ObjectData) then
|
|
begin
|
|
Upload(TStream(lItem.ObjectData), lItem.Name);
|
|
// FSendedTotal := FSendedTotal + TStream(lItem.ObjectData).Size;
|
|
end
|
|
else
|
|
if aItem.OriginalName = '' then
|
|
begin
|
|
CreateRemoteDir(lItem.Name);
|
|
DoItem(lItem);
|
|
ChangeDirUp;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
DoBeforeSent;
|
|
if (RootNode.Count = 0) and (FilterAccess = faRead) then
|
|
GetStream(FileName)
|
|
else
|
|
DoItem(InternalFilter.RootNode);
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.SendFiles: String;
|
|
var
|
|
sMessage: String;
|
|
begin
|
|
Result := '';
|
|
if not CreateConnector then Exit; // TODO: rise exception later
|
|
try
|
|
try
|
|
if DoConnectorConncet then
|
|
if ((FDirTree.FilesCount = 1) or (FilterAccess = faRead)) and IsSelectFileName or
|
|
(FDirTree.FilesCount > 1) and IsSelectDirectory then
|
|
begin
|
|
if FilterAccess = faWrite then
|
|
begin
|
|
InternalFilter.FilterAccess := faRead;
|
|
InternalFilter.CloseAllStreams;
|
|
InternalFilter.LoadClosedStreams;
|
|
end;
|
|
if FilterAccess = faWrite then
|
|
sMessage := GetStr('IOTransportUploading')
|
|
else
|
|
sMessage := GetStr('IOTransportDownloading');
|
|
CreateProgress(sMessage + ' ' + GetDescription);
|
|
ProcessFiles;
|
|
end
|
|
else
|
|
begin
|
|
Result := 'Closed';// TODO
|
|
FIsFilterOpened := False;
|
|
end;
|
|
except
|
|
on e: Exception do
|
|
Result := IfStr(e.Message = '', 'Empty HTTP Error', e.Message);
|
|
end;
|
|
finally
|
|
FreeAndNil(FProgress);
|
|
DisposeConnector;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.SetName(const NewName: TComponentName);
|
|
var
|
|
OldName: TComponentName;
|
|
begin
|
|
OldName := Name;
|
|
if (OldName <> '') and not FNoRegister and (OldName <> NewName) then
|
|
frxDataProtocols.Unregister(OldName);
|
|
inherited;
|
|
if (NewName <> '') and not FNoRegister and (OldName <> NewName) then
|
|
frxDataProtocols.Register(GetProtocolClass, NewName, Self);
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.SilentAuthorize;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TfrxInternetIOTransport.SizeOfFiles: Int64;
|
|
function DoSizeOfFiles(aItem: TfrxNode): Int64;
|
|
var
|
|
lItem: tfrxNode;
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to aItem.Count - 1 do
|
|
begin
|
|
lItem := aItem.Items[i];
|
|
if lItem.OriginalName = '' then
|
|
Result := Result + DoSizeOfFiles(lItem)
|
|
else
|
|
if Assigned(lItem.ObjectData) then
|
|
Result := Result + TStream(lItem.ObjectData).Size
|
|
else
|
|
Result := Result + frxFileUtils.GetFileSize(lItem.OriginalName);
|
|
end;
|
|
end;
|
|
begin
|
|
Result := DoSizeOfFiles(InternalFilter.RootNode);
|
|
end;
|
|
|
|
procedure TfrxInternetIOTransport.TestToken;
|
|
begin
|
|
|
|
end;
|
|
|
|
class function TfrxInternetIOTransport.TransportDialogClass: TfrxBaseTransportDialogClass;
|
|
begin
|
|
Result := TfrxBaseTransportDialog;
|
|
end;
|
|
|
|
class function TfrxInternetIOTransport.TransportPostDialogClass(DM: TfrxIOInternetDialogMode): TfrxBaseFormClass;
|
|
begin
|
|
Result := TfrxIOTransportDialogIntForm;
|
|
end;
|
|
|
|
{ TfrxHTTPIOTransport }
|
|
|
|
procedure TfrxHTTPIOTransport.AddToDirItems(DirItems: TStrings; IsFolder,
|
|
IsFile: Boolean; Name: String; Id: String = '');
|
|
var
|
|
FullName: String;
|
|
begin
|
|
if IsFolder then
|
|
FullName := TfrxIOTransportDialogIntForm.AsDirectory(Name)
|
|
else if IsFile then
|
|
FullName := TfrxIOTransportDialogIntForm.AsFile(Name);
|
|
|
|
if IsFolder or IsFile then
|
|
if Id = '' then
|
|
DirItems.Add(FullName)
|
|
else
|
|
DirItems.AddObject(FullName, TIdObject.Create(Id));
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.AssignFilter(Source: TfrxCustomIOTransport);
|
|
var
|
|
lFilter: TfrxHTTPIOTransport;
|
|
begin
|
|
inherited;
|
|
if Source is TfrxHTTPIOTransport then
|
|
begin
|
|
lFilter := TfrxHTTPIOTransport(Source);
|
|
FClientID := lFilter.FClientID;
|
|
FUseProxyServer := lFilter.FUseProxyServer;
|
|
FAccessToken := lFilter.FAccessToken;
|
|
FRemoteDir := lFilter.FRemoteDir;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.AssignSharedProperties(
|
|
Source: TfrxCustomIOTransport);
|
|
var
|
|
tHTTP: TfrxHTTPIOTransport;
|
|
Index: Integer;
|
|
begin
|
|
inherited;
|
|
tHTTP := (Source as TfrxHTTPIOTransport);
|
|
if not Assigned(tHTTP) then Exit;
|
|
FClientID := tHTTP.ClientID;
|
|
FClientSecret := tHTTP.ClientSecret;
|
|
|
|
if not FNoRegister then
|
|
begin
|
|
Index := FAccessTokens.IndexOf(tHTTP.ClientID);
|
|
if Index = -1 then
|
|
FAccessTokens.AddObject(tHTTP.ClientID, TIdObject.Create(tHTTP.FAccessToken))
|
|
else
|
|
TIdObject(FAccessTokens.Objects[Index]).FId := tHTTP.FAccessToken;
|
|
end;
|
|
|
|
Index := tHTTP.FAccessTokens.IndexOf(ClientID);
|
|
if Index > -1 then
|
|
FAccessToken := TIdObject(tHTTP.FAccessTokens.Objects[Index]).Id;
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.ChangeDirUP;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := Length(FRemoteDir) downto 1 do
|
|
if FRemoteDir[i] = '/' then
|
|
begin
|
|
FRemoteDir := Copy(FRemoteDir, 1, Length(FRemoteDir) - (Length(FRemoteDir) - i));
|
|
if FRemoteDir = '/' then FRemoteDir := '';
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TfrxHTTPIOTransport.Connection: TfrxBaseTransportConnection;
|
|
begin
|
|
Connection := FHTTP;
|
|
end;
|
|
|
|
constructor TfrxHTTPIOTransport.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FConnected := False;
|
|
FClientID := '';
|
|
FDefaultProxyPort := 80;
|
|
FProxyPort := FDefaultProxyPort;
|
|
FUSeProxyServer := False;
|
|
FAccessTokens := TStringList.Create;
|
|
ListenerPort := 9898;
|
|
FEncryptionKey := 'dE][}3f!=ve:dQefsxTpIq!3lC';
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.CreateConnector: Boolean;
|
|
begin
|
|
Result := FHTTP <> nil;
|
|
if Result then Exit;
|
|
FHTTP := TfrxBaseTransportConnection(GetConnectorInstance.NewInstance);
|
|
FHTTP.Create(nil);
|
|
try
|
|
if BlockedType then
|
|
FHTTP.SocketType := fstBlocking;
|
|
FHTTP.SetDefaultParametersWithToken(FAccessToken);
|
|
finally
|
|
Result := FHTTP <> nil;
|
|
end;
|
|
end;
|
|
|
|
destructor TfrxHTTPIOTransport.Destroy;
|
|
begin
|
|
ClearWithObjects(FAccessTokens);
|
|
FreeAndNil(FAccessTokens);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.DisposeConnector;
|
|
begin
|
|
if Assigned(FHTTP) then
|
|
FreeAndNil(FHTTP);
|
|
FConnected := False;
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.DoConnectorConncet: Boolean;
|
|
begin
|
|
if not FConnected then
|
|
begin
|
|
SetProxy;
|
|
TestRemoteDir;
|
|
FConnected := True;
|
|
end;
|
|
Result := FConnected;
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.DownloadToStream(const SourceFileName: String;
|
|
const Source: TStream);
|
|
begin
|
|
if not CreateConnector then Exit;
|
|
try
|
|
Download(SourceFileName, Source);
|
|
finally
|
|
DisposeConnector;
|
|
end;
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.GetRedirectURI: String;
|
|
begin
|
|
Result := 'http://localhost:' + IntToStr(FListenerPort);
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.GetRemoteDir: String;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.IsFinalURLTest(const URL: String;
|
|
var Errors: String): Boolean;
|
|
var
|
|
AuthorizationCode: String;
|
|
begin
|
|
if FAccessToken = '' then
|
|
begin
|
|
AuthorizationCode := CopySubstring(URL, ['?code=', '&code='], [' ', '&', '?', #13, #10]);
|
|
if AuthorizationCode <> '' then
|
|
FAccessToken := GetAccessToken(AuthorizationCode, Errors)
|
|
else
|
|
Errors := CopySubstring(URL, ['?error='], [' ', '&', '?']);
|
|
end;
|
|
Result := FAccessToken + Errors <> '';
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.LoadTokenFromIni: Boolean;
|
|
var
|
|
ini: TCustomIniFile;
|
|
Data: AnsiString;
|
|
begin
|
|
Result := False;
|
|
if not UseIniFile or (FAccessToken <> '') then Exit;
|
|
if Assigned(Report) then
|
|
ini := Report.GetIniFile
|
|
else
|
|
ini := TRegistryIniFile.Create('\Software\Fast Reports');
|
|
try
|
|
Data := Base64Decode(AnsiString(Ini.ReadString(PropertiesSection, frxTransportTokenName, '')));
|
|
if Data = '' then Exit;
|
|
try
|
|
Data := TrimRight(DeCryptString(Data, FEncryptionKey));
|
|
except
|
|
Data := '';
|
|
end;
|
|
finally
|
|
FAccessToken := String(Data);
|
|
TestToken;
|
|
Result := FAccessToken <> '';
|
|
ini.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxHTTPIOTransport.OpenFilter: Boolean;
|
|
var
|
|
SaveShowDialog: Boolean;
|
|
begin
|
|
SaveShowDialog := ShowDialog;
|
|
if LoadTokenFromIni then
|
|
ShowDialog := False;;
|
|
try
|
|
Result := inherited OpenFilter;
|
|
finally
|
|
ShowDialog := SaveShowDialog;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.SetProxy;
|
|
begin
|
|
if UseProxyServer then
|
|
begin
|
|
FHTTP.ProxyHost := ProxyHost;
|
|
FHTTP.ProxyPort := ProxyPort;
|
|
FHTTP.ProxyLogin := ProxyUserName;
|
|
FHTTP.ProxyPassword := ProxyPassword;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.SetRemoteDir(const Value: String);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.TestRemoteDir;
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TfrxHTTPIOTransport.Upload(const Source: TStream;
|
|
DestFileName: String);
|
|
begin
|
|
|
|
end;
|
|
|
|
{ TIdObject }
|
|
|
|
constructor TIdObject.Create(AId: String);
|
|
begin
|
|
FId := AId;
|
|
end;
|
|
|
|
{ TDirStack }
|
|
|
|
constructor TDirStack.Create(st: String);
|
|
begin
|
|
StringList := TStringList.Create;
|
|
Push(st);
|
|
end;
|
|
|
|
destructor TDirStack.Destroy;
|
|
begin
|
|
StringList.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDirStack.Pop: String;
|
|
begin
|
|
Result := Top;
|
|
StringList.Delete(StringList.Count - 1);
|
|
end;
|
|
|
|
procedure TDirStack.Push(st: String);
|
|
begin
|
|
StringList.Add(st);
|
|
end;
|
|
|
|
function TDirStack.Top: String;
|
|
begin
|
|
Result := StringList[StringList.Count - 1];
|
|
end;
|
|
|
|
function TDirStack.Full: String;
|
|
begin
|
|
Result := StringList[0] + FullWOFirst;
|
|
end;
|
|
|
|
function TDirStack.FullWOFirst: String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to StringList.Count - 1 do
|
|
Result := Result + StringList[i] + '/';
|
|
end;
|
|
|
|
{ TfrxBaseTransportDialog }
|
|
|
|
function TfrxBaseTransportDialog.Decode64(Text: String): String;
|
|
begin
|
|
Result := String(UTF8Decode(Base64Decode(AnsiString(Text))));
|
|
end;
|
|
|
|
destructor TfrxBaseTransportDialog.Destroy;
|
|
begin
|
|
if Assigned(FIni) then
|
|
FreeAndNil(FIni);
|
|
inherited;
|
|
end;
|
|
|
|
function TfrxBaseTransportDialog.Encode64(Text: String): String;
|
|
begin
|
|
Result := String(Base64Encode(UTF8Encode(Text)));
|
|
end;
|
|
|
|
function TfrxBaseTransportDialog.GetIniFile(TransportFilter: TfrxInternetIOTransport): TCustomIniFile;
|
|
begin
|
|
Result := FIni;
|
|
if Assigned(FIni) then Exit;
|
|
if not TransportFilter.UseIniFile then
|
|
Result := nil
|
|
else if Assigned(TransportFilter.Report) then
|
|
Result := TransportFilter.Report.GetIniFile
|
|
else
|
|
Result := TRegistryIniFile.Create('\Software\Fast Reports');
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniLoadCheckBox(CheckBox: TCheckBox);
|
|
begin
|
|
CheckBox.Checked := FIni.ReadBool(FFilter.PropertiesSection, CheckBox.Name, False);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniLoadComboBox(ComboBox: TComboBox);
|
|
begin
|
|
ComboBox.Text := FIni.ReadString(FFilter.PropertiesSection, ComboBox.Name, '');
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniLoadComboBoxWithItems(ComboBox: TComboBox);
|
|
begin
|
|
IniLoadComboBox(ComboBox);
|
|
FIni.ReadSection(FFilter.FilterSection + '.' + ComboBox.Name, ComboBox.Items);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniLoadEdit(Edit: TEdit);
|
|
begin
|
|
Edit.Text := Decode64(FIni.ReadString(FFilter.PropertiesSection, Edit.Name, ''));
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniSaveCheckBox(CheckBox: TCheckBox);
|
|
begin
|
|
FIni.WriteBool(FFilter.PropertiesSection, CheckBox.Name, CheckBox.Checked);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniSaveComboBox(ComboBox: TComboBox);
|
|
begin
|
|
FIni.WriteString(FFilter.PropertiesSection, ComboBox.Name, ComboBox.Text);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniSaveComboBoxItem(ComboBox: TComboBox);
|
|
begin
|
|
FIni.WriteString(FFilter.FilterSection + '.' + ComboBox.Name, ComboBox.Text, '');
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.IniSaveEdit(Edit: TEdit);
|
|
begin
|
|
FIni.WriteString(FFilter.PropertiesSection, Edit.Name, Encode64(Edit.Text));
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.InitControlsFromFilter(
|
|
TransportFilter: TfrxInternetIOTransport);
|
|
begin
|
|
FFilter := TransportFilter;
|
|
FIni := GetIniFile(TransportFilter);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.InitDialog;
|
|
|
|
function GetStr(const Id: string): string;
|
|
begin
|
|
Result := frxResources.Get(Id)
|
|
end;
|
|
|
|
procedure AssignTexts(Root: TControl);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with Root do
|
|
begin
|
|
if Tag > 0 then
|
|
SetTextBuf(PChar(GetStr(IntToStr(Tag))));
|
|
|
|
if Root is TWinControl then
|
|
with Root as TWinControl do
|
|
for i := 0 to ControlCount - 1 do
|
|
if Controls[i] is TControl then
|
|
AssignTexts(Controls[i] as TControl);
|
|
end;
|
|
end;
|
|
begin
|
|
AssignTexts(Self);
|
|
if UseRightToLeftAlignment then
|
|
FlipChildren(True);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.InitFilterFromDialog(
|
|
TransportFilter: TfrxInternetIOTransport);
|
|
begin
|
|
FFilter := nil;
|
|
if Assigned(FIni) then
|
|
FreeAndNil(FIni);
|
|
end;
|
|
|
|
procedure TfrxBaseTransportDialog.UpdateResouces;
|
|
begin
|
|
inherited;
|
|
// TODO
|
|
end;
|
|
|
|
{ TfrxBaseOAuthTransportDialog }
|
|
|
|
function TfrxBaseOAuthTransportDialog.GetTokenDialog: Boolean;
|
|
var
|
|
BrowserForm: TBrowserForm;
|
|
LFilter: TfrxHTTPIOTransport;
|
|
begin
|
|
Result := False;
|
|
if not (FFilter is TfrxHTTPIOTransport) then Exit;
|
|
LFilter := TfrxHTTPIOTransport(FFilter);
|
|
Result := (LFilter.AccessToken <> '');
|
|
if Result then Exit;
|
|
BrowserForm := TBrowserForm.Create(nil);
|
|
try
|
|
BrowserForm.SetListenerPort(LFilter.ListenerPort);
|
|
LFilter.ClientID := GetClientID;
|
|
LFilter.ClientSecret := GetClientSecret;
|
|
BrowserForm.URL := LFilter.GetOAuthURI;
|
|
BrowserForm.OnTestURL := LFilter.IsFinalURLTest;
|
|
Result := (BrowserForm.ShowModal = mrOK) and (LFilter.AccessToken <> '');
|
|
if not Result then
|
|
FErrorMessage := FErrorMessage + BrowserForm.NavigateHistory.Text;
|
|
finally
|
|
BrowserForm.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxBaseOAuthTransportDialog.IniLoadStringCrypt(const SectionName: String): String;
|
|
var
|
|
Data: AnsiString;
|
|
begin
|
|
Result := '';
|
|
try
|
|
Data := Base64Decode(AnsiString(FIni.ReadString(FFilter.PropertiesSection, SectionName, '')));
|
|
if Data = '' then Exit;
|
|
Data := TrimRight(DeCryptString(Data, TfrxHTTPIOTransport(FFilter).EncryptionKey))
|
|
except
|
|
Data := '';
|
|
end;
|
|
Result := String(Data);
|
|
end;
|
|
|
|
procedure TfrxBaseOAuthTransportDialog.IniSaveStringCrypt(const SectionName, Data: String);
|
|
var
|
|
LData: AnsiString;
|
|
begin
|
|
try
|
|
LData := EnCryptString(AnsiString(Data), TfrxHTTPIOTransport(FFilter).EncryptionKey);
|
|
LData := Base64Encode(LData)
|
|
except
|
|
LData := '';
|
|
end;
|
|
// if LData <> '' then
|
|
FIni.WriteString(FFilter.PropertiesSection, SectionName, String(LData));
|
|
end;
|
|
|
|
procedure TfrxBaseOAuthTransportDialog.InitControlsFromFilter(
|
|
TransportFilter: TfrxInternetIOTransport);
|
|
begin
|
|
inherited;
|
|
if FFilter is TfrxHTTPIOTransport then
|
|
FRedirectURI := TfrxHTTPIOTransport(FFilter).GetRedirectURI;
|
|
end;
|
|
|
|
end.
|