From c9887283a220f123d28f7939e334c790c3bf0fe7 Mon Sep 17 00:00:00 2001 From: Pozitronik Date: Tue, 12 Dec 2023 17:02:35 +0400 Subject: [PATCH 1/5] Move constant definitions to CMRConstants.pas --- helpers/PluginHelper.pas | 12 ------------ types/CMRConstants.pas | 11 +++++++++++ 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/helpers/PluginHelper.pas b/helpers/PluginHelper.pas index 1ad194d..c4687ae 100644 --- a/helpers/PluginHelper.pas +++ b/helpers/PluginHelper.pas @@ -7,18 +7,6 @@ interface CMRConstants, SysUtils; -const - //FsFindFirst* success return codes (INVALID_HANDLE_VALUE returns on error) - FIND_NO_MORE_FILES = 0; - FIND_OK = 1; - FIND_ROOT_DIRECTORY = 2; - FIND_SHARED_LINKS = 3; //.shared folder - - TYPE_AUTO = -1; - TYPE_BYTES = 0; - TYPE_KYLOBYTES = 1; - TYPE_MEGABYTES = 2; - function FormatSize(size: Int64; SizeType: integer = TYPE_AUTO): WideString; //Форматируем размер в удобочитаемый вид function ShardTypeFromStreamingFormat(StreamingFormat: integer): string; diff --git a/types/CMRConstants.pas b/types/CMRConstants.pas index a54d35c..ddcdfc0 100644 --- a/types/CMRConstants.pas +++ b/types/CMRConstants.pas @@ -211,6 +211,17 @@ interface LOG_LEVEL_ERROR = 16; //error details LOG_LEVEL_DEBUG = 32; //also same internal debugging info + //FsFindFirst* success return codes (INVALID_HANDLE_VALUE returns on error) + FIND_NO_MORE_FILES = 0; + FIND_OK = 1; + FIND_ROOT_DIRECTORY = 2; + FIND_SHARED_LINKS = 3; //.shared folder + + TYPE_AUTO = -1; + TYPE_BYTES = 0; + TYPE_KYLOBYTES = 1; + TYPE_MEGABYTES = 2; + implementation end. From 5d650603555e8d1d01040a9f6984a22e4c8e60fe Mon Sep 17 00:00:00 2001 From: Pozitronik Date: Tue, 12 Dec 2023 17:03:15 +0400 Subject: [PATCH 2/5] Introduce the class-like WFX Interface implementation --- models/wfx/WFXInterface.pas | 42 +++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 models/wfx/WFXInterface.pas diff --git a/models/wfx/WFXInterface.pas b/models/wfx/WFXInterface.pas new file mode 100644 index 0000000..ac30b76 --- /dev/null +++ b/models/wfx/WFXInterface.pas @@ -0,0 +1,42 @@ +unit WFXInterface; + +interface + +uses + Windows, + PLUGIN_TYPES; + +type + {This class implements a basic abstract filesystem plugin} + {TODO: do not use pointers} + IWFXInterface = interface + {Initialization methods} + function FsInit(PluginNr: Integer; pProgressProc: TProgressProcW; pLogProc: TLogProcW; pRequestProc: TRequestProcW): Integer; + procedure FsGetDefRootName(DefRootName: PAnsiChar; MaxLen: Integer); + procedure FsSetCryptCallback(PCryptProc: TCryptProcW; CryptoNr: Integer; Flags: Integer); + function FsGetBackgroundFlags: Integer; + {Mandatory filesystem methods} + function FsFindFirst(Path: WideString; var FindData: tWIN32FINDDATAW): THandle; + function FsFindNext(Hdl: THandle; var FindData: tWIN32FINDDATAW): Boolean; + function FsFindClose(Hdl: THandle): Integer; + {Optional filesystem methods} + procedure FsStatusInfo(RemoteDir: WideString; InfoStartEnd, InfoOperation: Integer); + function FsExecuteFile(MainWin: THandle; RemoteName, Verb: PWideChar): Integer; + function FsGetFile(RemoteName, LocalName: WideString; CopyFlags: Integer; RemoteInfo: pRemoteInfo): Integer; + function FsPutFile(LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; + function FsDeleteFile(RemoteName: WideString): Boolean; + function FsMkDir(Path: WideString): Boolean; + function FsRemoveDir(RemoteName: WideString): Boolean; + function FsRenMovFile(OldName: PWideChar; NewName: PWideChar; Move: Boolean; OverWrite: Boolean; ri: pRemoteInfo): Integer; + + function FsDisconnect(DisconnectRoot: PWideChar): Boolean; + + {Content methods} + function FsContentGetSupportedField(FieldIndex: Integer; FieldName: PAnsiChar; Units: PAnsiChar; MaxLen: Integer): Integer; + function FsContentGetValue(FileName: PWideChar; FieldIndex: Integer; UnitIndex: Integer; FieldValue: Pointer; MaxLen: Integer; Flags: Integer): Integer; + function FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags: Integer; var TheIcon: hIcon): Integer; + end; + +implementation + +end. From 07733f8b5247d60ce314666c938633e8ff7417bb Mon Sep 17 00:00:00 2001 From: Pozitronik Date: Tue, 12 Dec 2023 17:03:39 +0400 Subject: [PATCH 3/5] Refactor the MailRuCloud.dpr to introduce and use a class-like WFX interface. This implementation enhances code readability by abstracting complex code operations into methods. It also encourages code modularity, making it easier for future extension and maintenance. We encapsulated all operations into the MailRuCloudWFX class for improved organization and ease of use. --- MailRuCloud.dpr | 1785 +------------------------------ MailRuCloud.dproj | 2 + models/wfx/MailRuCloudWFX.pas | 1889 +++++++++++++++++++++++++++++++++ types/ANSIFunctions.pas | 98 -- 4 files changed, 1922 insertions(+), 1852 deletions(-) create mode 100644 models/wfx/MailRuCloudWFX.pas diff --git a/MailRuCloud.dpr b/MailRuCloud.dpr index cca3513..2287061 100644 --- a/MailRuCloud.dpr +++ b/MailRuCloud.dpr @@ -82,7 +82,9 @@ uses Vcl.controls, WSList in 'models\WSList.pas', Windows, - WindowsHelper in 'helpers\WindowsHelper.pas'; + WindowsHelper in 'helpers\WindowsHelper.pas', + MailRuCloudWFX in 'models\wfx\MailRuCloudWFX.pas', + WFXInterface in 'models\wfx\WFXInterface.pas'; {$IFDEF WIN64} {$E wfx64} @@ -92,161 +94,12 @@ uses {$ENDIF} {$R *.res} -const -{$IFDEF WIN64} - PlatformDllPath = 'x64'; -{$ENDIF} -{$IFDEF WIN32} - PlatformDllPath = 'x32'; -{$ENDIF} - -var - - GlobalPath, PluginPath: WideString; - FileCounter: integer = 0; - CurrentlyMovedDir: TRealPath; - ThreadSkipListDelete: TDictionary; //Массив id потоков, для которых операции получения листинга должны быть пропущены (при удалении) - ThreadSkipListRenMov: TDictionary; //Массив id потоков, для которых операции получения листинга должны быть пропущены (при копировании/перемещении) - ThreadCanAbortRenMov: TDictionary; //Массив id потоков, для которых в операциях получения листинга должен быть выведен дополнительный диалог прогресса с возможностью отмены операции (fix issue #113) - ThreadListingAborted: TDictionary; //Массив id потоков, для которых в операциях получения листинга была нажата отмена - - ThreadRetryCountDownload: TDictionary; //массив [id потока => количество попыток] для подсчёта количества повторов скачивания файла - ThreadRetryCountUpload: TDictionary; //массив [id потока => количество попыток] для подсчёта количества повторов закачивания файла - ThreadRetryCountRenMov: TDictionary; //массив [id потока => количество попыток] для подсчёта количества повторов межсерверных операций с файлом - ThreadBackgroundJobs: TDictionary; //массив [account root => количество потоков] для хранения количества текущих фоновых задач (предохраняемся от удаления объектов, которые могут быть использованы потоками) - ThreadBackgroundThreads: TDictionary; //массив [id потока => статус операции] для хранения текущих фоновых потоков (предохраняемся от завершения работы плагина при закрытии TC) - ThreadFsStatusInfo: TDictionary; //массив [id потока => текущая операция] для хранения контекста выполняемой операции (применяем для отлова перемещений каталогов) - ThreadFsRemoveDirSkippedPath: TDictionary; //массив [id потока => путь] для хранения путей, пропускаемых при перемещении (см. issue #168). - - PluginNum: integer; - - SettingsManager: TPluginSettingsManager; - AccountSettings: TAccountsManager; - Accounts: TWSList; - - CurrentListing: TCMRDirItemList; - CurrentIncomingInvitesListing: TCMRIncomingInviteList; - ConnectionManager: TConnectionManager; - CurrentDescriptions: TDescription; - PasswordManager: TTCPasswordManager; - TCLogger: TTCLogger; - TCProgress: TTCProgress; - TCRequest: TTCRequest; - - {Пытаемся найти объект в облаке по его пути, сначала в текущем списке, если нет - то ищем в облаке} -function FindListingItemByPath(CurrentListing: TCMRDirItemList; path: TRealPath; UpdateListing: Boolean = true): TCMRDirItem; -var - getResult: integer; - CurrentCloud: TCloudMailRu; -begin - CurrentCloud := ConnectionManager.Get(path.account, getResult); - if not Assigned(CurrentCloud) then - exit; - - if path.HasHomePath and not CurrentCloud.public_account then - Result := CurrentListing.FindByHomePath(path.path) //сначала попробуем найти поле в имеющемся списке - else - Result := CurrentListing.FindByName(ExtractUniversalFileName(path.path)); - - if Result.isNone and UpdateListing then //если там его нет (нажали пробел на папке, например), то запросим в облаке напрямую, в зависимости от того, внутри чего мы находимся - begin - - if path.trashDir then //корзина - обновим CurrentListing, поищем в нём - begin - if CurrentCloud.getTrashbinListing(CurrentListing) then - exit(CurrentListing.FindByName(path.path)); - end; - if path.sharedDir then //ссылки - обновим список - begin - if CurrentCloud.getSharedLinksListing(CurrentListing) then - exit(CurrentListing.FindByName(path.path)); - end; - if path.invitesDir then - begin - //FindIncomingInviteItemByPath in that case! - end; - if CurrentCloud.statusFile(path.path, Result) then //Обычный каталог - begin - if (Result.home = EmptyWideStr) and not CurrentCloud.public_account then - TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_WHERE_IS_THE_FILE, [path.path]); {Такого быть не может, но...} - end; - end; //Не рапортуем, это будет уровнем выше -end; - -function FindIncomingInviteItemByPath(InviteListing: TCMRIncomingInviteList; path: TRealPath): TCMRIncomingInvite; var - getResult: integer; -begin - Result := InviteListing.FindByName(path.path); - {item not found in current global listing, so refresh it} - if Result.isNone then - if ConnectionManager.Get(path.account, getResult).getIncomingLinksListing(CurrentIncomingInvitesListing) then - exit(CurrentIncomingInvitesListing.FindByName(path.path)); -end; - -function DeleteLocalFile(LocalName: WideString): integer; -var - UNCLocalName: WideString; - DeleteFailOnUploadMode, DeleteFailOnUploadModeAsked: integer; -begin - Result := FS_FILE_OK; - DeleteFailOnUploadModeAsked := IDRETRY; - UNCLocalName := GetUNCFilePath(LocalName); - - while (not DeleteFileW(PWideChar(UNCLocalName))) and (DeleteFailOnUploadModeAsked = IDRETRY) do - begin - DeleteFailOnUploadMode := SettingsManager.Settings.DeleteFailOnUploadMode; - if DeleteFailOnUploadMode = DeleteFailOnUploadAsk then - begin - DeleteFailOnUploadModeAsked := MsgBox(ERR_DELETE_FILE_ASK, [LocalName], ERR_DELETE_FILE, MB_ABORTRETRYIGNORE + MB_ICONQUESTION); - case DeleteFailOnUploadModeAsked of - IDRETRY: - continue; - IDABORT: - DeleteFailOnUploadMode := DeleteFailOnUploadAbort; - IDIGNORE: - DeleteFailOnUploadMode := DeleteFailOnUploadIgnore; - end; - end; - - case DeleteFailOnUploadMode of - DeleteFailOnUploadAbort: - begin - TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_ABORT, [LocalName]); - exit(FS_FILE_NOTSUPPORTED); - end; - DeleteFailOnUploadDeleteIgnore, DeleteFailOnUploadDeleteAbort: - begin - //check if file just have RO attr, then remove it. If user has lack of rights, then ignore or abort - if ((FileGetAttr(UNCLocalName) or faReadOnly) <> 0) and ((FileSetAttr(UNCLocalName, not faReadOnly) = 0) and (DeleteFileW(PWideChar(UNCLocalName)))) then - begin - TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_DELETE, [LocalName]); - exit(FS_FILE_OK); - end else begin - if SettingsManager.Settings.DeleteFailOnUploadMode = DeleteFailOnUploadDeleteIgnore then - begin - TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_IGNORE, [LocalName]); - exit(FS_FILE_OK); - end else begin - TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_ABORT, [LocalName]); - exit(FS_FILE_NOTSUPPORTED); - end; - end; - end; - else - begin - TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_IGNORE, [LocalName]); - end; - end; - end; -end; + MailRuCloudWFX: TMailRuCloudWFX; function FsGetBackgroundFlags: integer; stdcall; begin - if SettingsManager.Settings.DisableMultiThreading then - Result := 0 - else - Result := BG_DOWNLOAD + BG_UPLOAD; //+ BG_ASK_USER; + Exit(MailRuCloudWFX.FsGetBackgroundFlags); end; function FsInit(PluginNr: integer; pProgressProc: TProgressProc; pLogProc: TLogProc; pRequestProc: TRequestProc): integer; stdcall; @@ -258,1686 +111,110 @@ end; function FsInitW(PluginNr: integer; pProgressProc: TProgressProcW; pLogProc: TLogProcW; pRequestProc: TRequestProcW): integer; stdcall; //Вход в плагин. begin - PluginNum := PluginNr; - Result := 0; - TCLogger := TTCLogger.Create(pLogProc, PluginNr, SettingsManager.Settings.LogLevel); - TCProgress := TTCProgress.Create(pProgressProc, PluginNr); - TCRequest := TTCRequest.Create(pRequestProc, PluginNr); - CurrentDescriptions := TDescription.Create(GetTmpFileName('ion'), GetTCCommentPreferredFormat); + Result := MailRuCloudWFX.FsInit(PluginNr, pProgressProc, pLogProc, pRequestProc); end; procedure FsStatusInfoW(RemoteDir: PWideChar; InfoStartEnd, InfoOperation: integer); stdcall; //Начало и конец операций FS -var - RealPath: TRealPath; - getResult: integer; - BackgroundJobsCount: integer; begin - RealPath.FromPath(RemoteDir, ID_True); // RemoteDir always a directory - if (InfoStartEnd = FS_STATUS_START) then - begin - ThreadFsStatusInfo.AddOrSetValue(GetCurrentThreadID(), InfoOperation); - case InfoOperation of - FS_STATUS_OP_LIST: - begin - if (SettingsManager.Settings.DescriptionEnabled) and RealPath.IsInAccount() then - begin - if ConnectionManager.Get(RealPath.account, getResult).getDescriptionFile(IncludeTrailingBackslash(RealPath.path) + SettingsManager.Settings.DescriptionFileName, CurrentDescriptions.ionFilename) then - begin - CurrentDescriptions.Read; - end else begin - CurrentDescriptions.Clear; - end; - end; - end; - FS_STATUS_OP_GET_SINGLE: - begin - ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); - end; - FS_STATUS_OP_GET_MULTI: - begin - ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); - end; - FS_STATUS_OP_PUT_SINGLE: - begin - ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); - end; - FS_STATUS_OP_PUT_MULTI: - begin - ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); - end; - FS_STATUS_OP_RENMOV_SINGLE: - begin - end; - FS_STATUS_OP_RENMOV_MULTI: - begin - if ConnectionManager.Get(RealPath.account, getResult).public_account then - begin - TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_COPY_SUPPORT); - ThreadSkipListRenMov.AddOrSetValue(GetCurrentThreadID, true); - end; - ThreadRetryCountRenMov.AddOrSetValue(GetCurrentThreadID(), 0); - ThreadCanAbortRenMov.AddOrSetValue(GetCurrentThreadID, true); - ThreadFsRemoveDirSkippedPath.AddOrSetValue(GetCurrentThreadID, TStringList.Create()); - end; - FS_STATUS_OP_DELETE: - begin - //ThreadSkipListDelete.Add(GetCurrentThreadID()); - ThreadSkipListDelete.AddOrSetValue(GetCurrentThreadID, true); - end; - FS_STATUS_OP_ATTRIB: - begin - end; - FS_STATUS_OP_MKDIR: - begin - end; - FS_STATUS_OP_EXEC: - begin - end; - FS_STATUS_OP_CALCSIZE: - begin - end; - FS_STATUS_OP_SEARCH: - begin - end; - FS_STATUS_OP_SEARCH_TEXT: - begin - end; - FS_STATUS_OP_SYNC_SEARCH: - begin - end; - FS_STATUS_OP_SYNC_GET: - begin - end; - FS_STATUS_OP_SYNC_PUT: - begin - end; - FS_STATUS_OP_SYNC_DELETE: - begin - end; - FS_STATUS_OP_GET_MULTI_THREAD: - begin - ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); - if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then - BackgroundJobsCount := 0; - ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount + 1); - ThreadBackgroundThreads.AddOrSetValue(GetCurrentThreadID(), FS_STATUS_OP_GET_MULTI_THREAD); - end; - FS_STATUS_OP_PUT_MULTI_THREAD: - begin - ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); - if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then - BackgroundJobsCount := 0; - ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount + 1); - ThreadBackgroundThreads.AddOrSetValue(GetCurrentThreadID(), FS_STATUS_OP_PUT_MULTI_THREAD); - end; - end; - exit; - end; - if (InfoStartEnd = FS_STATUS_END) then - begin - ThreadFsStatusInfo.Remove(GetCurrentThreadID); - case InfoOperation of - FS_STATUS_OP_LIST: - begin - end; - FS_STATUS_OP_GET_SINGLE: - begin - end; - FS_STATUS_OP_GET_MULTI: - begin - end; - FS_STATUS_OP_PUT_SINGLE: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_PUT_MULTI: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_RENMOV_SINGLE: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_RENMOV_MULTI: - begin - ThreadSkipListRenMov.AddOrSetValue(GetCurrentThreadID, false); - ThreadCanAbortRenMov.AddOrSetValue(GetCurrentThreadID, false); - - ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Free; - ThreadFsRemoveDirSkippedPath.AddOrSetValue(GetCurrentThreadID, nil); - - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_DELETE: - begin - ThreadSkipListDelete.AddOrSetValue(GetCurrentThreadID(), false); - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_ATTRIB: - begin - end; - FS_STATUS_OP_MKDIR: - begin - end; - FS_STATUS_OP_EXEC: - begin - end; - FS_STATUS_OP_CALCSIZE: - begin - end; - FS_STATUS_OP_SEARCH: - begin - end; - FS_STATUS_OP_SEARCH_TEXT: - begin - end; - FS_STATUS_OP_SYNC_SEARCH: - begin - end; - FS_STATUS_OP_SYNC_GET: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_SYNC_PUT: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_SYNC_DELETE: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - end; - FS_STATUS_OP_GET_MULTI_THREAD: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then - BackgroundJobsCount := 0; - ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount - 1); - ThreadBackgroundThreads.Remove(GetCurrentThreadID()); - - end; - FS_STATUS_OP_PUT_MULTI_THREAD: - begin - if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then - ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; - if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then - BackgroundJobsCount := 0; - ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount - 1); - ThreadBackgroundThreads.Remove(GetCurrentThreadID()); - end; - end; - exit; - end; + MailRuCloudWFX.FsStatusInfo(RemoteDir, InfoStartEnd, InfoOperation); end; function FsFindFirstW(path: PWideChar; var FindData: tWIN32FINDDATAW): THandle; stdcall; -var //Получение первого файла в папке. Result тоталом не используется (можно использовать для работы плагина). - RealPath: TRealPath; - getResult: integer; - SkipListDelete, SkipListRenMov, CanAbortRenMov, RenMovAborted: Boolean; - CurrentItem: TCMRDirItem; - CurrentCloud: TCloudMailRu; begin - ThreadSkipListDelete.TryGetValue(GetCurrentThreadID(), SkipListDelete); - ThreadSkipListRenMov.TryGetValue(GetCurrentThreadID(), SkipListRenMov); - - ThreadCanAbortRenMov.TryGetValue(GetCurrentThreadID(), CanAbortRenMov); - - if (CanAbortRenMov and TCProgress.Progress(path)) then - begin - ThreadListingAborted.AddOrSetValue(GetCurrentThreadID(), true); - RenMovAborted := true; - end - else - RenMovAborted := false; - - if SkipListDelete or SkipListRenMov or RenMovAborted then - begin - SetLastError(ERROR_NO_MORE_FILES); - exit(INVALID_HANDLE_VALUE); - end; - - //Result := FIND_NO_MORE_FILES; - GlobalPath := path; - if GlobalPath = '\' then - begin //список соединений - Accounts := AccountSettings.GetAccountsList([ATPrivate, ATPublic], SettingsManager.Settings.EnabledVirtualTypes); - if (Accounts.Count > 0) then - begin - FindData := GetFindDataEmptyDir(Accounts[0]); - FileCounter := 1; - Result := FIND_ROOT_DIRECTORY; - end else begin - Result := INVALID_HANDLE_VALUE; //Нельзя использовать exit - SetLastError(ERROR_NO_MORE_FILES); - end; - end else begin - RealPath.FromPath(GlobalPath); - CurrentCloud := ConnectionManager.Get(RealPath.account, getResult); - - if getResult <> CLOUD_OPERATION_OK then - begin - SetLastError(ERROR_ACCESS_DENIED); - exit(INVALID_HANDLE_VALUE); - end; - - if not Assigned(CurrentCloud) then - begin - SetLastError(ERROR_PATH_NOT_FOUND); - exit(INVALID_HANDLE_VALUE); - end; - - if RealPath.trashDir then - begin - if not CurrentCloud.getTrashbinListing(CurrentListing) then - SetLastError(ERROR_PATH_NOT_FOUND); - end else if RealPath.sharedDir then - begin - if not CurrentCloud.getSharedLinksListing(CurrentListing) then - SetLastError(ERROR_PATH_NOT_FOUND); //that will be interpreted as symlinks later - end else if RealPath.invitesDir then - begin - if not CurrentCloud.getIncomingLinksListing(CurrentListing, CurrentIncomingInvitesListing) then - SetLastError(ERROR_PATH_NOT_FOUND); //одновременно получаем оба листинга, чтобы не перечитывать листинг инватов на каждый чих - end else begin //Нужно проверить, является ли открываемый объект каталогом - для файлов API вернёт листинг вышестоящего каталога, см. issue #174 - if not CurrentCloud.getDirListing(RealPath.path, CurrentListing) then - SetLastError(ERROR_PATH_NOT_FOUND); - end; - - if RealPath.isVirtual and not RealPath.isInAccountsList then //игнорим попытки получить листинги объектов вирутальных каталогов - begin - SetLastError(ERROR_ACCESS_DENIED); - exit(INVALID_HANDLE_VALUE); - end; - - if CurrentCloud.public_account then - CurrentItem := CurrentListing.FindByName(ExtractUniversalFileName(RealPath.path)) - else - CurrentItem := CurrentListing.FindByHomePath(RealPath.path); - - if not(CurrentItem.isNone or CurrentItem.isDir) then - begin - SetLastError(ERROR_PATH_NOT_FOUND); - exit(INVALID_HANDLE_VALUE); - end; - - if (Length(CurrentListing) = 0) then - begin - FindData := GetFindDataEmptyDir(); //воркароунд бага с невозможностью входа в пустой каталог, см. http://www.ghisler.ch/board/viewtopic.php?t=42399 - Result := FIND_NO_MORE_FILES; - SetLastError(ERROR_NO_MORE_FILES); - end else begin - - FindData := CurrentListing[0].ToFindData(RealPath.sharedDir); //folders inside shared links directory must be displayed as symlinks - FileCounter := 1; - if RealPath.sharedDir then - Result := FIND_SHARED_LINKS - else - Result := FIND_OK; - end; - end; + Exit(MailRuCloudWFX.FsFindFirst(path, FindData)); end; function FsFindNextW(Hdl: THandle; var FindData: tWIN32FINDDATAW): Bool; stdcall; begin - if GlobalPath = '\' then - begin - if (Accounts.Count > FileCounter) then - begin - FindData := GetFindDataEmptyDir(Accounts[FileCounter]); - inc(FileCounter); - Result := true; - end - else - Result := false; - - end else begin - //Получение последующих файлов в папке (вызывается до тех пор, пока не вернёт false). - if (Length(CurrentListing) > FileCounter) then - begin - FindData := CurrentListing[FileCounter].ToFindData(Hdl = FIND_SHARED_LINKS); - Result := true; - inc(FileCounter); - end else begin - FillChar(FindData, sizeof(WIN32_FIND_DATA), 0); - FileCounter := 0; - Result := false; - end; - end; + Exit(MailRuCloudWFX.FsFindNext(Hdl, FindData)); end; function FsFindClose(Hdl: THandle): integer; stdcall; begin //Завершение получения списка файлов. Result тоталом не используется (всегда равен 0) - Result := 0; - FileCounter := 0; -end; - -function ExecTrashbinProperties(MainWin: THandle; RealPath: TRealPath): integer; -var - Cloud: TCloudMailRu; - getResult: integer; - CurrentItem: TCMRDirItem; -begin - Result := FS_EXEC_OK; - Cloud := ConnectionManager.Get(RealPath.account, getResult); - if RealPath.isInAccountsList then //main trashbin folder properties - begin - if not Cloud.getTrashbinListing(CurrentListing) then - exit(FS_EXEC_ERROR); - getResult := TDeletedPropertyForm.ShowProperties(MainWin, CurrentListing, true, RealPath.account); - end else begin //one item in trashbin - CurrentItem := FindListingItemByPath(CurrentListing, RealPath); //для одинаково именованных файлов в корзине будут показываться свойства первого, сорян - getResult := TDeletedPropertyForm.ShowProperties(MainWin, [CurrentItem]); - end; - case (getResult) of - mrNo: - if not Cloud.trashbinEmpty then - exit(FS_EXEC_ERROR); - mrYes: - if not Cloud.trashbinRestore(CurrentItem.deleted_from + CurrentItem.name, CurrentItem.rev) then - exit(FS_EXEC_ERROR); - mrYesToAll: - for CurrentItem in CurrentListing do - if not Cloud.trashbinRestore(CurrentItem.deleted_from + CurrentItem.name, CurrentItem.rev) then - exit(FS_EXEC_ERROR); - end; - - PostMessage(MainWin, WM_USER + 51, 540, 0); //TC does not update current panel, so we should do it this way -end; - -function ExecSharedAction(MainWin: THandle; RealPath: TRealPath; RemoteName: PWideChar; ActionOpen: Boolean = true): integer; -var - Cloud: TCloudMailRu; - CurrentItem: TCMRDirItem; - getResult: integer; -begin - Result := FS_EXEC_OK; - if ActionOpen then //open item, i.e. treat it as symlink to original location - begin - CurrentItem := FindListingItemByPath(CurrentListing, RealPath); - if CurrentItem.type_ = TYPE_FILE then - strpcopy(RemoteName, '\' + RealPath.account + ExtractFilePath(UrlToPath(CurrentItem.home))) - else - strpcopy(RemoteName, '\' + RealPath.account + UrlToPath(CurrentItem.home)); - Result := FS_EXEC_SYMLINK; - end else begin - if RealPath.isInAccountsList then - begin - if TAccountsForm.ShowAccounts(MainWin, PasswordManager, RealPath.account) then //main shared folder properties - open connection settings - SettingsManager.Refresh; - end else begin - Cloud := ConnectionManager.Get(RealPath.account, getResult); - CurrentItem := FindListingItemByPath(CurrentListing, RealPath); - if Cloud.statusFile(CurrentItem.home, CurrentItem) then - TPropertyForm.ShowProperty(MainWin, RealPath.path, CurrentItem, Cloud, SettingsManager.Settings.DownloadLinksEncode, SettingsManager.Settings.AutoUpdateDownloadListing, false, false, SettingsManager.Settings.DescriptionFileName) - end; - end; -end; - -function ExecInvitesAction(MainWin: THandle; RealPath: TRealPath): integer; -var - Cloud: TCloudMailRu; - getResult: integer; - CurrentInvite: TCMRIncomingInvite; -begin - Result := FS_EXEC_OK; - Cloud := ConnectionManager.Get(RealPath.account, getResult); - if RealPath.isInAccountsList then //main invites folder properties - begin - if TAccountsForm.ShowAccounts(MainWin, PasswordManager, RealPath.account) then - SettingsManager.Refresh; - end else begin //one invite item - CurrentInvite := FindIncomingInviteItemByPath(CurrentIncomingInvitesListing, RealPath); - if CurrentInvite.name = EmptyWideStr then - exit(FS_EXEC_ERROR); - - getResult := TInvitePropertyForm.ShowProperties(MainWin, CurrentInvite); - end; - case (getResult) of - mrAbort: - Cloud.unmountFolder(CurrentInvite.name, true); - mrClose: - Cloud.unmountFolder(CurrentInvite.name, false); - mrYes: - Cloud.mountFolder(CurrentInvite.name, CurrentInvite.invite_token); - mrNo: - Cloud.rejectInvite(CurrentInvite.invite_token); - - end; - - PostMessage(MainWin, WM_USER + 51, 540, 0); //TC does not update current panel, so we should do it this way -end; - -function ExecProperties(MainWin: THandle; RealPath: TRealPath): integer; -var - Cloud: TCloudMailRu; - CurrentItem: TCMRDirItem; - getResult: integer; -begin - Result := FS_EXEC_OK; - if RealPath.isInAccountsList then - begin - if TAccountsForm.ShowAccounts(MainWin, PasswordManager, RealPath.account) then //show account properties - SettingsManager.Refresh; - end else begin - Cloud := ConnectionManager.Get(RealPath.account, getResult); - //всегда нужно обновлять статус на сервере, CurrentListing может быть изменён в другой панели - if (Cloud.statusFile(RealPath.path, CurrentItem)) and (idContinue = TPropertyForm.ShowProperty(MainWin, RealPath.path, CurrentItem, Cloud, SettingsManager.Settings.DownloadLinksEncode, SettingsManager.Settings.AutoUpdateDownloadListing, SettingsManager.Settings.DescriptionEnabled, SettingsManager.Settings.DescriptionEditorEnabled, SettingsManager.Settings.DescriptionFileName)) then - PostMessage(MainWin, WM_USER + 51, 540, 0); //refresh tc panel if description edited - end; -end; - -function ExecCommand(RemoteName: PWideChar; command: WideString; Parameter: WideString = ''): integer; -var - RealPath: TRealPath; - getResult: integer; - Cloud: TCloudMailRu; - HashInfo: THashInfo; -begin - Result := FS_EXEC_OK; - - if command = 'rmdir' then - begin - RealPath.FromPath(RemoteName + Parameter); - if (ConnectionManager.Get(RealPath.account, getResult).removeDir(RealPath.path) <> true) then - exit(FS_EXEC_ERROR); - end; - - RealPath.FromPath(RemoteName); //default - Cloud := ConnectionManager.Get(RealPath.account, getResult); - - //undocumented, share current folder to email param - if command = 'share' then - if not(Cloud.shareFolder(RealPath.path, ExtractLinkFromUrl(Parameter), CLOUD_SHARE_RW)) then - exit(FS_EXEC_ERROR); - - if command = 'hash' then //add file by hash & filesize - begin - HashInfo := THashInfo.Create(Parameter); - if HashInfo.valid then - begin - Cloud.addFileByIdentity(HashInfo.CloudFileIdentity, IncludeTrailingPathDelimiter(RealPath.path) + HashInfo.name, CLOUD_CONFLICT_RENAME); - HashInfo.Destroy; - end else begin - TCLogger.Log(LOG_LEVEL_DEBUG, msgtype_details, ERR_CLONE_BY_HASH, [HashInfo.errorString, Parameter]); - HashInfo.Destroy; - exit(FS_EXEC_ERROR); - end; - end; - - if command = 'clone' then //add file by weblink - begin - if (Cloud.cloneWeblink(RealPath.path, ExtractLinkFromUrl(Parameter)) = CLOUD_OPERATION_OK) then - if SettingsManager.Settings.LogUserSpace then - Cloud.logUserSpaceInfo - else - exit(FS_EXEC_ERROR); - end; - - if command = 'trash' then //go to current account trash directory - begin - if Cloud.public_account then - exit(FS_EXEC_ERROR); - if RealPath.IsInAccount(false) then - begin - strpcopy(RemoteName, '\' + RealPath.account + TrashPostfix); - exit(FS_EXEC_SYMLINK); - end; - end; - - if command = 'shared' then - begin - if Cloud.public_account then - exit(FS_EXEC_ERROR); - if RealPath.IsInAccount(false) then - begin - strpcopy(RemoteName, '\' + RealPath.account + SharedPostfix); - exit(FS_EXEC_SYMLINK); - end; - end; - - if command = 'invites' then - begin - if Cloud.public_account then - exit(FS_EXEC_ERROR); - if RealPath.IsInAccount(false) then - begin - strpcopy(RemoteName, '\' + RealPath.account + InvitesPostfix); - exit(FS_EXEC_SYMLINK); - end; - end; - -end; - -function ExecuteFileStream(RealPath: TRealPath; StreamingSettings: TStreamingSettings): integer; -var - StreamUrl: WideString; - getResult: integer; - CurrentCloud, TempPublicCloud: TCloudMailRu; - CurrentItem: TCMRDirItem; -begin - Result := FS_EXEC_OK; - if (STREAMING_FORMAT_DISABLED = StreamingSettings.Format) or (STREAMING_FORMAT_UNSET = StreamingSettings.Format) then - exit; - - //может быть разница в атрибутах настоящих и полученных из листинга (они не рефрешатся) - CurrentItem := FindListingItemByPath(CurrentListing, RealPath); //внутри публичного облака веблинк есть автоматически - - if TCloudMailRu.TempPublicCloudInit(TempPublicCloud, PUBLIC_ACCESS_URL + CurrentItem.weblink) then - begin - if STREAMING_FORMAT_PLAYLIST = StreamingSettings.Format then - begin - if not TempPublicCloud.getPublishedFileStreamUrl(CurrentItem, StreamUrl) then - Result := FS_EXEC_ERROR; - end else begin - if not CurrentItem.isPublished then - begin - CurrentCloud := ConnectionManager.Get(RealPath.account, getResult); - if not CurrentCloud.publishFile(CurrentItem.home, CurrentItem.weblink) then - Result := FS_EXEC_ERROR; - //Здесь можно бы обновить листинг - end; - if FS_EXEC_OK = Result then - StreamUrl := TempPublicCloud.getSharedFileUrl(EmptyWideStr, ShardTypeFromStreamingFormat(StreamingSettings.Format)); - end; - - if FS_EXEC_OK = Result then - begin - if EmptyWideStr = StreamingSettings.Parameters then - StreamingSettings.Parameters := '%url%'; - StreamingSettings.Parameters := StringReplace(StreamingSettings.Parameters, '%url%', StreamUrl, [rfReplaceAll, rfIgnoreCase]); - - if not(Run(StreamingSettings.command, StreamUrl, StreamingSettings.StartPath)) then - Result := FS_EXEC_ERROR; - end; - - end; - - FreeAndNil(TempPublicCloud); - + Exit(MailRuCloudWFX.FsFindClose(Hdl)); end; function FsExecuteFileW(MainWin: THandle; RemoteName, Verb: PWideChar): integer; stdcall; //Запуск файла -var - RealPath: TRealPath; -begin - RealPath.FromPath(RemoteName); - - if RealPath.upDirItem then - RealPath.path := ExtractFilePath(RealPath.path); //if somepath/.. item properties called - - if RealPath.trashDir and ((Verb = VERB_OPEN) or (Verb = VERB_PROPERTIES)) then - exit(ExecTrashbinProperties(MainWin, RealPath)); - - if RealPath.sharedDir then - exit(ExecSharedAction(MainWin, RealPath, RemoteName, Verb = VERB_OPEN)); - - if RealPath.invitesDir then - exit(ExecInvitesAction(MainWin, RealPath)); - - if Verb = VERB_PROPERTIES then - exit(ExecProperties(MainWin, RealPath)); - - if Verb = VERB_OPEN then - begin - if (not(RealPath.isDir = ID_True)) then - exit(ExecuteFileStream(RealPath, SettingsManager.GetStreamingSettings(RealPath.path))) - else - exit(FS_EXEC_YOURSELF); - end; - - if copy(Verb, 1, 5) = VERB_QUOTE then - exit(ExecCommand(RemoteName, LowerCase(GetWord(Verb, 1)), GetWord(Verb, 2))); - - //if copy(Verb, 1, 5) = 'chmod' then exit; //future usage - exit(FS_EXEC_OK) - -end; - -procedure UpdateFileDescription(RemotePath: TRealPath; LocalFilePath: WideString; var Cloud: TCloudMailRu); -var - RemoteDescriptions, LocalDescriptions: TDescription; - RemoteIonPath, LocalTempPath: WideString; - RemoteIonExists: Boolean; begin - RemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(RemotePath.path)) + SettingsManager.Settings.DescriptionFileName; - LocalTempPath := GetTmpFileName('ion'); - - RemoteIonExists := Cloud.getDescriptionFile(RemoteIonPath, LocalTempPath); - if not RemoteIonExists then - exit; //удалённого файла описаний нет - - RemoteDescriptions := TDescription.Create(LocalTempPath, GetTCCommentPreferredFormat); - RemoteDescriptions.Read; - LocalDescriptions := TDescription.Create(IncludeTrailingPathDelimiter(ExtractFileDir(LocalFilePath)) + SettingsManager.Settings.DescriptionFileName, GetTCCommentPreferredFormat); //open local ion file - LocalDescriptions.Read; - LocalDescriptions.CopyFrom(RemoteDescriptions, ExtractFileName(LocalFilePath)); - LocalDescriptions.Write(); - LocalDescriptions.Destroy; - RemoteDescriptions.Destroy -end; - -procedure UpdateRemoteFileDescription(RemotePath: TRealPath; LocalFilePath: WideString; var Cloud: TCloudMailRu); -var - RemoteDescriptions, LocalDescriptions: TDescription; - RemoteIonPath, LocalIonPath, LocalTempPath: WideString; - RemoteIonExists: Boolean; -begin - RemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(RemotePath.path)) + SettingsManager.Settings.DescriptionFileName; - LocalIonPath := IncludeTrailingBackslash(ExtractFileDir(LocalFilePath)) + SettingsManager.Settings.DescriptionFileName; - LocalTempPath := GetTmpFileName('ion'); - - if (not FileExists(GetUNCFilePath(LocalIonPath))) then - exit; //Файла описаний нет, не паримся - - LocalDescriptions := TDescription.Create(LocalIonPath, GetTCCommentPreferredFormat); - LocalDescriptions.Read; - - RemoteIonExists := Cloud.getDescriptionFile(RemoteIonPath, LocalTempPath); - RemoteDescriptions := TDescription.Create(LocalTempPath, GetTCCommentPreferredFormat); - if RemoteIonExists then - RemoteDescriptions.Read; //если был прежний файл - его надо перечитать - - RemoteDescriptions.CopyFrom(LocalDescriptions, ExtractFileName(RemotePath.path)); - RemoteDescriptions.Write(); - if RemoteIonExists then - Cloud.deleteFile(RemoteIonPath); //Приходится удалять, потому что не знаем, как переписать - - Cloud.putDesriptionFile(RemoteIonPath, RemoteDescriptions.ionFilename); - - RemoteDescriptions.Destroy; - LocalDescriptions.Destroy; -end; - -//Предполагается, что процедура происходит внутри одного облака - в плагине запрещены прямые операции между аккаунтами -procedure RenameRemoteFileDescription(OldRemotePath, NewRemotePath: TRealPath; var Cloud: TCloudMailRu); -var - OldDescriptions, NewDescriptions: TDescription; - OldRemoteIonPath, NewRemoteIonPath, OldLocalTempPath, NewLocalTempPath: WideString; - NewRemoteIonExists: Boolean; - OldItem, NewItem: WideString; -begin - OldItem := ExtractFileName(OldRemotePath.path); - NewItem := ExtractFileName(NewRemotePath.path); - OldRemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(OldRemotePath.path)) + SettingsManager.Settings.DescriptionFileName; - NewRemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(NewRemotePath.path)) + SettingsManager.Settings.DescriptionFileName; - OldLocalTempPath := GetTmpFileName('ion'); - NewLocalTempPath := GetTmpFileName('ion'); - - if ExtractFileDir(OldRemotePath.path) = ExtractFileDir(NewRemotePath.path) then //переименование внутри одного файла - begin - if not Cloud.getDescriptionFile(OldRemoteIonPath, OldLocalTempPath) then - exit; //описания нет, переносить нечего - OldDescriptions := TDescription.Create(OldLocalTempPath, GetTCCommentPreferredFormat); - OldDescriptions.Read; - if (OldDescriptions.RenameItem(OldItem, NewItem)) then //метод сам проверит существование описания - begin - OldDescriptions.Write(); - Cloud.deleteFile(OldRemoteIonPath); - Cloud.putDesriptionFile(OldRemoteIonPath, OldDescriptions.ionFilename); - end; - OldDescriptions.Destroy; - end - else //перенос и переименование в разных файлах (например, перемещение в подкаталог) - begin - if not Cloud.getDescriptionFile(OldRemoteIonPath, OldLocalTempPath) then - exit; //описания нет, не заморачиваемся - OldDescriptions := TDescription.Create(OldLocalTempPath, GetTCCommentPreferredFormat); - OldDescriptions.Read; - NewRemoteIonExists := Cloud.getDescriptionFile(NewRemoteIonPath, NewLocalTempPath); - NewDescriptions := TDescription.Create(NewLocalTempPath, GetTCCommentPreferredFormat); - if NewRemoteIonExists then - NewDescriptions.Read; //прочитать существующий, если его нет - то и читать нечего - - NewDescriptions.SetValue(ExtractFileName(NewRemotePath.path), OldDescriptions.GetValue(ExtractFileName(OldRemotePath.path))); - OldDescriptions.DeleteValue(ExtractFileName(OldRemotePath.path)); - OldDescriptions.Write(); - NewDescriptions.Write(); - Cloud.deleteFile(OldRemoteIonPath); - Cloud.putDesriptionFile(OldRemoteIonPath, OldDescriptions.ionFilename); - if NewRemoteIonExists then - Cloud.deleteFile(NewRemoteIonPath); //Если файл существовал ранее, его нужно удалить для последующей записи на его место - Cloud.putDesriptionFile(NewRemoteIonPath, NewDescriptions.ionFilename); - OldDescriptions.Destroy; - NewDescriptions.Destroy; - end; - -end; - -procedure DeleteRemoteFileDescription(RemotePath: TRealPath; var Cloud: TCloudMailRu); -var - RemoteDescriptions: TDescription; - RemoteIonPath, LocalTempPath: WideString; -begin - RemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(RemotePath.path)) + SettingsManager.Settings.DescriptionFileName; - LocalTempPath := GetTmpFileName('ion'); - if not Cloud.getDescriptionFile(RemoteIonPath, LocalTempPath) then - exit; //описания нет, не заморачиваемся - RemoteDescriptions := TDescription.Create(LocalTempPath, GetTCCommentPreferredFormat); - RemoteDescriptions.Read; - RemoteDescriptions.DeleteValue(ExtractFileName(RemotePath.path)); - RemoteDescriptions.Write(); - Cloud.deleteFile(RemoteIonPath); //Приходится удалять, потому что не знаем, как переписать - Cloud.putDesriptionFile(RemoteIonPath, RemoteDescriptions.ionFilename); - RemoteDescriptions.Destroy; -end; - -function GetRemoteFile(RemotePath: TRealPath; LocalName, RemoteName: WideString; CopyFlags: integer): integer; -var - getResult: integer; - Item: TCMRDirItem; - Cloud: TCloudMailRu; - resultHash: WideString; -begin - if (SettingsManager.Settings.CheckCRC) then - resultHash := EmptyWideStr - else - resultHash := 'dummy'; //calculations will be ignored if variable is not empty - Cloud := ConnectionManager.Get(RemotePath.account, getResult); - - Result := Cloud.getFile(WideString(RemotePath.path), LocalName, resultHash); - - if Result = FS_FILE_OK then - begin - - Item := FindListingItemByPath(CurrentListing, RemotePath); - {Дополнительно проверим CRC скачанного файла} - if SettingsManager.Settings.CheckCRC then - begin - if (resultHash <> EmptyWideStr) and (Item.hash <> resultHash) then - exit(FS_FILE_READERROR); - end; - - if SettingsManager.Settings.PreserveFileTime then - begin - if Item.mtime <> 0 then - SetAllFileTime(ExpandUNCFileName(LocalName), DateTimeToFileTime(UnixToDateTime(Item.mtime))); - end; - if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then - begin - Cloud.deleteFile(RemotePath.path); - if (SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RemotePath.account).IsRemoteDescriptionsSupported) then - DeleteRemoteFileDescription(RemotePath, Cloud); - end; - TCProgress.Progress(PWideChar(LocalName), PWideChar(RemoteName), 100); - TCLogger.Log(LOG_LEVEL_FILE_OPERATION, MSGTYPE_TRANSFERCOMPLETE, '%s -> %s', [RemoteName, LocalName]); - - if SettingsManager.Settings.DescriptionCopyFromCloud then - UpdateFileDescription(RemotePath, LocalName, Cloud); - - end; + Exit(MailRuCloudWFX.FsExecuteFile(MainWin, RemoteName, Verb)); end; function FsGetFileW(RemoteName, LocalName: PWideChar; CopyFlags: integer; RemoteInfo: pRemoteInfo): integer; stdcall; //Копирование файла из файловой системы плагина -var - RealPath: TRealPath; - OverwriteLocalMode: integer; - RetryAttempts: integer; begin - Result := FS_FILE_NOTSUPPORTED; - if CheckFlag(FS_COPYFLAGS_RESUME, CopyFlags) then - exit; {NEVER CALLED HERE} - RealPath.FromPath(RemoteName); - if RealPath.isVirtual then - exit; - - TCProgress.Progress(RemoteName, LocalName, 0); - - OverwriteLocalMode := SettingsManager.Settings.OverwriteLocalMode; - if (FileExists(GetUNCFilePath(LocalName)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags))) then - begin - case OverwriteLocalMode of - OverwriteLocalModeAsk: - exit(FS_FILE_EXISTS); //TC will ask user - OverwriteLocalModeIgnore: - begin - TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, FILE_EXISTS_IGNORE, [LocalName]); - exit(FS_FILE_OK); - end; - OverwriteLocalModeOverwrite: - TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, FILE_EXISTS_OVERWRITE, [LocalName]); - end; - end; - - Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); - - if Result <> FS_FILE_READERROR then - exit; - - case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: - begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - case (MsgBox(ERR_DOWNLOAD_FILE_ASK, [RemoteName], ERR_DOWNLOAD, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of - ID_ABORT: - Result := FS_FILE_USERABORT; - ID_RETRY: - Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); - ID_IGNORE: - break; - end; - end; - - end; - OperationErrorModeIgnore: - exit; - OperationErrorModeAbort: - exit(FS_FILE_USERABORT); - OperationErrorModeRetry: - begin; - RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountDownload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - ThreadRetryCountDownload.Items[GetCurrentThreadID()] := ThreadRetryCountDownload.Items[GetCurrentThreadID()] + 1; - TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, DOWNLOAD_FILE_RETRY, [RemoteName, ThreadRetryCountDownload.Items[GetCurrentThreadID()], RetryAttempts]); - Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); - if TCProgress.Progress(PWideChar(LocalName), RemoteName, 0) then - Result := FS_FILE_USERABORT; - if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then - ThreadRetryCountDownload.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток - ProcessMessages; - Sleep(SettingsManager.Settings.AttemptWait); - end; - end; - end; - -end; - -function PutRemoteFile(RemotePath: TRealPath; LocalName, RemoteName: WideString; CopyFlags: integer): integer; -var - getResult: integer; - Cloud: TCloudMailRu; -begin - Cloud := ConnectionManager.Get(RemotePath.account, getResult); - - Result := Cloud.putFile(WideString(LocalName), RemotePath.path); - if Result = FS_FILE_OK then - begin - TCProgress.Progress(PWideChar(LocalName), PWideChar(RemotePath.path), 100); - TCLogger.Log(LOG_LEVEL_FILE_OPERATION, MSGTYPE_TRANSFERCOMPLETE, '%s -> %s', [LocalName, RemoteName]); - if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then - Result := DeleteLocalFile(LocalName); - if (SettingsManager.Settings.DescriptionCopyToCloud and AccountSettings.GetAccountSettings(RemotePath.account).IsRemoteDescriptionsSupported) then - UpdateRemoteFileDescription(RemotePath, LocalName, Cloud); - end; - + Exit(MailRuCloudWFX.FsGetFile(RemoteName, LocalName, CopyFlags, RemoteInfo)); end; function FsPutFileW(LocalName, RemoteName: PWideChar; CopyFlags: integer): integer; stdcall; -var - RealPath: TRealPath; - RetryAttempts: integer; - getResult: integer; begin - - RealPath.FromPath(RemoteName); - if not FileExists(GetUNCFilePath(LocalName)) then - exit(FS_FILE_NOTFOUND); - - if RealPath.isAccountEmpty or RealPath.isVirtual then - exit(FS_FILE_NOTSUPPORTED); - TCProgress.Progress(LocalName, PWideChar(RealPath.path), 0); - - if CheckFlag(FS_COPYFLAGS_RESUME, CopyFlags) then - exit(FS_FILE_NOTSUPPORTED); //NOT SUPPORTED - - if (CheckFlag(FS_COPYFLAGS_EXISTS_SAMECASE, CopyFlags) or CheckFlag(FS_COPYFLAGS_EXISTS_DIFFERENTCASE, CopyFlags)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags)) then - exit(FS_FILE_EXISTS); //Облако не поддерживает разные регистры - - if CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags) then - begin - if not(ConnectionManager.Get(RealPath.account, getResult).deleteFile(RealPath.path)) then - exit(FS_FILE_NOTSUPPORTED); //Неизвестно, как перезаписать файл черз API, но мы можем его удалить - end; - Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); - - //if Result in [FS_FILE_OK, FS_FILE_USERABORT, FS_FILE_NOTSUPPORTED] then exit; - if Result <> FS_FILE_WRITEERROR then - exit; - - case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: - begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - case (MsgBox(ERR_UPLOAD_FILE_ASK, [LocalName], ERR_UPLOAD, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of - ID_ABORT: - Result := FS_FILE_USERABORT; - ID_RETRY: - Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); - ID_IGNORE: - break; - end; - end; - - end; - OperationErrorModeIgnore: - exit; - OperationErrorModeAbort: - exit(FS_FILE_USERABORT); - OperationErrorModeRetry: - begin; - RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountUpload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - ThreadRetryCountUpload.Items[GetCurrentThreadID()] := ThreadRetryCountUpload.Items[GetCurrentThreadID()] + 1; - TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, UPLOAD_FILE_RETRY, [LocalName, ThreadRetryCountUpload.Items[GetCurrentThreadID()], RetryAttempts]); - Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); - if TCProgress.Progress(PWideChar(LocalName), RemoteName, 0) then - Result := FS_FILE_USERABORT; - if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then - ThreadRetryCountUpload.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток - ProcessMessages; - Sleep(SettingsManager.Settings.AttemptWait); - end; - end; - end; - + Exit(MailRuCloudWFX.FsPutFile(RemoteName, LocalName, CopyFlags)); end; function FsDeleteFileW(RemoteName: PWideChar): Bool; stdcall; //Удаление файла из файловой системы плагина -var - RealPath: TRealPath; - getResult: integer; - CurrentItem: TCMRDirItem; - Cloud: TCloudMailRu; - InvitesListing: TCMRInviteList; - Invite: TCMRInvite; begin - RealPath.FromPath(WideString(RemoteName)); - if RealPath.isAccountEmpty or RealPath.trashDir or RealPath.invitesDir then - exit(false); - Cloud := ConnectionManager.Get(RealPath.account, getResult); - if RealPath.sharedDir then - begin - CurrentItem := FindListingItemByPath(CurrentListing, RealPath); - Cloud.getShareInfo(CurrentItem.home, InvitesListing); - for Invite in InvitesListing do - Cloud.shareFolder(CurrentItem.home, Invite.email, CLOUD_SHARE_NO); //no reporting here - if CurrentItem.isPublished then - Cloud.publishFile(CurrentItem.home, CurrentItem.weblink, CLOUD_UNPUBLISH); - Result := true; - end - else - Result := Cloud.deleteFile(RealPath.path); - if (Result and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RealPath.account).IsRemoteDescriptionsSupported) then - DeleteRemoteFileDescription(RealPath, Cloud); + Exit(MailRuCloudWFX.FsDeleteFile(RemoteName)); end; function FsMkDirW(path: PWideChar): Bool; stdcall; -var - RealPath: TRealPath; - getResult: integer; - SkipListRenMov: Boolean; - OperationContextId: integer; - RegisteredAccount: TAccountSettings; begin - ThreadSkipListRenMov.TryGetValue(GetCurrentThreadID(), SkipListRenMov); - if SkipListRenMov then - exit(false); //skip create directory if this flag set on - - RealPath.FromPath(WideString(path)); - if RealPath.isInAccountsList then //accounts list - begin - RegisteredAccount := AccountSettings.GetAccountSettings(RealPath.account); - - Result := (mrOk = TRegistrationForm.ShowRegistration(FindTCWindow, SettingsManager.Settings.ConnectionSettings, RegisteredAccount)); - if Result then - begin - if RegisteredAccount.UseTCPasswordManager then //просим TC сохранить пароль - Result := FS_FILE_OK = PasswordManager.SetPassword(RealPath.account, RegisteredAccount.password); - if Result then - AccountSettings.SetAccountSettings(RealPath.account, RegisteredAccount); - end; - exit(); - end; - if (RealPath.isAccountEmpty) or RealPath.isVirtual then - exit(false); - - Result := ConnectionManager.Get(RealPath.account, getResult).createDir(RealPath.path); - if Result then //need to check operation context => directory can be moved - begin - ThreadFsStatusInfo.TryGetValue(GetCurrentThreadID, OperationContextId); - if OperationContextId = FS_STATUS_OP_RENMOV_MULTI then - CurrentlyMovedDir := RealPath; - end; - + Exit(MailRuCloudWFX.FsMkDir(path)); end; function FsRemoveDirW(RemoteName: PWideChar): Bool; stdcall; -var - RealPath: TRealPath; - getResult: integer; - ListingAborted: Boolean; - Cloud: TCloudMailRu; - OperationContextId: integer; begin - if (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID) and Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) and ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Text.Contains(RemoteName)) then //файлы по удаляемому пути есть в блек-листе - exit(false); - ThreadListingAborted.TryGetValue(GetCurrentThreadID(), ListingAborted); - if ListingAborted then - begin - ThreadListingAborted.AddOrSetValue(GetCurrentThreadID(), false); - exit(false); - end; - RealPath.FromPath(WideString(RemoteName)); - if RealPath.isVirtual then - exit(false); - Cloud := ConnectionManager.Get(RealPath.account, getResult); - Result := Cloud.removeDir(RealPath.path); - - if (Result and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RealPath.account).IsRemoteDescriptionsSupported) then - begin - ThreadFsStatusInfo.TryGetValue(GetCurrentThreadID, OperationContextId); //need to check operation context => directory can be deleted after moving operation - if OperationContextId = FS_STATUS_OP_RENMOV_MULTI then - begin - RenameRemoteFileDescription(RealPath, CurrentlyMovedDir, Cloud); - end - else - DeleteRemoteFileDescription(RealPath, Cloud); - end; - -end; - -function cloneWeblink(NewCloud, OldCloud: TCloudMailRu; CloudPath: WideString; CurrentItem: TCMRDirItem; NeedUnpublish: Boolean): integer; -begin - Result := NewCloud.cloneWeblink(ExtractFileDir(CloudPath), CurrentItem.weblink, CLOUD_CONFLICT_STRICT); - if (NeedUnpublish) and (FS_FILE_USERABORT <> Result) and not(OldCloud.publishFile(CurrentItem.home, CurrentItem.weblink, CLOUD_UNPUBLISH)) then - TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, PREFIX_ERR_REMOVE_TEMP_PUBLIC_LINK + CurrentItem.home); -end; - -function RenMoveFileViaHash(OldCloud, NewCloud: TCloudMailRu; OldRealPath, NewRealPath: TRealPath; Move, OverWrite: Boolean): integer; -var - CurrentItem: TCMRDirItem; - RetryAttempts: integer; -begin - Result := FS_FILE_NOTSUPPORTED; - if OverWrite and not(NewCloud.deleteFile(NewRealPath.path)) then - exit; - if OldCloud.statusFile(OldRealPath.path, CurrentItem) then - begin - Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.path)) + ExtractFileName(NewRealPath.path)); - if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then - begin - - case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: - begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - case (MsgBox(ERR_CLONE_FILE_ASK, [TCloudMailRu.ErrorCodeText(Result)], ERR_OPERATION, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of - ID_ABORT: - Result := FS_FILE_USERABORT; - ID_RETRY: - Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.path)) + CurrentItem.name); - ID_IGNORE: - break; - end; - end; - end; - OperationErrorModeIgnore: - exit; - OperationErrorModeAbort: - exit(FS_FILE_USERABORT); - OperationErrorModeRetry: - begin; - RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := ThreadRetryCountRenMov.Items[GetCurrentThreadID()] + 1; - TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, CLONE_FILE_RETRY, [TCloudMailRu.ErrorCodeText(Result), ThreadRetryCountRenMov.Items[GetCurrentThreadID()], RetryAttempts]); - Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.path)) + ExtractFileName(NewRealPath.path)); - if TCProgress.Aborted() then - Result := FS_FILE_USERABORT; - if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then - ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток - ProcessMessages; - Sleep(SettingsManager.Settings.AttemptWait); - end; - end; - end; - end; - - if (Result = CLOUD_OPERATION_OK) and Move and not(OldCloud.deleteFile(OldRealPath.path)) then - TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_DELETE, [CurrentItem.home]); //пишем в лог, но не отваливаемся - end; -end; - -function RenMoveFileViaPublicLink(OldCloud, NewCloud: TCloudMailRu; OldRealPath, NewRealPath: TRealPath; Move, OverWrite: Boolean): integer; -var - NeedUnpublish: Boolean; - CurrentItem: TCMRDirItem; - RetryAttempts: integer; -begin - Result := FS_FILE_NOTSUPPORTED; - NeedUnpublish := false; - if OverWrite and not(NewCloud.deleteFile(NewRealPath.path)) then - exit; - - if OldCloud.statusFile(OldRealPath.path, CurrentItem) then - begin - if not CurrentItem.isPublished then //create temporary weblink - begin - NeedUnpublish := true; - if not(OldCloud.publishFile(CurrentItem.home, CurrentItem.weblink)) then //problem publishing - begin - TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_GET_TEMP_PUBLIC_LINK, [CurrentItem.home]); - exit(FS_FILE_READERROR); - end; - end; - Result := cloneWeblink(NewCloud, OldCloud, NewRealPath.path, CurrentItem, NeedUnpublish); - if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then - begin - - case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: - begin - - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - case (MsgBox(ERR_PUBLISH_FILE_ASK, [TCloudMailRu.ErrorCodeText(Result)], ERR_PUBLISH_FILE, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of - ID_ABORT: - Result := FS_FILE_USERABORT; - ID_RETRY: - Result := cloneWeblink(NewCloud, OldCloud, NewRealPath.path, CurrentItem, NeedUnpublish); - ID_IGNORE: - break; - end; - end; - - end; - OperationErrorModeIgnore: - exit; - OperationErrorModeAbort: - exit(FS_FILE_USERABORT); - OperationErrorModeRetry: - begin; - RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do - begin - ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := ThreadRetryCountRenMov.Items[GetCurrentThreadID()] + 1; - TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, PUBLISH_FILE_RETRY, [TCloudMailRu.ErrorCodeText(Result), ThreadRetryCountRenMov.Items[GetCurrentThreadID()], RetryAttempts]); - Result := cloneWeblink(NewCloud, OldCloud, NewRealPath.path, CurrentItem, NeedUnpublish); - if TCProgress.Aborted() then - Result := FS_FILE_USERABORT; - if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then - ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток - ProcessMessages; - Sleep(SettingsManager.Settings.AttemptWait); - end; - end; - end; - end; - - if (Result = CLOUD_OPERATION_OK) and Move and not(OldCloud.deleteFile(OldRealPath.path)) then - TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_DELETE, [CurrentItem.home]); //пишем в лог, но не отваливаемся - end; + Exit(MailRuCloudWFX.FsRemoveDir(RemoteName)); end; function FsRenMovFileW(OldName: PWideChar; NewName: PWideChar; Move: Boolean; OverWrite: Boolean; ri: pRemoteInfo): integer; stdcall; -var - OldRealPath: TRealPath; - NewRealPath: TRealPath; - getResult, SkippedFoundIndex: integer; - OldCloud, NewCloud: TCloudMailRu; begin - TCProgress.Progress(OldName, NewName, 0); - - OldRealPath.FromPath(WideString(OldName)); - NewRealPath.FromPath(WideString(NewName)); - - {TODO: Check the behavior inside virtual directories} - if OldRealPath.trashDir or NewRealPath.trashDir or OldRealPath.sharedDir or NewRealPath.sharedDir then - exit(FS_FILE_NOTSUPPORTED); - - OldCloud := ConnectionManager.Get(OldRealPath.account, getResult); - NewCloud := ConnectionManager.Get(NewRealPath.account, getResult); - - if OldRealPath.account <> NewRealPath.account then //разные аккаунты - begin - if OldCloud.public_account then - begin - TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_OPERATIONS_NOT_SUPPORTED); - exit(FS_FILE_USERABORT); - end; - - case SettingsManager.Settings.CopyBetweenAccountsMode of - CopyBetweenAccountsModeDisabled: - begin - TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_OPERATIONS_DISABLED); - exit(FS_FILE_USERABORT); - end; - CopyBetweenAccountsModeViaHash: - Result := RenMoveFileViaHash(OldCloud, NewCloud, OldRealPath, NewRealPath, Move, OverWrite); - CopyBetweenAccountsModeViaPublicLink: - Result := RenMoveFileViaPublicLink(OldCloud, NewCloud, OldRealPath, NewRealPath, Move, OverWrite); - else - exit(FS_FILE_WRITEERROR); - end; - - end else begin //один аккаунт - - if OverWrite and not(NewCloud.deleteFile(NewRealPath.path)) then - exit(FS_FILE_NOTSUPPORTED); //мы не умеем перезаписывать, но мы можем удалить существующий файл - if Move then - begin - Result := OldCloud.mvFile(OldRealPath.path, NewRealPath.path); - if (FS_FILE_EXISTS = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then //TC сразу же попытается удалить каталог, чтобы избежать этого - внесем путь в своеобразный блеклист - begin - ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Add(OldRealPath.ToPath); - end else if (FS_FILE_OK = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then - begin //Вытащим из блеклиста, если решили перезаписать - - if Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) then - begin - SkippedFoundIndex := ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].IndexOf(OldRealPath.ToPath); - if (-1 <> SkippedFoundIndex) then - ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Delete(SkippedFoundIndex); - end; - - end; - if ((FS_FILE_OK = Result) and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(NewRealPath.account).IsRemoteDescriptionsSupported) then - RenameRemoteFileDescription(OldRealPath, NewRealPath, OldCloud); - end else begin - Result := OldCloud.cpFile(OldRealPath.path, NewRealPath.path); - end; - - end; - TCProgress.Progress(OldName, NewName, 100); + Exit(MailRuCloudWFX.FsRenMovFile(OldName, NewName, Move, OverWrite, ri)); end; function FsDisconnectW(DisconnectRoot: PWideChar): Bool; stdcall; -var - BackgroundJobsCount: integer; - //ThreadId: DWORD; begin - //ConnectionManager.freeAll; - BackgroundJobsCount := 0; - if ((not ThreadBackgroundJobs.TryGetValue(ExtractFileName(DisconnectRoot), BackgroundJobsCount)) or (BackgroundJobsCount = 0)) then - begin - ConnectionManager.Free(ExtractFileName(DisconnectRoot)); - Result := true; - end else begin //здесь можно добавить механизм ожидания завершения фоновой операции - Result := false; - end; - + Exit(MailRuCloudWFX.FsDisconnect(DisconnectRoot)); end; {The password manager can be created only after this method is being called — it needs passed parameters} procedure FsSetCryptCallbackW(PCryptProc: TCryptProcW; CryptoNr: integer; Flags: integer); stdcall; begin - PasswordManager := TTCPasswordManager.Create(PCryptProc, PluginNum, CryptoNr, TCLogger); + MailRuCloudWFX.FsSetCryptCallback(PCryptProc, CryptoNr, Flags); +end; - ConnectionManager := TConnectionManager.Create(SettingsManager.Settings, TCProgress, TCLogger, TCRequest, PasswordManager); +function FsContentGetSupportedField(FieldIndex: integer; FieldName: PAnsiChar; Units: PAnsiChar; maxlen: integer): integer; stdcall; +begin + Exit(MailRuCloudWFX.FsContentGetSupportedField(FieldIndex, FieldName, Units, maxlen)); end; function FsContentGetValueW(FileName: PWideChar; FieldIndex: integer; UnitIndex: integer; FieldValue: Pointer; maxlen: integer; Flags: integer): integer; stdcall; -var - Item: TCMRDirItem; - RealPath: TRealPath; - FileTime: TFileTime; begin - Result := ft_nosuchfield; - RealPath.FromPath(FileName); - if RealPath.isInAccountsList then - begin - if FieldIndex = 14 then - begin - strpcopy(FieldValue, AccountSettings.GetAccountSettings(RealPath.account).Description); - exit(ft_stringw); - end - else - exit(ft_nosuchfield); - end; - - Item := FindListingItemByPath(CurrentListing, RealPath, not RealPath.invitesDir); - //if Item.home = '' then exit(ft_nosuchfield); - - case FieldIndex of - 0: - begin - if Item.mtime <> 0 then - exit(ft_nosuchfield); - strpcopy(FieldValue, Item.tree); - Result := ft_stringw; - end; - 1: - begin - strpcopy(FieldValue, Item.name); - Result := ft_stringw; - end; - 2: - begin - if Item.mtime <> 0 then - exit(ft_nosuchfield); - Move(Item.grev, FieldValue^, sizeof(Item.grev)); - Result := ft_numeric_32; - end; - 3: - begin - Move(Item.size, FieldValue^, sizeof(Item.size)); - Result := ft_numeric_64; - end; - 4: - begin - strpcopy(FieldValue, Item.kind); - Result := ft_stringw; - end; - 5: - begin - strpcopy(FieldValue, Item.weblink); - Result := ft_stringw; - end; - 6: - begin - if Item.mtime <> 0 then - exit(ft_nosuchfield); - Move(Item.rev, FieldValue^, sizeof(Item.rev)); - Result := ft_numeric_32; - end; - 7: - begin - strpcopy(FieldValue, Item.type_); - Result := ft_stringw; - end; - 8: - begin - strpcopy(FieldValue, Item.home); - Result := ft_stringw; - end; - 9: - begin - if Item.mtime = 0 then - exit(ft_nosuchfield); - FileTime.dwHighDateTime := 0; - FileTime.dwLowDateTime := 0; - FileTime := DateTimeToFileTime(UnixToDateTime(Item.mtime)); - Move(FileTime, FieldValue^, sizeof(FileTime)); - Result := ft_datetime; - end; - 10: - begin - strpcopy(FieldValue, Item.hash); - Result := ft_stringw; - end; - 11: - begin - strpcopy(FieldValue, Item.virus_scan); - Result := ft_stringw; - end; - 12: - begin - if Item.type_ = TYPE_FILE then - exit(ft_nosuchfield); - Move(Item.folders_count, FieldValue^, sizeof(Item.folders_count)); - Result := ft_numeric_32; - end; - 13: - begin - if Item.type_ = TYPE_FILE then - exit(ft_nosuchfield); - Move(Item.files_count, FieldValue^, sizeof(Item.files_count)); - Result := ft_numeric_32; - end; - 14: - begin - //При включённой сортировке Запрос происходит при появлении в списке - if SettingsManager.Settings.DescriptionEnabled then - begin - strpcopy(FieldValue, CurrentDescriptions.GetValue(Item.name)); - end else begin - strpcopy(FieldValue, ''); - end; - Result := ft_stringw; - end; - 15: - begin - if Item.deleted_at = 0 then - exit(ft_nosuchfield); - FileTime.dwHighDateTime := 0; - FileTime.dwLowDateTime := 0; - FileTime := DateTimeToFileTime(UnixToDateTime(Item.deleted_at)); - Move(FileTime, FieldValue^, sizeof(FileTime)); - Result := ft_datetime; - end; - 16: - begin - if Item.deleted_from = EmptyWideStr then - exit(ft_nosuchfield); - strpcopy(FieldValue, Item.deleted_from); - Result := ft_stringw; - end; - 17: - begin - if Item.deleted_by = 0 then - exit(ft_nosuchfield); - strpcopy(FieldValue, Item.deleted_by.ToString); //display user id as is, because no conversation api method performed - Result := ft_stringw; - end; - end; + Exit(MailRuCloudWFX.FsContentGetValue(FileName, FieldIndex, UnitIndex, FieldValue, maxlen, Flags)); end; function FsExtractCustomIconW(RemoteName: PWideChar; ExtractFlags: integer; var TheIcon: hicon): integer; stdcall; -var - RealPath: TRealPath; - Item: TCMRDirItem; - IconsMode: integer; - CurrentInviteItem: TCMRIncomingInvite; - IconsSize: integer; - FrontIcon, BackIcon: hicon; - - function GetFolderIconSize(IconsSize: integer): integer; - begin - if IconsSize <= 16 then - exit(IconSizeSmall); - if IconsSize <= 32 then - exit(IconSizeNormal); - exit(IconSizeLarge); - end; - - procedure CombineMacro(var CombinedIcon: hicon); - begin - FrontIcon := LoadImageW(hInstance, RemoteName, IMAGE_ICON, IconsSize, IconsSize, LR_DEFAULTCOLOR); - BackIcon := GetFolderIcon(GetFolderIconSize(IconsSize)); - CombinedIcon := CombineIcons(FrontIcon, BackIcon); - DeleteObject(FrontIcon); - DeleteObject(BackIcon); - end; - begin - Result := FS_ICON_EXTRACTED; - - RealPath.FromPath(RemoteName); - - if RealPath.upDirItem then - exit; //do not overlap updir icon - - IconsMode := SettingsManager.Settings.IconsMode; - IconsSize := GetTCIconsSize; - - if RealPath.trashDir and RealPath.isInAccountsList then //always draw system trash icon - begin - strpcopy(RemoteName, 'cloud_trash'); - TheIcon := GetSystemIcon(GetFolderIconSize(IconsSize)); - exit(FS_ICON_EXTRACTED_DESTROY); - end; - - if RealPath.sharedDir then - begin - if RealPath.isInAccountsList then - begin - strpcopy(RemoteName, 'shared'); - CombineMacro(TheIcon); - - exit(FS_ICON_EXTRACTED_DESTROY); - end else begin - if IconsMode = IconsModeDisabled then - IconsMode := IconsModeInternalOverlay; //always draw icons in shared links directory - end; - end; - - if RealPath.invitesDir then - begin - if RealPath.isInAccountsList then - begin - strpcopy(RemoteName, 'shared_incoming'); - CombineMacro(TheIcon); - exit(FS_ICON_EXTRACTED_DESTROY); - end else begin - - CurrentInviteItem := FindIncomingInviteItemByPath(CurrentIncomingInvitesListing, RealPath); - if CurrentInviteItem.name = EmptyWideStr then - exit(FS_ICON_USEDEFAULT); - - if CurrentInviteItem.isMounted then //mounted item - begin - strpcopy(RemoteName, 'shared_incoming'); - CombineMacro(TheIcon); - end else begin - strpcopy(RemoteName, 'shared'); - CombineMacro(TheIcon); - end; - exit(FS_ICON_EXTRACTED_DESTROY); - - end; - end; - - if IconsMode = IconsModeDisabled then - exit(FS_ICON_USEDEFAULT); - - if RealPath.isInAccountsList then //connection list - begin - if AccountSettings.GetAccountSettings(copy(RemoteName, 2, StrLen(RemoteName) - 2)).PublicAccount then - strpcopy(RemoteName, 'cloud_public') - else - strpcopy(RemoteName, 'cloud'); - end else begin //directories - Item := FindListingItemByPath(CurrentListing, RealPath); - if (Item.type_ = TYPE_DIR) or (Item.kind = KIND_SHARED) then - begin - if Item.kind = KIND_SHARED then - strpcopy(RemoteName, 'shared') - else if Item.isPublished then - strpcopy(RemoteName, 'shared_public') - else - exit(FS_ICON_USEDEFAULT); - end - else - exit(FS_ICON_USEDEFAULT); - end; - case IconsMode of - IconsModeInternal: - TheIcon := LoadImageW(hInstance, RemoteName, IMAGE_ICON, IconsSize, IconsSize, LR_DEFAULTCOLOR); - IconsModeInternalOverlay: - CombineMacro(TheIcon); - IconsModeExternal: - begin - TheIcon := LoadPluginIcon(PluginPath + 'icons', RemoteName); - if TheIcon = INVALID_HANDLE_VALUE then - exit(FS_ICON_USEDEFAULT); - exit(FS_ICON_EXTRACTED_DESTROY); - end; - IconsModeExternalOverlay: - begin - TheIcon := LoadPluginIcon(PluginPath + 'icons', RemoteName); - if TheIcon = INVALID_HANDLE_VALUE then - exit(FS_ICON_USEDEFAULT); - BackIcon := GetFolderIcon(GetFolderIconSize(IconsSize)); - TheIcon := CombineIcons(TheIcon, BackIcon); - DeleteObject(BackIcon); - exit(FS_ICON_EXTRACTED_DESTROY); - end; - - end; + Exit(MailRuCloudWFX.FsExtractCustomIcon(RemoteName, ExtractFlags, TheIcon)); end; procedure InitPluginData; begin - PluginPath := GetModuleName(hInstance); - PluginPath := IncludeTrailingBackslash(ExtractFilePath(PluginPath)); - - SettingsManager := TPluginSettingsManager.Create(); - - if SettingsManager.Settings.LoadSSLDLLOnlyFromPluginDir then - begin - if ((DirectoryExists(PluginPath + PlatformDllPath)) and (FileExists(PluginPath + PlatformDllPath + '\ssleay32.dll')) and (FileExists(PluginPath + PlatformDllPath + '\libeay32.dll'))) then - begin //try to load dll from platform subdir - IdOpenSSLSetLibPath(PluginPath + PlatformDllPath); - end else if ((FileExists(GetUNCFilePath(PluginPath + 'ssleay32.dll'))) and (FileExists(GetUNCFilePath(PluginPath + 'libeay32.dll')))) then - begin //else try to load it from plugin dir - IdOpenSSLSetLibPath(PluginPath); - end; - end; - - IsMultiThread := not(SettingsManager.Settings.DisableMultiThreading); - ThreadRetryCountDownload := TDictionary.Create; - ThreadRetryCountUpload := TDictionary.Create; - ThreadRetryCountRenMov := TDictionary.Create; - ThreadSkipListDelete := TDictionary.Create; - ThreadSkipListRenMov := TDictionary.Create; - ThreadCanAbortRenMov := TDictionary.Create; - ThreadListingAborted := TDictionary.Create; - ThreadBackgroundJobs := TDictionary.Create; - ThreadBackgroundThreads := TDictionary.Create; - ThreadFsStatusInfo := TDictionary.Create; - ThreadFsRemoveDirSkippedPath := TDictionary.Create; - - AccountSettings := TAccountsManager.Create(SettingsManager.AccountsIniFilePath); - + MailRuCloudWFX := TMailRuCloudWFX.Create(); end; procedure FreePluginData(); begin - FreeAndNil(ThreadRetryCountDownload); - FreeAndNil(ThreadRetryCountUpload); - FreeAndNil(ThreadRetryCountRenMov); - FreeAndNil(ThreadSkipListDelete); - FreeAndNil(ThreadSkipListRenMov); - FreeAndNil(ThreadCanAbortRenMov); - FreeAndNil(ThreadListingAborted); - FreeAndNil(ThreadBackgroundJobs); - FreeAndNil(ThreadFsStatusInfo); - FreeAndNil(ThreadFsRemoveDirSkippedPath); - FreeAndNil(ThreadBackgroundThreads); - FreeAndNil(ConnectionManager); - - CurrentDescriptions.Free; - - SettingsManager.Free; - AccountSettings.Free; - PasswordManager.Free; - TCLogger.Free; - TCProgress.Free; - TCRequest.Free; - + MailRuCloudWFX.Destroy; end; procedure DllInit(Code: integer); begin case Code of DLL_PROCESS_ATTACH: - begin - InitPluginData; - end; + InitPluginData; DLL_PROCESS_DETACH: - begin - FreePluginData(); - - end; - DLL_THREAD_ATTACH: - begin + FreePluginData(); + DLL_THREAD_ATTACH: begin end; - DLL_THREAD_DETACH: - begin + DLL_THREAD_DETACH: begin end; end; //case end; diff --git a/MailRuCloud.dproj b/MailRuCloud.dproj index c1491df..fba1632 100644 --- a/MailRuCloud.dproj +++ b/MailRuCloud.dproj @@ -265,6 +265,8 @@ + + ICON base_icon diff --git a/models/wfx/MailRuCloudWFX.pas b/models/wfx/MailRuCloudWFX.pas new file mode 100644 index 0000000..3280140 --- /dev/null +++ b/models/wfx/MailRuCloudWFX.pas @@ -0,0 +1,1889 @@ +unit MailRuCloudWFX; + +interface + +uses + AnsiStrings, + WFXInterface, + CloudMailRu, + Windows, + SysUtils, + DateUtils, + Classes, + Generics.Collections, + PLUGIN_TYPES, + RealPath, + PluginSettingsManager, + Accountsmanager, + WSList, + CMRConstants, + LANGUAGE_STRINGS, + SETTINGS_CONSTANTS, + CMRInviteList, + CMRInvite, + CMRDirItem, + CMRDirItemList, + CMRIncomingInviteList, + ConnectionManager, + IdSSLOpenSSLHeaders, + Description, + TCPasswordManager, + TCLogger, + TCProgress, + TCRequest, + PathHelper, + WindowsHelper, + TCHelper, + CMRIncomingInvite, + AccountSettings, + Accounts, + Registration, + InviteProperty, + RemoteProperty, + DeletedProperty, + Controls, + Messages, + HashInfo, + StringHelper, + PluginHelper, + FileHelper, + IconHelper, + SystemHelper, + StreamingSettings; + +type + TMailRuCloudWFX = class(TInterfacedObject, IWFXInterface) + private const +{$IFDEF WIN64} + PlatformDllPath = 'x64'; +{$ENDIF} +{$IFDEF WIN32} + PlatformDllPath = 'x32'; +{$ENDIF} + + var + GlobalPath, PluginPath: WideString; + FileCounter: Integer; + CurrentlyMovedDir: TRealPath; + ThreadSkipListDelete: TDictionary; //Массив id потоков, для которых операции получения листинга должны быть пропущены (при удалении) + ThreadSkipListRenMov: TDictionary; //Массив id потоков, для которых операции получения листинга должны быть пропущены (при копировании/перемещении) + ThreadCanAbortRenMov: TDictionary; //Массив id потоков, для которых в операциях получения листинга должен быть выведен дополнительный диалог прогресса с возможностью отмены операции (fix issue #113) + ThreadListingAborted: TDictionary; //Массив id потоков, для которых в операциях получения листинга была нажата отмена + + ThreadRetryCountDownload: TDictionary; //массив [id потока => количество попыток] для подсчёта количества повторов скачивания файла + ThreadRetryCountUpload: TDictionary; //массив [id потока => количество попыток] для подсчёта количества повторов закачивания файла + ThreadRetryCountRenMov: TDictionary; //массив [id потока => количество попыток] для подсчёта количества повторов межсерверных операций с файлом + ThreadBackgroundJobs: TDictionary; //массив [account root => количество потоков] для хранения количества текущих фоновых задач (предохраняемся от удаления объектов, которые могут быть использованы потоками) + ThreadBackgroundThreads: TDictionary; //массив [id потока => статус операции] для хранения текущих фоновых потоков (предохраняемся от завершения работы плагина при закрытии TC) + ThreadFsStatusInfo: TDictionary; //массив [id потока => текущая операция] для хранения контекста выполняемой операции (применяем для отлова перемещений каталогов) + ThreadFsRemoveDirSkippedPath: TDictionary; //массив [id потока => путь] для хранения путей, пропускаемых при перемещении (см. issue #168). + + PluginNum: Integer; + + SettingsManager: TPluginSettingsManager; + AccountSettings: TAccountsManager; + Accounts: TWSList; + + CurrentListing: TCMRDirItemList; + CurrentIncomingInvitesListing: TCMRIncomingInviteList; + ConnectionManager: TConnectionManager; + CurrentDescriptions: TDescription; + PasswordManager: TTCPasswordManager; + TCLogger: TTCLogger; + TCProgress: TTCProgress; + TCRequest: TTCRequest; + protected + function FindListingItemByPath(CurrentListing: TCMRDirItemList; Path: TRealPath; UpdateListing: Boolean = true): TCMRDirItem; + function FindIncomingInviteItemByPath(InviteListing: TCMRIncomingInviteList; Path: TRealPath): TCMRIncomingInvite; + function DeleteLocalFile(LocalName: WideString): Integer; + function ExecTrashbinProperties(MainWin: THandle; RealPath: TRealPath): Integer; + function ExecSharedAction(MainWin: THandle; RealPath: TRealPath; RemoteName: PWideChar; ActionOpen: Boolean = true): Integer; + function ExecInvitesAction(MainWin: THandle; RealPath: TRealPath): Integer; + function ExecProperties(MainWin: THandle; RealPath: TRealPath): Integer; + function ExecCommand(RemoteName: PWideChar; Command: WideString; Parameter: WideString = ''): Integer; + function ExecuteFileStream(RealPath: TRealPath; StreamingSettings: TStreamingSettings): Integer; + procedure UpdateFileDescription(RemotePath: TRealPath; LocalFilePath: WideString; var Cloud: TCloudMailRu); + procedure UpdateRemoteFileDescription(RemotePath: TRealPath; LocalFilePath: WideString; var Cloud: TCloudMailRu); + procedure RenameRemoteFileDescription(OldRemotePath, NewRemotePath: TRealPath; var Cloud: TCloudMailRu); + procedure DeleteRemoteFileDescription(RemotePath: TRealPath; var Cloud: TCloudMailRu); + function GetRemoteFile(RemotePath: TRealPath; LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; + function PutRemoteFile(RemotePath: TRealPath; LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; + function CloneWeblink(NewCloud, OldCloud: TCloudMailRu; CloudPath: WideString; CurrentItem: TCMRDirItem; NeedUnpublish: Boolean): Integer; + function RenMoveFileViaHash(OldCloud, NewCloud: TCloudMailRu; OldRealPath, NewRealPath: TRealPath; Move, OverWrite: Boolean): Integer; + function RenMoveFileViaPublicLink(OldCloud, NewCloud: TCloudMailRu; OldRealPath, NewRealPath: TRealPath; Move, OverWrite: Boolean): Integer; + public + constructor Create(); + destructor Destroy; override; + {Initialization methods} + function FsInit(PluginNr: Integer; pProgressProc: TProgressProcW; pLogProc: TLogProcW; pRequestProc: TRequestProcW): Integer; + procedure FsGetDefRootName(DefRootName: PAnsiChar; MaxLen: Integer); + procedure FsSetCryptCallback(PCryptProc: TCryptProcW; CryptoNr: Integer; Flags: Integer); + function FsGetBackgroundFlags: Integer; + {Mandatory filesystem methods} + function FsFindFirst(Path: WideString; var FindData: tWIN32FINDDATAW): THandle; + function FsFindNext(Hdl: THandle; var FindData: tWIN32FINDDATAW): Boolean; + function FsFindClose(Hdl: THandle): Integer; + {Optional filesystem methods} + procedure FsStatusInfo(RemoteDir: WideString; InfoStartEnd, InfoOperation: Integer); + function FsExecuteFile(MainWin: THandle; RemoteName, Verb: PWideChar): Integer; + function FsGetFile(RemoteName, LocalName: WideString; CopyFlags: Integer; RemoteInfo: pRemoteInfo): Integer; + function FsPutFile(LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; + function FsDeleteFile(RemoteName: WideString): Boolean; + function FsMkDir(Path: WideString): Boolean; + function FsRemoveDir(RemoteName: WideString): Boolean; + function FsRenMovFile(OldName: PWideChar; NewName: PWideChar; Move: Boolean; OverWrite: Boolean; ri: pRemoteInfo): Integer; + + function FsDisconnect(DisconnectRoot: PWideChar): Boolean; + + {Content methods} + function FsContentGetSupportedField(FieldIndex: Integer; FieldName: PAnsiChar; Units: PAnsiChar; MaxLen: Integer): Integer; + function FsContentGetValue(FileName: PWideChar; FieldIndex: Integer; UnitIndex: Integer; FieldValue: Pointer; MaxLen: Integer; Flags: Integer): Integer; + function FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags: Integer; var TheIcon: hIcon): Integer; + + end; + +implementation + +{TMailRuCloudWFX} + +function TMailRuCloudWFX.CloneWeblink(NewCloud, OldCloud: TCloudMailRu; CloudPath: WideString; CurrentItem: TCMRDirItem; NeedUnpublish: Boolean): Integer; +begin + Result := NewCloud.CloneWeblink(ExtractFileDir(CloudPath), CurrentItem.weblink, CLOUD_CONFLICT_STRICT); + if (NeedUnpublish) and (FS_FILE_USERABORT <> Result) and not(OldCloud.publishFile(CurrentItem.home, CurrentItem.weblink, CLOUD_UNPUBLISH)) then + TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, PREFIX_ERR_REMOVE_TEMP_PUBLIC_LINK + CurrentItem.home); +end; + +constructor TMailRuCloudWFX.Create(); +begin + + PluginPath := GetModuleName(hInstance); + PluginPath := IncludeTrailingBackslash(ExtractFilePath(PluginPath)); + + SettingsManager := TPluginSettingsManager.Create(); + + if SettingsManager.Settings.LoadSSLDLLOnlyFromPluginDir then + begin + if ((DirectoryExists(PluginPath + PlatformDllPath)) and (FileExists(PluginPath + PlatformDllPath + '\ssleay32.dll')) and (FileExists(PluginPath + PlatformDllPath + '\libeay32.dll'))) then + begin //try to load dll from platform subdir + IdOpenSSLSetLibPath(PluginPath + PlatformDllPath); + end else if ((FileExists(GetUNCFilePath(PluginPath + 'ssleay32.dll'))) and (FileExists(GetUNCFilePath(PluginPath + 'libeay32.dll')))) then + begin //else try to load it from plugin dir + IdOpenSSLSetLibPath(PluginPath); + end; + end; + + IsMultiThread := not(SettingsManager.Settings.DisableMultiThreading); + ThreadRetryCountDownload := TDictionary.Create; + ThreadRetryCountUpload := TDictionary.Create; + ThreadRetryCountRenMov := TDictionary.Create; + ThreadSkipListDelete := TDictionary.Create; + ThreadSkipListRenMov := TDictionary.Create; + ThreadCanAbortRenMov := TDictionary.Create; + ThreadListingAborted := TDictionary.Create; + ThreadBackgroundJobs := TDictionary.Create; + ThreadBackgroundThreads := TDictionary.Create; + ThreadFsStatusInfo := TDictionary.Create; + ThreadFsRemoveDirSkippedPath := TDictionary.Create; + + AccountSettings := TAccountsManager.Create(SettingsManager.AccountsIniFilePath); +end; + +function TMailRuCloudWFX.FsInit(PluginNr: Integer; pProgressProc: TProgressProcW; pLogProc: TLogProcW; pRequestProc: TRequestProcW): Integer; +begin + PluginNum := PluginNr; + TCLogger := TTCLogger.Create(pLogProc, PluginNr, SettingsManager.Settings.LogLevel); + TCProgress := TTCProgress.Create(pProgressProc, PluginNr); + TCRequest := TTCRequest.Create(pRequestProc, PluginNr); + CurrentDescriptions := TDescription.Create(GetTmpFileName('ion'), GetTCCommentPreferredFormat); + Result := 0; +end; + +function TMailRuCloudWFX.DeleteLocalFile(LocalName: WideString): Integer; +var + UNCLocalName: WideString; + DeleteFailOnUploadMode, DeleteFailOnUploadModeAsked: Integer; +begin + Result := FS_FILE_OK; + DeleteFailOnUploadModeAsked := IDRETRY; + UNCLocalName := GetUNCFilePath(LocalName); + + while (not DeleteFileW(PWideChar(UNCLocalName))) and (DeleteFailOnUploadModeAsked = IDRETRY) do + begin + DeleteFailOnUploadMode := SettingsManager.Settings.DeleteFailOnUploadMode; + if DeleteFailOnUploadMode = DeleteFailOnUploadAsk then + begin + DeleteFailOnUploadModeAsked := MsgBox(ERR_DELETE_FILE_ASK, [LocalName], ERR_DELETE_FILE, MB_ABORTRETRYIGNORE + MB_ICONQUESTION); + case DeleteFailOnUploadModeAsked of + IDRETRY: + continue; + IDABORT: + DeleteFailOnUploadMode := DeleteFailOnUploadAbort; + IDIGNORE: + DeleteFailOnUploadMode := DeleteFailOnUploadIgnore; + end; + end; + + case DeleteFailOnUploadMode of + DeleteFailOnUploadAbort: + begin + TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_ABORT, [LocalName]); + exit(FS_FILE_NOTSUPPORTED); + end; + DeleteFailOnUploadDeleteIgnore, DeleteFailOnUploadDeleteAbort: + begin + //check if file just have RO attr, then remove it. If user has lack of rights, then ignore or abort + if ((FileGetAttr(UNCLocalName) or faReadOnly) <> 0) and ((FileSetAttr(UNCLocalName, not faReadOnly) = 0) and (DeleteFileW(PWideChar(UNCLocalName)))) then + begin + TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_DELETE, [LocalName]); + exit(FS_FILE_OK); + end else begin + if SettingsManager.Settings.DeleteFailOnUploadMode = DeleteFailOnUploadDeleteIgnore then + begin + TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_IGNORE, [LocalName]); + exit(FS_FILE_OK); + end else begin + TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_ABORT, [LocalName]); + exit(FS_FILE_NOTSUPPORTED); + end; + end; + end; + else + begin + TCLogger.Log(LOG_LEVEL_DETAIL, MSGTYPE_IMPORTANTERROR, ERR_DELETE_FILE_IGNORE, [LocalName]); + end; + end; + end; +end; + +procedure TMailRuCloudWFX.DeleteRemoteFileDescription(RemotePath: TRealPath; var Cloud: TCloudMailRu); +var + RemoteDescriptions: TDescription; + RemoteIonPath, LocalTempPath: WideString; +begin + RemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(RemotePath.Path)) + SettingsManager.Settings.DescriptionFileName; + LocalTempPath := GetTmpFileName('ion'); + if not Cloud.getDescriptionFile(RemoteIonPath, LocalTempPath) then + exit; //описания нет, не заморачиваемся + RemoteDescriptions := TDescription.Create(LocalTempPath, GetTCCommentPreferredFormat); + RemoteDescriptions.Read; + RemoteDescriptions.DeleteValue(ExtractFileName(RemotePath.Path)); + RemoteDescriptions.Write(); + Cloud.deleteFile(RemoteIonPath); //Приходится удалять, потому что не знаем, как переписать + Cloud.putDesriptionFile(RemoteIonPath, RemoteDescriptions.ionFilename); + RemoteDescriptions.Destroy; +end; + +destructor TMailRuCloudWFX.Destroy; +begin + FreeAndNil(ThreadRetryCountDownload); + FreeAndNil(ThreadRetryCountUpload); + FreeAndNil(ThreadRetryCountRenMov); + FreeAndNil(ThreadSkipListDelete); + FreeAndNil(ThreadSkipListRenMov); + FreeAndNil(ThreadCanAbortRenMov); + FreeAndNil(ThreadListingAborted); + FreeAndNil(ThreadBackgroundJobs); + FreeAndNil(ThreadFsStatusInfo); + FreeAndNil(ThreadFsRemoveDirSkippedPath); + FreeAndNil(ThreadBackgroundThreads); + FreeAndNil(ConnectionManager); + + CurrentDescriptions.Free; + + SettingsManager.Free; + AccountSettings.Free; + PasswordManager.Free; + TCLogger.Free; + TCProgress.Free; + TCRequest.Free; + inherited; +end; + +function TMailRuCloudWFX.ExecCommand(RemoteName: PWideChar; Command, Parameter: WideString): Integer; +var + RealPath: TRealPath; + getResult: Integer; + Cloud: TCloudMailRu; + HashInfo: THashInfo; +begin + Result := FS_EXEC_OK; + + if Command = 'rmdir' then + begin + RealPath.FromPath(RemoteName + Parameter); + if (ConnectionManager.Get(RealPath.account, getResult).removeDir(RealPath.Path) <> true) then + exit(FS_EXEC_ERROR); + end; + + RealPath.FromPath(RemoteName); //default + Cloud := ConnectionManager.Get(RealPath.account, getResult); + + //undocumented, share current folder to email param + if Command = 'share' then + if not(Cloud.shareFolder(RealPath.Path, ExtractLinkFromUrl(Parameter), CLOUD_SHARE_RW)) then + exit(FS_EXEC_ERROR); + + if Command = 'hash' then //add file by hash & filesize + begin + HashInfo := THashInfo.Create(Parameter); + if HashInfo.valid then + begin + Cloud.addFileByIdentity(HashInfo.CloudFileIdentity, IncludeTrailingPathDelimiter(RealPath.Path) + HashInfo.name, CLOUD_CONFLICT_RENAME); + HashInfo.Destroy; + end else begin + TCLogger.Log(LOG_LEVEL_DEBUG, msgtype_details, ERR_CLONE_BY_HASH, [HashInfo.errorString, Parameter]); + HashInfo.Destroy; + exit(FS_EXEC_ERROR); + end; + end; + + if Command = 'clone' then //add file by weblink + begin + if (Cloud.CloneWeblink(RealPath.Path, ExtractLinkFromUrl(Parameter)) = CLOUD_OPERATION_OK) then + if SettingsManager.Settings.LogUserSpace then + Cloud.logUserSpaceInfo + else + exit(FS_EXEC_ERROR); + end; + + if Command = 'trash' then //go to current account trash directory + begin + if Cloud.public_account then + exit(FS_EXEC_ERROR); + if RealPath.IsInAccount(false) then + begin + strpcopy(RemoteName, '\' + RealPath.account + TrashPostfix); + exit(FS_EXEC_SYMLINK); + end; + end; + + if Command = 'shared' then + begin + if Cloud.public_account then + exit(FS_EXEC_ERROR); + if RealPath.IsInAccount(false) then + begin + strpcopy(RemoteName, '\' + RealPath.account + SharedPostfix); + exit(FS_EXEC_SYMLINK); + end; + end; + + if Command = 'invites' then + begin + if Cloud.public_account then + exit(FS_EXEC_ERROR); + if RealPath.IsInAccount(false) then + begin + strpcopy(RemoteName, '\' + RealPath.account + InvitesPostfix); + exit(FS_EXEC_SYMLINK); + end; + end; +end; + +function TMailRuCloudWFX.ExecInvitesAction(MainWin: THandle; RealPath: TRealPath): Integer; +var + Cloud: TCloudMailRu; + getResult: Integer; + CurrentInvite: TCMRIncomingInvite; +begin + Result := FS_EXEC_OK; + Cloud := ConnectionManager.Get(RealPath.account, getResult); + if RealPath.isInAccountsList then //main invites folder properties + begin + if TAccountsForm.ShowAccounts(MainWin, PasswordManager, RealPath.account) then + SettingsManager.Refresh; + end else begin //one invite item + CurrentInvite := FindIncomingInviteItemByPath(CurrentIncomingInvitesListing, RealPath); + if CurrentInvite.name = EmptyWideStr then + exit(FS_EXEC_ERROR); + + getResult := TInvitePropertyForm.ShowProperties(MainWin, CurrentInvite); + end; + case (getResult) of + mrAbort: + Cloud.unmountFolder(CurrentInvite.name, true); + mrClose: + Cloud.unmountFolder(CurrentInvite.name, false); + mrYes: + Cloud.mountFolder(CurrentInvite.name, CurrentInvite.invite_token); + mrNo: + Cloud.rejectInvite(CurrentInvite.invite_token); + + end; + + PostMessage(MainWin, WM_USER + 51, 540, 0); //TC does not update current panel, so we should do it this way +end; + +function TMailRuCloudWFX.ExecProperties(MainWin: THandle; RealPath: TRealPath): Integer; +var + Cloud: TCloudMailRu; + CurrentItem: TCMRDirItem; + getResult: Integer; +begin + Result := FS_EXEC_OK; + if RealPath.isInAccountsList then + begin + if TAccountsForm.ShowAccounts(MainWin, PasswordManager, RealPath.account) then //show account properties + SettingsManager.Refresh; + end else begin + Cloud := ConnectionManager.Get(RealPath.account, getResult); + //всегда нужно обновлять статус на сервере, CurrentListing может быть изменён в другой панели + if (Cloud.statusFile(RealPath.Path, CurrentItem)) and (idContinue = TPropertyForm.ShowProperty(MainWin, RealPath.Path, CurrentItem, Cloud, SettingsManager.Settings.DownloadLinksEncode, SettingsManager.Settings.AutoUpdateDownloadListing, SettingsManager.Settings.DescriptionEnabled, SettingsManager.Settings.DescriptionEditorEnabled, SettingsManager.Settings.DescriptionFileName)) then + PostMessage(MainWin, WM_USER + 51, 540, 0); //refresh tc panel if description edited + end; +end; + +function TMailRuCloudWFX.ExecSharedAction(MainWin: THandle; RealPath: TRealPath; RemoteName: PWideChar; ActionOpen: Boolean): Integer; +var + Cloud: TCloudMailRu; + CurrentItem: TCMRDirItem; + getResult: Integer; +begin + Result := FS_EXEC_OK; + if ActionOpen then //open item, i.e. treat it as symlink to original location + begin + CurrentItem := FindListingItemByPath(CurrentListing, RealPath); + if CurrentItem.type_ = TYPE_FILE then + strpcopy(RemoteName, '\' + RealPath.account + ExtractFilePath(UrlToPath(CurrentItem.home))) + else + strpcopy(RemoteName, '\' + RealPath.account + UrlToPath(CurrentItem.home)); + Result := FS_EXEC_SYMLINK; + end else begin + if RealPath.isInAccountsList then + begin + if TAccountsForm.ShowAccounts(MainWin, PasswordManager, RealPath.account) then //main shared folder properties - open connection settings + SettingsManager.Refresh; + end else begin + Cloud := ConnectionManager.Get(RealPath.account, getResult); + CurrentItem := FindListingItemByPath(CurrentListing, RealPath); + if Cloud.statusFile(CurrentItem.home, CurrentItem) then + TPropertyForm.ShowProperty(MainWin, RealPath.Path, CurrentItem, Cloud, SettingsManager.Settings.DownloadLinksEncode, SettingsManager.Settings.AutoUpdateDownloadListing, false, false, SettingsManager.Settings.DescriptionFileName) + end; + end; +end; + +function TMailRuCloudWFX.ExecTrashbinProperties(MainWin: THandle; RealPath: TRealPath): Integer; +var + Cloud: TCloudMailRu; + getResult: Integer; + CurrentItem: TCMRDirItem; +begin + Result := FS_EXEC_OK; + Cloud := ConnectionManager.Get(RealPath.account, getResult); + if RealPath.isInAccountsList then //main trashbin folder properties + begin + if not Cloud.getTrashbinListing(CurrentListing) then + exit(FS_EXEC_ERROR); + getResult := TDeletedPropertyForm.ShowProperties(MainWin, CurrentListing, true, RealPath.account); + end else begin //one item in trashbin + CurrentItem := FindListingItemByPath(CurrentListing, RealPath); //для одинаково именованных файлов в корзине будут показываться свойства первого, сорян + getResult := TDeletedPropertyForm.ShowProperties(MainWin, [CurrentItem]); + end; + case (getResult) of + mrNo: + if not Cloud.trashbinEmpty then + exit(FS_EXEC_ERROR); + mrYes: + if not Cloud.trashbinRestore(CurrentItem.deleted_from + CurrentItem.name, CurrentItem.rev) then + exit(FS_EXEC_ERROR); + mrYesToAll: + for CurrentItem in CurrentListing do + if not Cloud.trashbinRestore(CurrentItem.deleted_from + CurrentItem.name, CurrentItem.rev) then + exit(FS_EXEC_ERROR); + end; + + PostMessage(MainWin, WM_USER + 51, 540, 0); //TC does not update current panel, so we should do it this way +end; + +function TMailRuCloudWFX.ExecuteFileStream(RealPath: TRealPath; StreamingSettings: TStreamingSettings): Integer; +var + StreamUrl: WideString; + getResult: Integer; + CurrentCloud, TempPublicCloud: TCloudMailRu; + CurrentItem: TCMRDirItem; +begin + Result := FS_EXEC_OK; + if (STREAMING_FORMAT_DISABLED = StreamingSettings.Format) or (STREAMING_FORMAT_UNSET = StreamingSettings.Format) then + exit; + + //может быть разница в атрибутах настоящих и полученных из листинга (они не рефрешатся) + CurrentItem := FindListingItemByPath(CurrentListing, RealPath); //внутри публичного облака веблинк есть автоматически + + if TCloudMailRu.TempPublicCloudInit(TempPublicCloud, PUBLIC_ACCESS_URL + CurrentItem.weblink) then + begin + if STREAMING_FORMAT_PLAYLIST = StreamingSettings.Format then + begin + if not TempPublicCloud.getPublishedFileStreamUrl(CurrentItem, StreamUrl) then + Result := FS_EXEC_ERROR; + end else begin + if not CurrentItem.isPublished then + begin + CurrentCloud := ConnectionManager.Get(RealPath.account, getResult); + if not CurrentCloud.publishFile(CurrentItem.home, CurrentItem.weblink) then + Result := FS_EXEC_ERROR; + //Здесь можно бы обновить листинг + end; + if FS_EXEC_OK = Result then + StreamUrl := TempPublicCloud.getSharedFileUrl(EmptyWideStr, ShardTypeFromStreamingFormat(StreamingSettings.Format)); + end; + + if FS_EXEC_OK = Result then + begin + if EmptyWideStr = StreamingSettings.Parameters then + StreamingSettings.Parameters := '%url%'; + StreamingSettings.Parameters := StringReplace(StreamingSettings.Parameters, '%url%', StreamUrl, [rfReplaceAll, rfIgnoreCase]); + + if not(Run(StreamingSettings.Command, StreamUrl, StreamingSettings.StartPath)) then + Result := FS_EXEC_ERROR; + end; + + end; + + FreeAndNil(TempPublicCloud); +end; + +function TMailRuCloudWFX.FindIncomingInviteItemByPath(InviteListing: TCMRIncomingInviteList; Path: TRealPath): TCMRIncomingInvite; +var + getResult: Integer; +begin + Result := InviteListing.FindByName(Path.Path); + {item not found in current global listing, so refresh it} + if Result.isNone then + if ConnectionManager.Get(Path.account, getResult).getIncomingLinksListing(CurrentIncomingInvitesListing) then + exit(CurrentIncomingInvitesListing.FindByName(Path.Path)); +end; + +function TMailRuCloudWFX.FindListingItemByPath(CurrentListing: TCMRDirItemList; Path: TRealPath; UpdateListing: Boolean): TCMRDirItem; +var + getResult: Integer; + CurrentCloud: TCloudMailRu; +begin + CurrentCloud := ConnectionManager.Get(Path.account, getResult); + if not Assigned(CurrentCloud) then + exit; + + if Path.HasHomePath and not CurrentCloud.public_account then + Result := CurrentListing.FindByHomePath(Path.Path) //сначала попробуем найти поле в имеющемся списке + else + Result := CurrentListing.FindByName(ExtractUniversalFileName(Path.Path)); + + if Result.isNone and UpdateListing then //если там его нет (нажали пробел на папке, например), то запросим в облаке напрямую, в зависимости от того, внутри чего мы находимся + begin + + if Path.trashDir then //корзина - обновим CurrentListing, поищем в нём + begin + if CurrentCloud.getTrashbinListing(CurrentListing) then + exit(CurrentListing.FindByName(Path.Path)); + end; + if Path.sharedDir then //ссылки - обновим список + begin + if CurrentCloud.getSharedLinksListing(CurrentListing) then + exit(CurrentListing.FindByName(Path.Path)); + end; + if Path.invitesDir then + begin + //FindIncomingInviteItemByPath in that case! + end; + if CurrentCloud.statusFile(Path.Path, Result) then //Обычный каталог + begin + if (Result.home = EmptyWideStr) and not CurrentCloud.public_account then + TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_WHERE_IS_THE_FILE, [Path.Path]); {Такого быть не может, но...} + end; + end; //Не рапортуем, это будет уровнем выше +end; + +function TMailRuCloudWFX.FsContentGetSupportedField(FieldIndex: Integer; FieldName, Units: PAnsiChar; MaxLen: Integer): Integer; +begin + Result := ft_nomorefields; + case FieldIndex of + 0: + begin + System.AnsiStrings.strpcopy(FieldName, 'tree'); + Result := ft_stringw; + end; + 1: + begin + System.AnsiStrings.strpcopy(FieldName, 'name'); + Result := ft_stringw; + end; + 2: + begin + System.AnsiStrings.strpcopy(FieldName, 'grev'); + Result := ft_numeric_32; + end; + 3: + begin + System.AnsiStrings.strpcopy(FieldName, 'size'); + Result := ft_numeric_64; + end; + 4: + begin + System.AnsiStrings.strpcopy(FieldName, 'kind'); + Result := ft_stringw; + end; + 5: + begin + System.AnsiStrings.strpcopy(FieldName, 'weblink'); + Result := ft_stringw; + end; + 6: + begin + System.AnsiStrings.strpcopy(FieldName, 'rev'); + Result := ft_numeric_32; + end; + 7: + begin + System.AnsiStrings.strpcopy(FieldName, 'type'); + Result := ft_stringw; + end; + 8: + begin + System.AnsiStrings.strpcopy(FieldName, 'home'); + Result := ft_stringw; + end; + 9: + begin + System.AnsiStrings.strpcopy(FieldName, 'mtime'); + Result := ft_datetime; + end; + 10: + begin + System.AnsiStrings.strpcopy(FieldName, 'hash'); + Result := ft_stringw; + end; + 11: + begin + System.AnsiStrings.strpcopy(FieldName, 'virus_scan'); + Result := ft_stringw; + end; + 12: + begin + System.AnsiStrings.strpcopy(FieldName, 'folders_count'); + Result := ft_numeric_32; + end; + 13: + begin + System.AnsiStrings.strpcopy(FieldName, 'files_count'); + Result := ft_numeric_32; + end; + 14: + begin + System.AnsiStrings.strpcopy(FieldName, 'description'); + Result := ft_stringw; + end; + 15: + begin + System.AnsiStrings.strpcopy(FieldName, 'deleted_at'); + Result := ft_datetime; + end; + 16: + begin + System.AnsiStrings.strpcopy(FieldName, 'deleted_from'); + Result := ft_stringw; + end; + 17: + begin + System.AnsiStrings.strpcopy(FieldName, 'deleted_by'); + Result := ft_stringw; + end; + end; +end; + +function TMailRuCloudWFX.FsContentGetValue(FileName: PWideChar; FieldIndex, UnitIndex: Integer; FieldValue: Pointer; MaxLen, Flags: Integer): Integer; +var + Item: TCMRDirItem; + RealPath: TRealPath; + FileTime: TFileTime; +begin + Result := ft_nosuchfield; + RealPath.FromPath(FileName); + if RealPath.isInAccountsList then begin + if FieldIndex = 14 then begin + strpcopy(FieldValue, AccountSettings.GetAccountSettings(RealPath.account).Description); + exit(ft_stringw); + end + else + exit(ft_nosuchfield); + end; + + Item := FindListingItemByPath(CurrentListing, RealPath, not RealPath.invitesDir); + //if Item.home = '' then exit(ft_nosuchfield); + + case FieldIndex of + 0: begin + if Item.mtime <> 0 then + exit(ft_nosuchfield); + strpcopy(FieldValue, Item.tree); + Result := ft_stringw; + end; + 1: begin + strpcopy(FieldValue, Item.name); + Result := ft_stringw; + end; + 2: begin + if Item.mtime <> 0 then + exit(ft_nosuchfield); + Move(Item.grev, FieldValue^, sizeof(Item.grev)); + Result := ft_numeric_32; + end; + 3: begin + Move(Item.size, FieldValue^, sizeof(Item.size)); + Result := ft_numeric_64; + end; + 4: begin + strpcopy(FieldValue, Item.kind); + Result := ft_stringw; + end; + 5: begin + strpcopy(FieldValue, Item.weblink); + Result := ft_stringw; + end; + 6: begin + if Item.mtime <> 0 then + exit(ft_nosuchfield); + Move(Item.rev, FieldValue^, sizeof(Item.rev)); + Result := ft_numeric_32; + end; + 7: begin + strpcopy(FieldValue, Item.type_); + Result := ft_stringw; + end; + 8: begin + strpcopy(FieldValue, Item.home); + Result := ft_stringw; + end; + 9: begin + if Item.mtime = 0 then + exit(ft_nosuchfield); + FileTime.dwHighDateTime := 0; + FileTime.dwLowDateTime := 0; + FileTime := DateTimeToFileTime(UnixToDateTime(Item.mtime)); + Move(FileTime, FieldValue^, sizeof(FileTime)); + Result := ft_datetime; + end; + 10: begin + strpcopy(FieldValue, Item.hash); + Result := ft_stringw; + end; + 11: begin + strpcopy(FieldValue, Item.virus_scan); + Result := ft_stringw; + end; + 12: begin + if Item.type_ = TYPE_FILE then + exit(ft_nosuchfield); + Move(Item.folders_count, FieldValue^, sizeof(Item.folders_count)); + Result := ft_numeric_32; + end; + 13: begin + if Item.type_ = TYPE_FILE then + exit(ft_nosuchfield); + Move(Item.files_count, FieldValue^, sizeof(Item.files_count)); + Result := ft_numeric_32; + end; + 14: begin + //При включённой сортировке Запрос происходит при появлении в списке + if SettingsManager.Settings.DescriptionEnabled then begin + strpcopy(FieldValue, CurrentDescriptions.GetValue(Item.name)); + end else begin + strpcopy(FieldValue, ''); + end; + Result := ft_stringw; + end; + 15: begin + if Item.deleted_at = 0 then + exit(ft_nosuchfield); + FileTime.dwHighDateTime := 0; + FileTime.dwLowDateTime := 0; + FileTime := DateTimeToFileTime(UnixToDateTime(Item.deleted_at)); + Move(FileTime, FieldValue^, sizeof(FileTime)); + Result := ft_datetime; + end; + 16: begin + if Item.deleted_from = EmptyWideStr then + exit(ft_nosuchfield); + strpcopy(FieldValue, Item.deleted_from); + Result := ft_stringw; + end; + 17: begin + if Item.deleted_by = 0 then + exit(ft_nosuchfield); + strpcopy(FieldValue, Item.deleted_by.ToString); //display user id as is, because no conversation api method performed + Result := ft_stringw; + end; + end; +end; + +function TMailRuCloudWFX.FsDeleteFile(RemoteName: WideString): Boolean; +var + RealPath: TRealPath; + getResult: Integer; + CurrentItem: TCMRDirItem; + Cloud: TCloudMailRu; + InvitesListing: TCMRInviteList; + Invite: TCMRInvite; +begin + RealPath.FromPath(WideString(RemoteName)); + if RealPath.isAccountEmpty or RealPath.trashDir or RealPath.invitesDir then + exit(false); + Cloud := ConnectionManager.Get(RealPath.account, getResult); + if RealPath.sharedDir then begin + CurrentItem := FindListingItemByPath(CurrentListing, RealPath); + Cloud.getShareInfo(CurrentItem.home, InvitesListing); + for Invite in InvitesListing do + Cloud.shareFolder(CurrentItem.home, Invite.email, CLOUD_SHARE_NO); //no reporting here + if CurrentItem.isPublished then + Cloud.publishFile(CurrentItem.home, CurrentItem.weblink, CLOUD_UNPUBLISH); + Result := true; + end + else + Result := Cloud.deleteFile(RealPath.Path); + if (Result and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RealPath.account).IsRemoteDescriptionsSupported) then + DeleteRemoteFileDescription(RealPath, Cloud); +end; + +function TMailRuCloudWFX.FsDisconnect(DisconnectRoot: PWideChar): Boolean; +var + BackgroundJobsCount: Integer; +begin + BackgroundJobsCount := 0; + if ((not ThreadBackgroundJobs.TryGetValue(ExtractFileName(DisconnectRoot), BackgroundJobsCount)) or (BackgroundJobsCount = 0)) then begin + ConnectionManager.Free(ExtractFileName(DisconnectRoot)); + Result := true; + end else begin //здесь можно добавить механизм ожидания завершения фоновой операции + Result := false; + end; +end; + +function TMailRuCloudWFX.FsExecuteFile(MainWin: THandle; RemoteName, Verb: PWideChar): Integer; +var + RealPath: TRealPath; +begin + RealPath.FromPath(RemoteName); + + if RealPath.upDirItem then + RealPath.Path := ExtractFilePath(RealPath.Path); //if somepath/.. item properties called + + if RealPath.trashDir and ((Verb = VERB_OPEN) or (Verb = VERB_PROPERTIES)) then + exit(ExecTrashbinProperties(MainWin, RealPath)); + + if RealPath.sharedDir then + exit(ExecSharedAction(MainWin, RealPath, RemoteName, Verb = VERB_OPEN)); + + if RealPath.invitesDir then + exit(ExecInvitesAction(MainWin, RealPath)); + + if Verb = VERB_PROPERTIES then + exit(ExecProperties(MainWin, RealPath)); + + if Verb = VERB_OPEN then begin + if (not(RealPath.isDir = ID_True)) then + exit(ExecuteFileStream(RealPath, SettingsManager.GetStreamingSettings(RealPath.Path))) + else + exit(FS_EXEC_YOURSELF); + end; + + if copy(Verb, 1, 5) = VERB_QUOTE then + exit(ExecCommand(RemoteName, LowerCase(GetWord(Verb, 1)), GetWord(Verb, 2))); + + //if copy(Verb, 1, 5) = 'chmod' then exit; //future usage + exit(FS_EXEC_OK) +end; + +function TMailRuCloudWFX.FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags: Integer; var TheIcon: hIcon): Integer; +var + RealPath: TRealPath; + Item: TCMRDirItem; + IconsMode: Integer; + CurrentInviteItem: TCMRIncomingInvite; + IconsSize: Integer; + FrontIcon, BackIcon: hIcon; + + function GetFolderIconSize(IconsSize: Integer): Integer; + begin + if IconsSize <= 16 then + exit(IconSizeSmall); + if IconsSize <= 32 then + exit(IconSizeNormal); + exit(IconSizeLarge); + end; + + procedure CombineMacro(var CombinedIcon: hIcon); + begin + FrontIcon := LoadImageW(hInstance, RemoteName, IMAGE_ICON, IconsSize, IconsSize, LR_DEFAULTCOLOR); + BackIcon := GetFolderIcon(GetFolderIconSize(IconsSize)); + CombinedIcon := CombineIcons(FrontIcon, BackIcon); + DeleteObject(FrontIcon); + DeleteObject(BackIcon); + end; + +begin + Result := FS_ICON_EXTRACTED; + + RealPath.FromPath(RemoteName); + + if RealPath.upDirItem then + exit; //do not overlap updir icon + + IconsMode := SettingsManager.Settings.IconsMode; + IconsSize := GetTCIconsSize; + + if RealPath.trashDir and RealPath.isInAccountsList then //always draw system trash icon + begin + strpcopy(RemoteName, 'cloud_trash'); + TheIcon := GetSystemIcon(GetFolderIconSize(IconsSize)); + exit(FS_ICON_EXTRACTED_DESTROY); + end; + + if RealPath.sharedDir then begin + if RealPath.isInAccountsList then begin + strpcopy(RemoteName, 'shared'); + CombineMacro(TheIcon); + + exit(FS_ICON_EXTRACTED_DESTROY); + end else begin + if IconsMode = IconsModeDisabled then + IconsMode := IconsModeInternalOverlay; //always draw icons in shared links directory + end; + end; + + if RealPath.invitesDir then begin + if RealPath.isInAccountsList then begin + strpcopy(RemoteName, 'shared_incoming'); + CombineMacro(TheIcon); + exit(FS_ICON_EXTRACTED_DESTROY); + end else begin + + CurrentInviteItem := FindIncomingInviteItemByPath(CurrentIncomingInvitesListing, RealPath); + if CurrentInviteItem.name = EmptyWideStr then + exit(FS_ICON_USEDEFAULT); + + if CurrentInviteItem.isMounted then //mounted item + begin + strpcopy(RemoteName, 'shared_incoming'); + CombineMacro(TheIcon); + end else begin + strpcopy(RemoteName, 'shared'); + CombineMacro(TheIcon); + end; + exit(FS_ICON_EXTRACTED_DESTROY); + + end; + end; + + if IconsMode = IconsModeDisabled then + exit(FS_ICON_USEDEFAULT); + + if RealPath.isInAccountsList then //connection list + begin + if AccountSettings.GetAccountSettings(copy(RemoteName, 2, StrLen(RemoteName) - 2)).PublicAccount then + strpcopy(RemoteName, 'cloud_public') + else + strpcopy(RemoteName, 'cloud'); + end else begin //directories + Item := FindListingItemByPath(CurrentListing, RealPath); + if (Item.type_ = TYPE_DIR) or (Item.kind = KIND_SHARED) then begin + if Item.kind = KIND_SHARED then + strpcopy(RemoteName, 'shared') + else if Item.isPublished then + strpcopy(RemoteName, 'shared_public') + else + exit(FS_ICON_USEDEFAULT); + end + else + exit(FS_ICON_USEDEFAULT); + end; + case IconsMode of + IconsModeInternal: + TheIcon := LoadImageW(hInstance, RemoteName, IMAGE_ICON, IconsSize, IconsSize, LR_DEFAULTCOLOR); + IconsModeInternalOverlay: + CombineMacro(TheIcon); + IconsModeExternal: begin + TheIcon := LoadPluginIcon(PluginPath + 'icons', RemoteName); + if TheIcon = INVALID_HANDLE_VALUE then + exit(FS_ICON_USEDEFAULT); + exit(FS_ICON_EXTRACTED_DESTROY); + end; + IconsModeExternalOverlay: begin + TheIcon := LoadPluginIcon(PluginPath + 'icons', RemoteName); + if TheIcon = INVALID_HANDLE_VALUE then + exit(FS_ICON_USEDEFAULT); + BackIcon := GetFolderIcon(GetFolderIconSize(IconsSize)); + TheIcon := CombineIcons(TheIcon, BackIcon); + DeleteObject(BackIcon); + exit(FS_ICON_EXTRACTED_DESTROY); + end; + + end; +end; + +function TMailRuCloudWFX.FsFindClose(Hdl: THandle): Integer; +begin + FileCounter := 0; + Result := 0; +end; + +function TMailRuCloudWFX.FsFindFirst(Path: WideString; var FindData: tWIN32FINDDATAW): THandle; +var //Получение первого файла в папке. Result тоталом не используется (можно использовать для работы плагина). + RealPath: TRealPath; + getResult: Integer; + SkipListDelete, SkipListRenMov, CanAbortRenMov, RenMovAborted: Boolean; + CurrentItem: TCMRDirItem; + CurrentCloud: TCloudMailRu; +begin + ThreadSkipListDelete.TryGetValue(GetCurrentThreadID(), SkipListDelete); + ThreadSkipListRenMov.TryGetValue(GetCurrentThreadID(), SkipListRenMov); + + ThreadCanAbortRenMov.TryGetValue(GetCurrentThreadID(), CanAbortRenMov); + + if (CanAbortRenMov and TCProgress.Progress(Path)) then begin + ThreadListingAborted.AddOrSetValue(GetCurrentThreadID(), true); + RenMovAborted := true; + end + else + RenMovAborted := false; + + if SkipListDelete or SkipListRenMov or RenMovAborted then begin + SetLastError(ERROR_NO_MORE_FILES); + exit(INVALID_HANDLE_VALUE); + end; + + //Result := FIND_NO_MORE_FILES; + GlobalPath := Path; + if GlobalPath = '\' then begin //список соединений + Accounts := AccountSettings.GetAccountsList([ATPrivate, ATPublic], SettingsManager.Settings.EnabledVirtualTypes); + if (Accounts.Count > 0) then begin + FindData := GetFindDataEmptyDir(Accounts[0]); + FileCounter := 1; + Result := FIND_ROOT_DIRECTORY; + end else begin + Result := INVALID_HANDLE_VALUE; //Нельзя использовать exit + SetLastError(ERROR_NO_MORE_FILES); + end; + end else begin + RealPath.FromPath(GlobalPath); + CurrentCloud := ConnectionManager.Get(RealPath.account, getResult); + + if getResult <> CLOUD_OPERATION_OK then begin + SetLastError(ERROR_ACCESS_DENIED); + exit(INVALID_HANDLE_VALUE); + end; + + if not Assigned(CurrentCloud) then begin + SetLastError(ERROR_PATH_NOT_FOUND); + exit(INVALID_HANDLE_VALUE); + end; + + if RealPath.trashDir then begin + if not CurrentCloud.getTrashbinListing(CurrentListing) then + SetLastError(ERROR_PATH_NOT_FOUND); + end else if RealPath.sharedDir then begin + if not CurrentCloud.getSharedLinksListing(CurrentListing) then + SetLastError(ERROR_PATH_NOT_FOUND); //that will be interpreted as symlinks later + end else if RealPath.invitesDir then begin + if not CurrentCloud.getIncomingLinksListing(CurrentListing, CurrentIncomingInvitesListing) then + SetLastError(ERROR_PATH_NOT_FOUND); //одновременно получаем оба листинга, чтобы не перечитывать листинг инватов на каждый чих + end else begin //Нужно проверить, является ли открываемый объект каталогом - для файлов API вернёт листинг вышестоящего каталога, см. issue #174 + if not CurrentCloud.getDirListing(RealPath.Path, CurrentListing) then + SetLastError(ERROR_PATH_NOT_FOUND); + end; + + if RealPath.isVirtual and not RealPath.isInAccountsList then //игнорим попытки получить листинги объектов вирутальных каталогов + begin + SetLastError(ERROR_ACCESS_DENIED); + exit(INVALID_HANDLE_VALUE); + end; + + if CurrentCloud.public_account then + CurrentItem := CurrentListing.FindByName(ExtractUniversalFileName(RealPath.Path)) + else + CurrentItem := CurrentListing.FindByHomePath(RealPath.Path); + + if not(CurrentItem.isNone or CurrentItem.isDir) then begin + SetLastError(ERROR_PATH_NOT_FOUND); + exit(INVALID_HANDLE_VALUE); + end; + + if (Length(CurrentListing) = 0) then begin + FindData := GetFindDataEmptyDir(); //воркароунд бага с невозможностью входа в пустой каталог, см. http://www.ghisler.ch/board/viewtopic.php?t=42399 + Result := FIND_NO_MORE_FILES; + SetLastError(ERROR_NO_MORE_FILES); + end else begin + + FindData := CurrentListing[0].ToFindData(RealPath.sharedDir); //folders inside shared links directory must be displayed as symlinks + FileCounter := 1; + if RealPath.sharedDir then + Result := FIND_SHARED_LINKS + else + Result := FIND_OK; + end; + end; +end; + +function TMailRuCloudWFX.FsFindNext(Hdl: THandle; var FindData: tWIN32FINDDATAW): Boolean; +begin + if GlobalPath = '\' then begin + if (Accounts.Count > FileCounter) then begin + FindData := GetFindDataEmptyDir(Accounts[FileCounter]); + inc(FileCounter); + Result := true; + end + else + Result := false; + + end else begin + //Получение последующих файлов в папке (вызывается до тех пор, пока не вернёт false). + if (Length(CurrentListing) > FileCounter) then begin + FindData := CurrentListing[FileCounter].ToFindData(Hdl = FIND_SHARED_LINKS); + Result := true; + inc(FileCounter); + end else begin + FillChar(FindData, sizeof(WIN32_FIND_DATA), 0); + FileCounter := 0; + Result := false; + end; + end; +end; + +function TMailRuCloudWFX.FsGetBackgroundFlags: Integer; +begin + if SettingsManager.Settings.DisableMultiThreading then + Result := 0 + else + Result := BG_DOWNLOAD + BG_UPLOAD; //+ BG_ASK_USER; +end; + +procedure TMailRuCloudWFX.FsGetDefRootName(DefRootName: PAnsiChar; MaxLen: Integer); +begin + +end; + +function TMailRuCloudWFX.FsGetFile(RemoteName, LocalName: WideString; CopyFlags: Integer; RemoteInfo: pRemoteInfo): Integer; +var + RealPath: TRealPath; + OverwriteLocalMode: Integer; + RetryAttempts: Integer; +begin + Result := FS_FILE_NOTSUPPORTED; + if CheckFlag(FS_COPYFLAGS_RESUME, CopyFlags) then + exit; {NEVER CALLED HERE} + RealPath.FromPath(RemoteName); + if RealPath.isVirtual then + exit; + + TCProgress.Progress(RemoteName, LocalName, 0); + + OverwriteLocalMode := SettingsManager.Settings.OverwriteLocalMode; + if (FileExists(GetUNCFilePath(LocalName)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags))) then begin + case OverwriteLocalMode of + OverwriteLocalModeAsk: + exit(FS_FILE_EXISTS); //TC will ask user + OverwriteLocalModeIgnore: begin + TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, FILE_EXISTS_IGNORE, [LocalName]); + exit(FS_FILE_OK); + end; + OverwriteLocalModeOverwrite: + TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, FILE_EXISTS_OVERWRITE, [LocalName]); + end; + end; + + Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); + + if Result <> FS_FILE_READERROR then + exit; + + case SettingsManager.Settings.OperationErrorMode of + OperationErrorModeAsk: begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + case (MsgBox(ERR_DOWNLOAD_FILE_ASK, [RemoteName], ERR_DOWNLOAD, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of + ID_ABORT: + Result := FS_FILE_USERABORT; + ID_RETRY: + Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); + ID_IGNORE: + break; + end; + end; + + end; + OperationErrorModeIgnore: + exit; + OperationErrorModeAbort: + exit(FS_FILE_USERABORT); + OperationErrorModeRetry: begin; + RetryAttempts := SettingsManager.Settings.RetryAttempts; + while (ThreadRetryCountDownload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + ThreadRetryCountDownload.Items[GetCurrentThreadID()] := ThreadRetryCountDownload.Items[GetCurrentThreadID()] + 1; + TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, DOWNLOAD_FILE_RETRY, [RemoteName, ThreadRetryCountDownload.Items[GetCurrentThreadID()], RetryAttempts]); + Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); + if TCProgress.Progress(PWideChar(LocalName), RemoteName, 0) then + Result := FS_FILE_USERABORT; + if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then + ThreadRetryCountDownload.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток + ProcessMessages; + Sleep(SettingsManager.Settings.AttemptWait); + end; + end; + end; +end; + +function TMailRuCloudWFX.FsMkDir(Path: WideString): Boolean; +var + RealPath: TRealPath; + getResult: Integer; + SkipListRenMov: Boolean; + OperationContextId: Integer; + RegisteredAccount: TAccountSettings; +begin + ThreadSkipListRenMov.TryGetValue(GetCurrentThreadID(), SkipListRenMov); + if SkipListRenMov then + exit(false); //skip create directory if this flag set on + + RealPath.FromPath(WideString(Path)); + if RealPath.isInAccountsList then //accounts list + begin + RegisteredAccount := AccountSettings.GetAccountSettings(RealPath.account); + + Result := (mrOk = TRegistrationForm.ShowRegistration(FindTCWindow, SettingsManager.Settings.ConnectionSettings, RegisteredAccount)); + if Result then begin + if RegisteredAccount.UseTCPasswordManager then //просим TC сохранить пароль + Result := FS_FILE_OK = PasswordManager.SetPassword(RealPath.account, RegisteredAccount.password); + if Result then + AccountSettings.SetAccountSettings(RealPath.account, RegisteredAccount); + end; + exit(); + end; + if (RealPath.isAccountEmpty) or RealPath.isVirtual then + exit(false); + + Result := ConnectionManager.Get(RealPath.account, getResult).createDir(RealPath.Path); + if Result then //need to check operation context => directory can be moved + begin + ThreadFsStatusInfo.TryGetValue(GetCurrentThreadID, OperationContextId); + if OperationContextId = FS_STATUS_OP_RENMOV_MULTI then + CurrentlyMovedDir := RealPath; + end; +end; + +function TMailRuCloudWFX.FsPutFile(LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; +var + RealPath: TRealPath; + RetryAttempts: Integer; + getResult: Integer; +begin + RealPath.FromPath(RemoteName); + if not FileExists(GetUNCFilePath(LocalName)) then + exit(FS_FILE_NOTFOUND); + + if RealPath.isAccountEmpty or RealPath.isVirtual then + exit(FS_FILE_NOTSUPPORTED); + TCProgress.Progress(LocalName, PWideChar(RealPath.Path), 0); + + if CheckFlag(FS_COPYFLAGS_RESUME, CopyFlags) then + exit(FS_FILE_NOTSUPPORTED); //NOT SUPPORTED + + if (CheckFlag(FS_COPYFLAGS_EXISTS_SAMECASE, CopyFlags) or CheckFlag(FS_COPYFLAGS_EXISTS_DIFFERENTCASE, CopyFlags)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags)) then + exit(FS_FILE_EXISTS); //Облако не поддерживает разные регистры + + if CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags) then begin + if not(ConnectionManager.Get(RealPath.account, getResult).deleteFile(RealPath.Path)) then + exit(FS_FILE_NOTSUPPORTED); //Неизвестно, как перезаписать файл черз API, но мы можем его удалить + end; + Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); + + //if Result in [FS_FILE_OK, FS_FILE_USERABORT, FS_FILE_NOTSUPPORTED] then exit; + if Result <> FS_FILE_WRITEERROR then + exit; + + case SettingsManager.Settings.OperationErrorMode of + OperationErrorModeAsk: begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + case (MsgBox(ERR_UPLOAD_FILE_ASK, [LocalName], ERR_UPLOAD, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of + ID_ABORT: + Result := FS_FILE_USERABORT; + ID_RETRY: + Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); + ID_IGNORE: + break; + end; + end; + + end; + OperationErrorModeIgnore: + exit; + OperationErrorModeAbort: + exit(FS_FILE_USERABORT); + OperationErrorModeRetry: begin; + RetryAttempts := SettingsManager.Settings.RetryAttempts; + while (ThreadRetryCountUpload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + ThreadRetryCountUpload.Items[GetCurrentThreadID()] := ThreadRetryCountUpload.Items[GetCurrentThreadID()] + 1; + TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, UPLOAD_FILE_RETRY, [LocalName, ThreadRetryCountUpload.Items[GetCurrentThreadID()], RetryAttempts]); + Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); + if TCProgress.Progress(PWideChar(LocalName), RemoteName, 0) then + Result := FS_FILE_USERABORT; + if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then + ThreadRetryCountUpload.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток + ProcessMessages; + Sleep(SettingsManager.Settings.AttemptWait); + end; + end; + end; +end; + +function TMailRuCloudWFX.FsRemoveDir(RemoteName: WideString): Boolean; +var + RealPath: TRealPath; + getResult: Integer; + ListingAborted: Boolean; + Cloud: TCloudMailRu; + OperationContextId: Integer; +begin + if (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID) and Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) and ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Text.Contains(RemoteName)) then //файлы по удаляемому пути есть в блек-листе + exit(false); + ThreadListingAborted.TryGetValue(GetCurrentThreadID(), ListingAborted); + if ListingAborted then begin + ThreadListingAborted.AddOrSetValue(GetCurrentThreadID(), false); + exit(false); + end; + RealPath.FromPath(WideString(RemoteName)); + if RealPath.isVirtual then + exit(false); + Cloud := ConnectionManager.Get(RealPath.account, getResult); + Result := Cloud.removeDir(RealPath.Path); + + if (Result and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RealPath.account).IsRemoteDescriptionsSupported) then begin + ThreadFsStatusInfo.TryGetValue(GetCurrentThreadID, OperationContextId); //need to check operation context => directory can be deleted after moving operation + if OperationContextId = FS_STATUS_OP_RENMOV_MULTI then begin + RenameRemoteFileDescription(RealPath, CurrentlyMovedDir, Cloud); + end + else + DeleteRemoteFileDescription(RealPath, Cloud); + end; +end; + +function TMailRuCloudWFX.FsRenMovFile(OldName, NewName: PWideChar; Move, OverWrite: Boolean; ri: pRemoteInfo): Integer; +var + OldRealPath: TRealPath; + NewRealPath: TRealPath; + getResult, SkippedFoundIndex: Integer; + OldCloud, NewCloud: TCloudMailRu; +begin + TCProgress.Progress(OldName, NewName, 0); + + OldRealPath.FromPath(WideString(OldName)); + NewRealPath.FromPath(WideString(NewName)); + + {TODO: Check the behavior inside virtual directories} + if OldRealPath.trashDir or NewRealPath.trashDir or OldRealPath.sharedDir or NewRealPath.sharedDir then + exit(FS_FILE_NOTSUPPORTED); + + OldCloud := ConnectionManager.Get(OldRealPath.account, getResult); + NewCloud := ConnectionManager.Get(NewRealPath.account, getResult); + + if OldRealPath.account <> NewRealPath.account then //разные аккаунты + begin + if OldCloud.public_account then begin + TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_OPERATIONS_NOT_SUPPORTED); + exit(FS_FILE_USERABORT); + end; + + case SettingsManager.Settings.CopyBetweenAccountsMode of + CopyBetweenAccountsModeDisabled: begin + TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_OPERATIONS_DISABLED); + exit(FS_FILE_USERABORT); + end; + CopyBetweenAccountsModeViaHash: + Result := RenMoveFileViaHash(OldCloud, NewCloud, OldRealPath, NewRealPath, Move, OverWrite); + CopyBetweenAccountsModeViaPublicLink: + Result := RenMoveFileViaPublicLink(OldCloud, NewCloud, OldRealPath, NewRealPath, Move, OverWrite); + else + exit(FS_FILE_WRITEERROR); + end; + + end else begin //один аккаунт + + if OverWrite and not(NewCloud.deleteFile(NewRealPath.Path)) then + exit(FS_FILE_NOTSUPPORTED); //мы не умеем перезаписывать, но мы можем удалить существующий файл + if Move then begin + Result := OldCloud.mvFile(OldRealPath.Path, NewRealPath.Path); + if (FS_FILE_EXISTS = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then //TC сразу же попытается удалить каталог, чтобы избежать этого - внесем путь в своеобразный блеклист + begin + ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Add(OldRealPath.ToPath); + end else if (FS_FILE_OK = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then begin //Вытащим из блеклиста, если решили перезаписать + + if Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) then begin + SkippedFoundIndex := ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].IndexOf(OldRealPath.ToPath); + if (-1 <> SkippedFoundIndex) then + ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Delete(SkippedFoundIndex); + end; + + end; + if ((FS_FILE_OK = Result) and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(NewRealPath.account).IsRemoteDescriptionsSupported) then + RenameRemoteFileDescription(OldRealPath, NewRealPath, OldCloud); + end else begin + Result := OldCloud.cpFile(OldRealPath.Path, NewRealPath.Path); + end; + + end; + TCProgress.Progress(OldName, NewName, 100); +end; + +procedure TMailRuCloudWFX.FsSetCryptCallback(PCryptProc: TCryptProcW; CryptoNr, Flags: Integer); +begin + PasswordManager := TTCPasswordManager.Create(PCryptProc, PluginNum, CryptoNr, TCLogger); + ConnectionManager := TConnectionManager.Create(SettingsManager.Settings, TCProgress, TCLogger, TCRequest, PasswordManager); +end; + +procedure TMailRuCloudWFX.FsStatusInfo(RemoteDir: WideString; InfoStartEnd, InfoOperation: Integer); +var + RealPath: TRealPath; + getResult: Integer; + BackgroundJobsCount: Integer; +begin + RealPath.FromPath(RemoteDir, ID_True); // RemoteDir always a directory + if (InfoStartEnd = FS_STATUS_START) then begin + ThreadFsStatusInfo.AddOrSetValue(GetCurrentThreadID(), InfoOperation); + case InfoOperation of + FS_STATUS_OP_LIST: begin + if (SettingsManager.Settings.DescriptionEnabled) and RealPath.IsInAccount() then begin + if ConnectionManager.Get(RealPath.account, getResult).getDescriptionFile(IncludeTrailingBackslash(RealPath.Path) + SettingsManager.Settings.DescriptionFileName, CurrentDescriptions.ionFilename) then begin + CurrentDescriptions.Read; + end else begin + CurrentDescriptions.Clear; + end; + end; + end; + FS_STATUS_OP_GET_SINGLE: begin + ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); + end; + FS_STATUS_OP_GET_MULTI: begin + ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); + end; + FS_STATUS_OP_PUT_SINGLE: begin + ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); + end; + FS_STATUS_OP_PUT_MULTI: begin + ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); + end; + FS_STATUS_OP_RENMOV_SINGLE: begin + end; + FS_STATUS_OP_RENMOV_MULTI: begin + if ConnectionManager.Get(RealPath.account, getResult).public_account then begin + TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_COPY_SUPPORT); + ThreadSkipListRenMov.AddOrSetValue(GetCurrentThreadID, true); + end; + ThreadRetryCountRenMov.AddOrSetValue(GetCurrentThreadID(), 0); + ThreadCanAbortRenMov.AddOrSetValue(GetCurrentThreadID, true); + ThreadFsRemoveDirSkippedPath.AddOrSetValue(GetCurrentThreadID, TStringList.Create()); + end; + FS_STATUS_OP_DELETE: begin + //ThreadSkipListDelete.Add(GetCurrentThreadID()); + ThreadSkipListDelete.AddOrSetValue(GetCurrentThreadID, true); + end; + FS_STATUS_OP_ATTRIB: begin + end; + FS_STATUS_OP_MKDIR: begin + end; + FS_STATUS_OP_EXEC: begin + end; + FS_STATUS_OP_CALCSIZE: begin + end; + FS_STATUS_OP_SEARCH: begin + end; + FS_STATUS_OP_SEARCH_TEXT: begin + end; + FS_STATUS_OP_SYNC_SEARCH: begin + end; + FS_STATUS_OP_SYNC_GET: begin + end; + FS_STATUS_OP_SYNC_PUT: begin + end; + FS_STATUS_OP_SYNC_DELETE: begin + end; + FS_STATUS_OP_GET_MULTI_THREAD: begin + ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); + if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then + BackgroundJobsCount := 0; + ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount + 1); + ThreadBackgroundThreads.AddOrSetValue(GetCurrentThreadID(), FS_STATUS_OP_GET_MULTI_THREAD); + end; + FS_STATUS_OP_PUT_MULTI_THREAD: begin + ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); + if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then + BackgroundJobsCount := 0; + ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount + 1); + ThreadBackgroundThreads.AddOrSetValue(GetCurrentThreadID(), FS_STATUS_OP_PUT_MULTI_THREAD); + end; + end; + exit; + end; + if (InfoStartEnd = FS_STATUS_END) then begin + ThreadFsStatusInfo.Remove(GetCurrentThreadID); + case InfoOperation of + FS_STATUS_OP_LIST: begin + end; + FS_STATUS_OP_GET_SINGLE: begin + end; + FS_STATUS_OP_GET_MULTI: begin + end; + FS_STATUS_OP_PUT_SINGLE: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_PUT_MULTI: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_RENMOV_SINGLE: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_RENMOV_MULTI: begin + ThreadSkipListRenMov.AddOrSetValue(GetCurrentThreadID, false); + ThreadCanAbortRenMov.AddOrSetValue(GetCurrentThreadID, false); + + ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Free; + ThreadFsRemoveDirSkippedPath.AddOrSetValue(GetCurrentThreadID, nil); + + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_DELETE: begin + ThreadSkipListDelete.AddOrSetValue(GetCurrentThreadID(), false); + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_ATTRIB: begin + end; + FS_STATUS_OP_MKDIR: begin + end; + FS_STATUS_OP_EXEC: begin + end; + FS_STATUS_OP_CALCSIZE: begin + end; + FS_STATUS_OP_SEARCH: begin + end; + FS_STATUS_OP_SEARCH_TEXT: begin + end; + FS_STATUS_OP_SYNC_SEARCH: begin + end; + FS_STATUS_OP_SYNC_GET: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_SYNC_PUT: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_SYNC_DELETE: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + end; + FS_STATUS_OP_GET_MULTI_THREAD: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then + BackgroundJobsCount := 0; + ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount - 1); + ThreadBackgroundThreads.Remove(GetCurrentThreadID()); + + end; + FS_STATUS_OP_PUT_MULTI_THREAD: begin + if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then + ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; + if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then + BackgroundJobsCount := 0; + ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount - 1); + ThreadBackgroundThreads.Remove(GetCurrentThreadID()); + end; + end; + exit; + end; +end; + +function TMailRuCloudWFX.GetRemoteFile(RemotePath: TRealPath; LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; +var + getResult: Integer; + Item: TCMRDirItem; + Cloud: TCloudMailRu; + resultHash: WideString; +begin + if (SettingsManager.Settings.CheckCRC) then + resultHash := EmptyWideStr + else + resultHash := 'dummy'; //calculations will be ignored if variable is not empty + Cloud := ConnectionManager.Get(RemotePath.account, getResult); + + Result := Cloud.getFile(WideString(RemotePath.Path), LocalName, resultHash); + + if Result = FS_FILE_OK then begin + + Item := FindListingItemByPath(CurrentListing, RemotePath); + {Дополнительно проверим CRC скачанного файла} + if SettingsManager.Settings.CheckCRC then begin + if (resultHash <> EmptyWideStr) and (Item.hash <> resultHash) then + exit(FS_FILE_READERROR); + end; + + if SettingsManager.Settings.PreserveFileTime then begin + if Item.mtime <> 0 then + SetAllFileTime(ExpandUNCFileName(LocalName), DateTimeToFileTime(UnixToDateTime(Item.mtime))); + end; + if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then begin + Cloud.deleteFile(RemotePath.Path); + if (SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RemotePath.account).IsRemoteDescriptionsSupported) then + DeleteRemoteFileDescription(RemotePath, Cloud); + end; + TCProgress.Progress(PWideChar(LocalName), PWideChar(RemoteName), 100); + TCLogger.Log(LOG_LEVEL_FILE_OPERATION, MSGTYPE_TRANSFERCOMPLETE, '%s -> %s', [RemoteName, LocalName]); + + if SettingsManager.Settings.DescriptionCopyFromCloud then + UpdateFileDescription(RemotePath, LocalName, Cloud); + + end; +end; + +function TMailRuCloudWFX.PutRemoteFile(RemotePath: TRealPath; LocalName, RemoteName: WideString; CopyFlags: Integer): Integer; +var + getResult: Integer; + Cloud: TCloudMailRu; +begin + Cloud := ConnectionManager.Get(RemotePath.account, getResult); + + Result := Cloud.putFile(WideString(LocalName), RemotePath.Path); + if Result = FS_FILE_OK then begin + TCProgress.Progress(PWideChar(LocalName), PWideChar(RemotePath.Path), 100); + TCLogger.Log(LOG_LEVEL_FILE_OPERATION, MSGTYPE_TRANSFERCOMPLETE, '%s -> %s', [LocalName, RemoteName]); + if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then + Result := DeleteLocalFile(LocalName); + if (SettingsManager.Settings.DescriptionCopyToCloud and AccountSettings.GetAccountSettings(RemotePath.account).IsRemoteDescriptionsSupported) then + UpdateRemoteFileDescription(RemotePath, LocalName, Cloud); + end; +end; + +{Assume the operation is inside of the same cloud instance - plugin does not support direct operations between different accounts} +procedure TMailRuCloudWFX.RenameRemoteFileDescription(OldRemotePath, NewRemotePath: TRealPath; var Cloud: TCloudMailRu); +var + OldDescriptions, NewDescriptions: TDescription; + OldRemoteIonPath, NewRemoteIonPath, OldLocalTempPath, NewLocalTempPath: WideString; + NewRemoteIonExists: Boolean; + OldItem, NewItem: WideString; +begin + OldItem := ExtractFileName(OldRemotePath.Path); + NewItem := ExtractFileName(NewRemotePath.Path); + OldRemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(OldRemotePath.Path)) + SettingsManager.Settings.DescriptionFileName; + NewRemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(NewRemotePath.Path)) + SettingsManager.Settings.DescriptionFileName; + OldLocalTempPath := GetTmpFileName('ion'); + NewLocalTempPath := GetTmpFileName('ion'); + + if ExtractFileDir(OldRemotePath.Path) = ExtractFileDir(NewRemotePath.Path) then //переименование внутри одного файла + begin + if not Cloud.getDescriptionFile(OldRemoteIonPath, OldLocalTempPath) then + exit; //описания нет, переносить нечего + OldDescriptions := TDescription.Create(OldLocalTempPath, GetTCCommentPreferredFormat); + OldDescriptions.Read; + if (OldDescriptions.RenameItem(OldItem, NewItem)) then //метод сам проверит существование описания + begin + OldDescriptions.Write(); + Cloud.deleteFile(OldRemoteIonPath); + Cloud.putDesriptionFile(OldRemoteIonPath, OldDescriptions.ionFilename); + end; + OldDescriptions.Destroy; + end + else //перенос и переименование в разных файлах (например, перемещение в подкаталог) + begin + if not Cloud.getDescriptionFile(OldRemoteIonPath, OldLocalTempPath) then + exit; //описания нет, не заморачиваемся + OldDescriptions := TDescription.Create(OldLocalTempPath, GetTCCommentPreferredFormat); + OldDescriptions.Read; + NewRemoteIonExists := Cloud.getDescriptionFile(NewRemoteIonPath, NewLocalTempPath); + NewDescriptions := TDescription.Create(NewLocalTempPath, GetTCCommentPreferredFormat); + if NewRemoteIonExists then + NewDescriptions.Read; //прочитать существующий, если его нет - то и читать нечего + + NewDescriptions.SetValue(ExtractFileName(NewRemotePath.Path), OldDescriptions.GetValue(ExtractFileName(OldRemotePath.Path))); + OldDescriptions.DeleteValue(ExtractFileName(OldRemotePath.Path)); + OldDescriptions.Write(); + NewDescriptions.Write(); + Cloud.deleteFile(OldRemoteIonPath); + Cloud.putDesriptionFile(OldRemoteIonPath, OldDescriptions.ionFilename); + if NewRemoteIonExists then + Cloud.deleteFile(NewRemoteIonPath); //Если файл существовал ранее, его нужно удалить для последующей записи на его место + Cloud.putDesriptionFile(NewRemoteIonPath, NewDescriptions.ionFilename); + OldDescriptions.Destroy; + NewDescriptions.Destroy; + end; +end; + +function TMailRuCloudWFX.RenMoveFileViaHash(OldCloud, NewCloud: TCloudMailRu; OldRealPath, NewRealPath: TRealPath; Move, OverWrite: Boolean): Integer; +var + CurrentItem: TCMRDirItem; + RetryAttempts: Integer; +begin + Result := FS_FILE_NOTSUPPORTED; + if OverWrite and not(NewCloud.deleteFile(NewRealPath.Path)) then + exit; + if OldCloud.statusFile(OldRealPath.Path, CurrentItem) then begin + Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.Path)) + ExtractFileName(NewRealPath.Path)); + if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then begin + + case SettingsManager.Settings.OperationErrorMode of + OperationErrorModeAsk: begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + case (MsgBox(ERR_CLONE_FILE_ASK, [TCloudMailRu.ErrorCodeText(Result)], ERR_OPERATION, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of + ID_ABORT: + Result := FS_FILE_USERABORT; + ID_RETRY: + Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.Path)) + CurrentItem.name); + ID_IGNORE: + break; + end; + end; + end; + OperationErrorModeIgnore: + exit; + OperationErrorModeAbort: + exit(FS_FILE_USERABORT); + OperationErrorModeRetry: begin; + RetryAttempts := SettingsManager.Settings.RetryAttempts; + while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := ThreadRetryCountRenMov.Items[GetCurrentThreadID()] + 1; + TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, CLONE_FILE_RETRY, [TCloudMailRu.ErrorCodeText(Result), ThreadRetryCountRenMov.Items[GetCurrentThreadID()], RetryAttempts]); + Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.Path)) + ExtractFileName(NewRealPath.Path)); + if TCProgress.Aborted() then + Result := FS_FILE_USERABORT; + if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then + ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток + ProcessMessages; + Sleep(SettingsManager.Settings.AttemptWait); + end; + end; + end; + end; + + if (Result = CLOUD_OPERATION_OK) and Move and not(OldCloud.deleteFile(OldRealPath.Path)) then + TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_DELETE, [CurrentItem.home]); //пишем в лог, но не отваливаемся + end; +end; + +function TMailRuCloudWFX.RenMoveFileViaPublicLink(OldCloud, NewCloud: TCloudMailRu; OldRealPath, NewRealPath: TRealPath; Move, OverWrite: Boolean): Integer; +var + NeedUnpublish: Boolean; + CurrentItem: TCMRDirItem; + RetryAttempts: Integer; +begin + Result := FS_FILE_NOTSUPPORTED; + NeedUnpublish := false; + if OverWrite and not(NewCloud.deleteFile(NewRealPath.Path)) then + exit; + + if OldCloud.statusFile(OldRealPath.Path, CurrentItem) then begin + if not CurrentItem.isPublished then //create temporary weblink + begin + NeedUnpublish := true; + if not(OldCloud.publishFile(CurrentItem.home, CurrentItem.weblink)) then //problem publishing + begin + TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_GET_TEMP_PUBLIC_LINK, [CurrentItem.home]); + exit(FS_FILE_READERROR); + end; + end; + Result := CloneWeblink(NewCloud, OldCloud, NewRealPath.Path, CurrentItem, NeedUnpublish); + if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then begin + + case SettingsManager.Settings.OperationErrorMode of + OperationErrorModeAsk: begin + + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + case (MsgBox(ERR_PUBLISH_FILE_ASK, [TCloudMailRu.ErrorCodeText(Result)], ERR_PUBLISH_FILE, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of + ID_ABORT: + Result := FS_FILE_USERABORT; + ID_RETRY: + Result := CloneWeblink(NewCloud, OldCloud, NewRealPath.Path, CurrentItem, NeedUnpublish); + ID_IGNORE: + break; + end; + end; + + end; + OperationErrorModeIgnore: + exit; + OperationErrorModeAbort: + exit(FS_FILE_USERABORT); + OperationErrorModeRetry: begin; + RetryAttempts := SettingsManager.Settings.RetryAttempts; + while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := ThreadRetryCountRenMov.Items[GetCurrentThreadID()] + 1; + TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, PUBLISH_FILE_RETRY, [TCloudMailRu.ErrorCodeText(Result), ThreadRetryCountRenMov.Items[GetCurrentThreadID()], RetryAttempts]); + Result := CloneWeblink(NewCloud, OldCloud, NewRealPath.Path, CurrentItem, NeedUnpublish); + if TCProgress.Aborted() then + Result := FS_FILE_USERABORT; + if (Result in [FS_FILE_OK, FS_FILE_USERABORT]) then + ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := 0; //сбросим счётчик попыток + ProcessMessages; + Sleep(SettingsManager.Settings.AttemptWait); + end; + end; + end; + end; + + if (Result = CLOUD_OPERATION_OK) and Move and not(OldCloud.deleteFile(OldRealPath.Path)) then + TCLogger.Log(LOG_LEVEL_ERROR, MSGTYPE_IMPORTANTERROR, ERR_DELETE, [CurrentItem.home]); //пишем в лог, но не отваливаемся + end; +end; + +procedure TMailRuCloudWFX.UpdateFileDescription(RemotePath: TRealPath; LocalFilePath: WideString; var Cloud: TCloudMailRu); +var + RemoteDescriptions, LocalDescriptions: TDescription; + RemoteIonPath, LocalTempPath: WideString; + RemoteIonExists: Boolean; +begin + RemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(RemotePath.Path)) + SettingsManager.Settings.DescriptionFileName; + LocalTempPath := GetTmpFileName('ion'); + + RemoteIonExists := Cloud.getDescriptionFile(RemoteIonPath, LocalTempPath); + if not RemoteIonExists then + exit; //удалённого файла описаний нет + + RemoteDescriptions := TDescription.Create(LocalTempPath, GetTCCommentPreferredFormat); + RemoteDescriptions.Read; + LocalDescriptions := TDescription.Create(IncludeTrailingPathDelimiter(ExtractFileDir(LocalFilePath)) + SettingsManager.Settings.DescriptionFileName, GetTCCommentPreferredFormat); //open local ion file + LocalDescriptions.Read; + LocalDescriptions.CopyFrom(RemoteDescriptions, ExtractFileName(LocalFilePath)); + LocalDescriptions.Write(); + LocalDescriptions.Destroy; + RemoteDescriptions.Destroy +end; + +procedure TMailRuCloudWFX.UpdateRemoteFileDescription(RemotePath: TRealPath; LocalFilePath: WideString; var Cloud: TCloudMailRu); +var + RemoteDescriptions, LocalDescriptions: TDescription; + RemoteIonPath, LocalIonPath, LocalTempPath: WideString; + RemoteIonExists: Boolean; +begin + RemoteIonPath := IncludeTrailingBackslash(ExtractFileDir(RemotePath.Path)) + SettingsManager.Settings.DescriptionFileName; + LocalIonPath := IncludeTrailingBackslash(ExtractFileDir(LocalFilePath)) + SettingsManager.Settings.DescriptionFileName; + LocalTempPath := GetTmpFileName('ion'); + + if (not FileExists(GetUNCFilePath(LocalIonPath))) then + exit; //Файла описаний нет, не паримся + + LocalDescriptions := TDescription.Create(LocalIonPath, GetTCCommentPreferredFormat); + LocalDescriptions.Read; + + RemoteIonExists := Cloud.getDescriptionFile(RemoteIonPath, LocalTempPath); + RemoteDescriptions := TDescription.Create(LocalTempPath, GetTCCommentPreferredFormat); + if RemoteIonExists then + RemoteDescriptions.Read; //если был прежний файл - его надо перечитать + + RemoteDescriptions.CopyFrom(LocalDescriptions, ExtractFileName(RemotePath.Path)); + RemoteDescriptions.Write(); + if RemoteIonExists then + Cloud.deleteFile(RemoteIonPath); //Приходится удалять, потому что не знаем, как переписать + + Cloud.putDesriptionFile(RemoteIonPath, RemoteDescriptions.ionFilename); + + RemoteDescriptions.Destroy; + LocalDescriptions.Destroy +end; + +end. diff --git a/types/ANSIFunctions.pas b/types/ANSIFunctions.pas index 939d9d0..b38715f 100644 --- a/types/ANSIFunctions.pas +++ b/types/ANSIFunctions.pas @@ -21,7 +21,6 @@ function FsDisconnect(DisconnectRoot: PAnsiChar): Bool; stdcall; function FsMkDir(path: PAnsiChar): Bool; stdcall; function FsRemoveDir(RemoteName: PAnsiChar): Bool; stdcall; procedure FsSetCryptCallback(PCryptProc: TCryptProcW; CryptoNr: integer; Flags: integer); stdcall; -function FsContentGetSupportedField(FieldIndex: integer; FieldName: PAnsiChar; Units: PAnsiChar; maxlen: integer): integer; stdcall; function FsContentGetValue(FileName: PAnsiChar; FieldIndex: integer; UnitIndex: integer; FieldValue: Pointer; maxlen: integer; Flags: integer): integer; stdcall; function FsExtractCustomIcon(RemoteName: pchar; ExtractFlags: integer; var TheIcon: hicon): integer; stdcall; @@ -102,103 +101,6 @@ procedure FsSetCryptCallback(PCryptProc: TCryptProcW; CryptoNr: integer; Flags: SetLastError(ERROR_INVALID_FUNCTION); end; -function FsContentGetSupportedField(FieldIndex: integer; FieldName: PAnsiChar; Units: PAnsiChar; maxlen: integer): integer; stdcall; -begin - Result := ft_nomorefields; - case FieldIndex of - 0: - begin - System.AnsiStrings.strpcopy(FieldName, 'tree'); - Result := ft_stringw; - end; - 1: - begin - System.AnsiStrings.strpcopy(FieldName, 'name'); - Result := ft_stringw; - end; - 2: - begin - System.AnsiStrings.strpcopy(FieldName, 'grev'); - Result := ft_numeric_32; - end; - 3: - begin - System.AnsiStrings.strpcopy(FieldName, 'size'); - Result := ft_numeric_64; - end; - 4: - begin - System.AnsiStrings.strpcopy(FieldName, 'kind'); - Result := ft_stringw; - end; - 5: - begin - System.AnsiStrings.strpcopy(FieldName, 'weblink'); - Result := ft_stringw; - end; - 6: - begin - System.AnsiStrings.strpcopy(FieldName, 'rev'); - Result := ft_numeric_32; - end; - 7: - begin - System.AnsiStrings.strpcopy(FieldName, 'type'); - Result := ft_stringw; - end; - 8: - begin - System.AnsiStrings.strpcopy(FieldName, 'home'); - Result := ft_stringw; - end; - 9: - begin - System.AnsiStrings.strpcopy(FieldName, 'mtime'); - Result := ft_datetime; - end; - 10: - begin - System.AnsiStrings.strpcopy(FieldName, 'hash'); - Result := ft_stringw; - end; - 11: - begin - System.AnsiStrings.strpcopy(FieldName, 'virus_scan'); - Result := ft_stringw; - end; - 12: - begin - System.AnsiStrings.strpcopy(FieldName, 'folders_count'); - Result := ft_numeric_32; - end; - 13: - begin - System.AnsiStrings.strpcopy(FieldName, 'files_count'); - Result := ft_numeric_32; - end; - 14: - begin - System.AnsiStrings.strpcopy(FieldName, 'description'); - Result := ft_stringw; - end; - 15: - begin - System.AnsiStrings.strpcopy(FieldName, 'deleted_at'); - Result := ft_datetime; - end; - 16: - begin - System.AnsiStrings.strpcopy(FieldName, 'deleted_from'); - Result := ft_stringw; - end; - 17: - begin - System.AnsiStrings.strpcopy(FieldName, 'deleted_by'); - Result := ft_stringw; - end; - end; -end; - function FsContentGetValue(FileName: PAnsiChar; FieldIndex: integer; UnitIndex: integer; FieldValue: Pointer; maxlen: integer; Flags: integer): integer; stdcall; begin SetLastError(ERROR_INVALID_FUNCTION); From 5292a6efabd8d3e24e4f7dd877c8bb18e6e301e4 Mon Sep 17 00:00:00 2001 From: Pozitronik Date: Tue, 12 Dec 2023 17:24:58 +0400 Subject: [PATCH 4/5] Format code --- MailRuCloud.dpr | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/MailRuCloud.dpr b/MailRuCloud.dpr index 2287061..21f8ad0 100644 --- a/MailRuCloud.dpr +++ b/MailRuCloud.dpr @@ -212,9 +212,11 @@ begin InitPluginData; DLL_PROCESS_DETACH: FreePluginData(); - DLL_THREAD_ATTACH: begin + DLL_THREAD_ATTACH: + begin end; - DLL_THREAD_DETACH: begin + DLL_THREAD_DETACH: + begin end; end; //case end; From 6862e1a7dd2e475ef10f937dfc2ca4c481961eb3 Mon Sep 17 00:00:00 2001 From: Pozitronik Date: Tue, 12 Dec 2023 17:27:18 +0400 Subject: [PATCH 5/5] Format project sources --- forms/Accounts.dfm | 33 ++- forms/DeletedProperty.pas | 2 +- forms/Registration.pas | 1 - models/ConnectionManager.pas | 3 +- models/cipher/FileCipher.pas | 2 +- models/http/CloudMailRuHTTP.pas | 4 +- models/wfx/MailRuCloudWFX.pas | 381 +++++++++++++++++++++----------- 7 files changed, 281 insertions(+), 145 deletions(-) diff --git a/forms/Accounts.dfm b/forms/Accounts.dfm index cc58d31..2e5dd58 100644 --- a/forms/Accounts.dfm +++ b/forms/Accounts.dfm @@ -170,10 +170,11 @@ object AccountsForm: TAccountsForm object AccountNameLabel: TLabel Left = 225 Top = 10 - Width = 68 + Width = 62 Height = 13 Anchors = [akLeft, akTop, akRight] Caption = 'Account name' + ExplicitWidth = 68 end object AccountsGroupBox: TGroupBox Left = -4 @@ -352,11 +353,10 @@ object AccountsForm: TAccountsForm object AccountNameEdit: TEdit Left = 225 Top = 27 - Width = 249 + Width = 243 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 1 - ExplicitWidth = 243 end object PublicAccountCB: TCheckBox Left = 225 @@ -982,42 +982,47 @@ object AccountsForm: TAccountsForm object ExtLabel: TLabel Left = 225 Top = 10 - Width = 66 + Width = 60 Height = 13 Anchors = [akLeft, akTop, akRight] Caption = 'File extension' + ExplicitWidth = 66 end object CommandLabel: TLabel Left = 225 Top = 52 - Width = 47 + Width = 41 Height = 13 Anchors = [akLeft, akTop, akRight] Caption = 'Command' + ExplicitWidth = 47 end object ParametersLabel: TLabel Left = 225 Top = 93 - Width = 227 + Width = 221 Height = 13 Anchors = [akLeft, akTop, akRight] Caption = 'Parameters (%url% for stream url substitution)' + ExplicitWidth = 227 end object StartPathLabel: TLabel Left = 225 Top = 134 - Width = 49 + Width = 43 Height = 13 Anchors = [akLeft, akTop, akRight] Caption = 'Start path' + ExplicitWidth = 49 end object StreamingTypeLabel: TLabel Left = 225 Top = 177 - Width = 73 + Width = 67 Height = 13 Anchors = [akLeft, akTop, akRight] Caption = 'Streaming type' + ExplicitWidth = 73 end object TExtensionsGroupBox: TGroupBox Left = -4 @@ -1047,18 +1052,20 @@ object AccountsForm: TAccountsForm object StreamingExtensionEdit: TEdit Left = 225 Top = 27 - Width = 249 + Width = 243 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 1 + ExplicitWidth = 249 end object CommandPathEdit: TEdit Left = 225 Top = 69 - Width = 228 + Width = 222 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 2 + ExplicitWidth = 228 end object CommandPathButton: TButton Left = 459 @@ -1072,18 +1079,20 @@ object AccountsForm: TAccountsForm object ParametersEdit: TEdit Left = 225 Top = 110 - Width = 249 + Width = 243 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 4 + ExplicitWidth = 249 end object StartPathEdit: TEdit Left = 225 Top = 151 - Width = 249 + Width = 243 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 5 + ExplicitWidth = 249 end object StreamingTypeCombo: TComboBox Left = 225 diff --git a/forms/DeletedProperty.pas b/forms/DeletedProperty.pas index 2180724..8ad7d1b 100644 --- a/forms/DeletedProperty.pas +++ b/forms/DeletedProperty.pas @@ -7,7 +7,7 @@ interface CMRDirItem, CloudMailRu, SETTINGS_CONSTANTS, - LANGUAGE_STRINGS, + LANGUAGE_STRINGS, CMRConstants, PluginHelper, DateUtils, diff --git a/forms/Registration.pas b/forms/Registration.pas index 7371cc6..1c18d2c 100644 --- a/forms/Registration.pas +++ b/forms/Registration.pas @@ -26,7 +26,6 @@ interface ConnectionSettings, Vcl.Imaging.JPEG; - type TRegistrationForm = class(TForm) FirstNameLabel: TLabel; diff --git a/models/ConnectionManager.pas b/models/ConnectionManager.pas index 24b2edc..4ac83ae 100644 --- a/models/ConnectionManager.pas +++ b/models/ConnectionManager.pas @@ -275,7 +275,8 @@ function TConnectionManager.GetProxyPassword: Boolean; if ProxySettings.UseTCPasswordManager and (PasswordManager.GetPassword('proxy' + ProxySettings.User, ProxySettings.password) = FS_FILE_OK) then {retrieve the proxy password from TC passwords storage} Result := True{Password is retrieved and should be updated in th HTTPManager} - else begin + else + begin if ProxySettings.password = EmptyWideStr then {password can be retrieved previously or just read from config} begin if mrOk = TAskPasswordForm.AskPassword(Format(ASK_PROXY_PASSWORD, [ProxySettings.User]), PREFIX_ASK_PROXY_PASSWORD, ProxySettings.password, ProxySettings.UseTCPasswordManager, False, FindTCWindow) then diff --git a/models/cipher/FileCipher.pas b/models/cipher/FileCipher.pas index fccf121..d02fdc1 100644 --- a/models/cipher/FileCipher.pas +++ b/models/cipher/FileCipher.pas @@ -47,7 +47,7 @@ TFileCipher = class function DecryptFile(SourceFileName, DestinationFilename: WideString): integer; function DecryptStream(SourceStream, DestinationStream: TStream): integer; function DecryptFileName(const FileName: WideString): WideString; - procedure DecryptDirListing(var CloudMailRuDirListing:TCMRDirItemList); + procedure DecryptDirListing(var CloudMailRuDirListing: TCMRDirItemList); class function Base64ToSafe(const Base64: WideString): WideString; //converts Base64-encoded string to URL and Filename safe (RFC 4648) class function Base64FromSafe(const Safe: WideString): WideString; diff --git a/models/http/CloudMailRuHTTP.pas b/models/http/CloudMailRuHTTP.pas index ed55a6d..992beb6 100644 --- a/models/http/CloudMailRuHTTP.pas +++ b/models/http/CloudMailRuHTTP.pas @@ -117,7 +117,7 @@ constructor TCloudMailRuHTTP.Create(Settings: TConnectionSettings; Progress: TTC begin self.Socks.Authentication := saUsernamePassword; self.Socks.Username := Settings.ProxySettings.User; - self.Socks.password := Settings.ProxySettings.Password; + self.Socks.password := Settings.ProxySettings.password; end else self.Socks.Authentication := saNoAuthentication; @@ -141,7 +141,7 @@ constructor TCloudMailRuHTTP.Create(Settings: TConnectionSettings; Progress: TTC begin HTTP.ProxyParams.BasicAuthentication := true; HTTP.ProxyParams.ProxyUsername := Settings.ProxySettings.User; - HTTP.ProxyParams.ProxyPassword := Settings.ProxySettings.Password; + HTTP.ProxyParams.ProxyPassword := Settings.ProxySettings.password; end end; diff --git a/models/wfx/MailRuCloudWFX.pas b/models/wfx/MailRuCloudWFX.pas index 3280140..0aee9c9 100644 --- a/models/wfx/MailRuCloudWFX.pas +++ b/models/wfx/MailRuCloudWFX.pas @@ -697,8 +697,10 @@ function TMailRuCloudWFX.FsContentGetValue(FileName: PWideChar; FieldIndex, Unit begin Result := ft_nosuchfield; RealPath.FromPath(FileName); - if RealPath.isInAccountsList then begin - if FieldIndex = 14 then begin + if RealPath.isInAccountsList then + begin + if FieldIndex = 14 then + begin strpcopy(FieldValue, AccountSettings.GetAccountSettings(RealPath.account).Description); exit(ft_stringw); end @@ -710,49 +712,59 @@ function TMailRuCloudWFX.FsContentGetValue(FileName: PWideChar; FieldIndex, Unit //if Item.home = '' then exit(ft_nosuchfield); case FieldIndex of - 0: begin + 0: + begin if Item.mtime <> 0 then exit(ft_nosuchfield); strpcopy(FieldValue, Item.tree); Result := ft_stringw; end; - 1: begin + 1: + begin strpcopy(FieldValue, Item.name); Result := ft_stringw; end; - 2: begin + 2: + begin if Item.mtime <> 0 then exit(ft_nosuchfield); Move(Item.grev, FieldValue^, sizeof(Item.grev)); Result := ft_numeric_32; end; - 3: begin + 3: + begin Move(Item.size, FieldValue^, sizeof(Item.size)); Result := ft_numeric_64; end; - 4: begin + 4: + begin strpcopy(FieldValue, Item.kind); Result := ft_stringw; end; - 5: begin + 5: + begin strpcopy(FieldValue, Item.weblink); Result := ft_stringw; end; - 6: begin + 6: + begin if Item.mtime <> 0 then exit(ft_nosuchfield); Move(Item.rev, FieldValue^, sizeof(Item.rev)); Result := ft_numeric_32; end; - 7: begin + 7: + begin strpcopy(FieldValue, Item.type_); Result := ft_stringw; end; - 8: begin + 8: + begin strpcopy(FieldValue, Item.home); Result := ft_stringw; end; - 9: begin + 9: + begin if Item.mtime = 0 then exit(ft_nosuchfield); FileTime.dwHighDateTime := 0; @@ -761,36 +773,43 @@ function TMailRuCloudWFX.FsContentGetValue(FileName: PWideChar; FieldIndex, Unit Move(FileTime, FieldValue^, sizeof(FileTime)); Result := ft_datetime; end; - 10: begin + 10: + begin strpcopy(FieldValue, Item.hash); Result := ft_stringw; end; - 11: begin + 11: + begin strpcopy(FieldValue, Item.virus_scan); Result := ft_stringw; end; - 12: begin + 12: + begin if Item.type_ = TYPE_FILE then exit(ft_nosuchfield); Move(Item.folders_count, FieldValue^, sizeof(Item.folders_count)); Result := ft_numeric_32; end; - 13: begin + 13: + begin if Item.type_ = TYPE_FILE then exit(ft_nosuchfield); Move(Item.files_count, FieldValue^, sizeof(Item.files_count)); Result := ft_numeric_32; end; - 14: begin + 14: + begin //При включённой сортировке Запрос происходит при появлении в списке - if SettingsManager.Settings.DescriptionEnabled then begin + if SettingsManager.Settings.DescriptionEnabled then + begin strpcopy(FieldValue, CurrentDescriptions.GetValue(Item.name)); end else begin strpcopy(FieldValue, ''); end; Result := ft_stringw; end; - 15: begin + 15: + begin if Item.deleted_at = 0 then exit(ft_nosuchfield); FileTime.dwHighDateTime := 0; @@ -799,13 +818,15 @@ function TMailRuCloudWFX.FsContentGetValue(FileName: PWideChar; FieldIndex, Unit Move(FileTime, FieldValue^, sizeof(FileTime)); Result := ft_datetime; end; - 16: begin + 16: + begin if Item.deleted_from = EmptyWideStr then exit(ft_nosuchfield); strpcopy(FieldValue, Item.deleted_from); Result := ft_stringw; end; - 17: begin + 17: + begin if Item.deleted_by = 0 then exit(ft_nosuchfield); strpcopy(FieldValue, Item.deleted_by.ToString); //display user id as is, because no conversation api method performed @@ -827,7 +848,8 @@ function TMailRuCloudWFX.FsDeleteFile(RemoteName: WideString): Boolean; if RealPath.isAccountEmpty or RealPath.trashDir or RealPath.invitesDir then exit(false); Cloud := ConnectionManager.Get(RealPath.account, getResult); - if RealPath.sharedDir then begin + if RealPath.sharedDir then + begin CurrentItem := FindListingItemByPath(CurrentListing, RealPath); Cloud.getShareInfo(CurrentItem.home, InvitesListing); for Invite in InvitesListing do @@ -847,7 +869,8 @@ function TMailRuCloudWFX.FsDisconnect(DisconnectRoot: PWideChar): Boolean; BackgroundJobsCount: Integer; begin BackgroundJobsCount := 0; - if ((not ThreadBackgroundJobs.TryGetValue(ExtractFileName(DisconnectRoot), BackgroundJobsCount)) or (BackgroundJobsCount = 0)) then begin + if ((not ThreadBackgroundJobs.TryGetValue(ExtractFileName(DisconnectRoot), BackgroundJobsCount)) or (BackgroundJobsCount = 0)) then + begin ConnectionManager.Free(ExtractFileName(DisconnectRoot)); Result := true; end else begin //здесь можно добавить механизм ожидания завершения фоновой операции @@ -876,7 +899,8 @@ function TMailRuCloudWFX.FsExecuteFile(MainWin: THandle; RemoteName, Verb: PWide if Verb = VERB_PROPERTIES then exit(ExecProperties(MainWin, RealPath)); - if Verb = VERB_OPEN then begin + if Verb = VERB_OPEN then + begin if (not(RealPath.isDir = ID_True)) then exit(ExecuteFileStream(RealPath, SettingsManager.GetStreamingSettings(RealPath.Path))) else @@ -935,8 +959,10 @@ function TMailRuCloudWFX.FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags exit(FS_ICON_EXTRACTED_DESTROY); end; - if RealPath.sharedDir then begin - if RealPath.isInAccountsList then begin + if RealPath.sharedDir then + begin + if RealPath.isInAccountsList then + begin strpcopy(RemoteName, 'shared'); CombineMacro(TheIcon); @@ -947,8 +973,10 @@ function TMailRuCloudWFX.FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags end; end; - if RealPath.invitesDir then begin - if RealPath.isInAccountsList then begin + if RealPath.invitesDir then + begin + if RealPath.isInAccountsList then + begin strpcopy(RemoteName, 'shared_incoming'); CombineMacro(TheIcon); exit(FS_ICON_EXTRACTED_DESTROY); @@ -982,7 +1010,8 @@ function TMailRuCloudWFX.FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags strpcopy(RemoteName, 'cloud'); end else begin //directories Item := FindListingItemByPath(CurrentListing, RealPath); - if (Item.type_ = TYPE_DIR) or (Item.kind = KIND_SHARED) then begin + if (Item.type_ = TYPE_DIR) or (Item.kind = KIND_SHARED) then + begin if Item.kind = KIND_SHARED then strpcopy(RemoteName, 'shared') else if Item.isPublished then @@ -998,13 +1027,15 @@ function TMailRuCloudWFX.FsExtractCustomIcon(RemoteName: PWideChar; ExtractFlags TheIcon := LoadImageW(hInstance, RemoteName, IMAGE_ICON, IconsSize, IconsSize, LR_DEFAULTCOLOR); IconsModeInternalOverlay: CombineMacro(TheIcon); - IconsModeExternal: begin + IconsModeExternal: + begin TheIcon := LoadPluginIcon(PluginPath + 'icons', RemoteName); if TheIcon = INVALID_HANDLE_VALUE then exit(FS_ICON_USEDEFAULT); exit(FS_ICON_EXTRACTED_DESTROY); end; - IconsModeExternalOverlay: begin + IconsModeExternalOverlay: + begin TheIcon := LoadPluginIcon(PluginPath + 'icons', RemoteName); if TheIcon = INVALID_HANDLE_VALUE then exit(FS_ICON_USEDEFAULT); @@ -1036,23 +1067,27 @@ function TMailRuCloudWFX.FsFindFirst(Path: WideString; var FindData: tWIN32FINDD ThreadCanAbortRenMov.TryGetValue(GetCurrentThreadID(), CanAbortRenMov); - if (CanAbortRenMov and TCProgress.Progress(Path)) then begin + if (CanAbortRenMov and TCProgress.Progress(Path)) then + begin ThreadListingAborted.AddOrSetValue(GetCurrentThreadID(), true); RenMovAborted := true; end else RenMovAborted := false; - if SkipListDelete or SkipListRenMov or RenMovAborted then begin + if SkipListDelete or SkipListRenMov or RenMovAborted then + begin SetLastError(ERROR_NO_MORE_FILES); exit(INVALID_HANDLE_VALUE); end; //Result := FIND_NO_MORE_FILES; GlobalPath := Path; - if GlobalPath = '\' then begin //список соединений + if GlobalPath = '\' then + begin //список соединений Accounts := AccountSettings.GetAccountsList([ATPrivate, ATPublic], SettingsManager.Settings.EnabledVirtualTypes); - if (Accounts.Count > 0) then begin + if (Accounts.Count > 0) then + begin FindData := GetFindDataEmptyDir(Accounts[0]); FileCounter := 1; Result := FIND_ROOT_DIRECTORY; @@ -1064,23 +1099,28 @@ function TMailRuCloudWFX.FsFindFirst(Path: WideString; var FindData: tWIN32FINDD RealPath.FromPath(GlobalPath); CurrentCloud := ConnectionManager.Get(RealPath.account, getResult); - if getResult <> CLOUD_OPERATION_OK then begin + if getResult <> CLOUD_OPERATION_OK then + begin SetLastError(ERROR_ACCESS_DENIED); exit(INVALID_HANDLE_VALUE); end; - if not Assigned(CurrentCloud) then begin + if not Assigned(CurrentCloud) then + begin SetLastError(ERROR_PATH_NOT_FOUND); exit(INVALID_HANDLE_VALUE); end; - if RealPath.trashDir then begin + if RealPath.trashDir then + begin if not CurrentCloud.getTrashbinListing(CurrentListing) then SetLastError(ERROR_PATH_NOT_FOUND); - end else if RealPath.sharedDir then begin + end else if RealPath.sharedDir then + begin if not CurrentCloud.getSharedLinksListing(CurrentListing) then SetLastError(ERROR_PATH_NOT_FOUND); //that will be interpreted as symlinks later - end else if RealPath.invitesDir then begin + end else if RealPath.invitesDir then + begin if not CurrentCloud.getIncomingLinksListing(CurrentListing, CurrentIncomingInvitesListing) then SetLastError(ERROR_PATH_NOT_FOUND); //одновременно получаем оба листинга, чтобы не перечитывать листинг инватов на каждый чих end else begin //Нужно проверить, является ли открываемый объект каталогом - для файлов API вернёт листинг вышестоящего каталога, см. issue #174 @@ -1099,12 +1139,14 @@ function TMailRuCloudWFX.FsFindFirst(Path: WideString; var FindData: tWIN32FINDD else CurrentItem := CurrentListing.FindByHomePath(RealPath.Path); - if not(CurrentItem.isNone or CurrentItem.isDir) then begin + if not(CurrentItem.isNone or CurrentItem.isDir) then + begin SetLastError(ERROR_PATH_NOT_FOUND); exit(INVALID_HANDLE_VALUE); end; - if (Length(CurrentListing) = 0) then begin + if (Length(CurrentListing) = 0) then + begin FindData := GetFindDataEmptyDir(); //воркароунд бага с невозможностью входа в пустой каталог, см. http://www.ghisler.ch/board/viewtopic.php?t=42399 Result := FIND_NO_MORE_FILES; SetLastError(ERROR_NO_MORE_FILES); @@ -1122,8 +1164,10 @@ function TMailRuCloudWFX.FsFindFirst(Path: WideString; var FindData: tWIN32FINDD function TMailRuCloudWFX.FsFindNext(Hdl: THandle; var FindData: tWIN32FINDDATAW): Boolean; begin - if GlobalPath = '\' then begin - if (Accounts.Count > FileCounter) then begin + if GlobalPath = '\' then + begin + if (Accounts.Count > FileCounter) then + begin FindData := GetFindDataEmptyDir(Accounts[FileCounter]); inc(FileCounter); Result := true; @@ -1133,7 +1177,8 @@ function TMailRuCloudWFX.FsFindNext(Hdl: THandle; var FindData: tWIN32FINDDATAW) end else begin //Получение последующих файлов в папке (вызывается до тех пор, пока не вернёт false). - if (Length(CurrentListing) > FileCounter) then begin + if (Length(CurrentListing) > FileCounter) then + begin FindData := CurrentListing[FileCounter].ToFindData(Hdl = FIND_SHARED_LINKS); Result := true; inc(FileCounter); @@ -1174,11 +1219,13 @@ function TMailRuCloudWFX.FsGetFile(RemoteName, LocalName: WideString; CopyFlags: TCProgress.Progress(RemoteName, LocalName, 0); OverwriteLocalMode := SettingsManager.Settings.OverwriteLocalMode; - if (FileExists(GetUNCFilePath(LocalName)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags))) then begin + if (FileExists(GetUNCFilePath(LocalName)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags))) then + begin case OverwriteLocalMode of OverwriteLocalModeAsk: exit(FS_FILE_EXISTS); //TC will ask user - OverwriteLocalModeIgnore: begin + OverwriteLocalModeIgnore: + begin TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, FILE_EXISTS_IGNORE, [LocalName]); exit(FS_FILE_OK); end; @@ -1193,8 +1240,10 @@ function TMailRuCloudWFX.FsGetFile(RemoteName, LocalName: WideString; CopyFlags: exit; case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + OperationErrorModeAsk: + begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin case (MsgBox(ERR_DOWNLOAD_FILE_ASK, [RemoteName], ERR_DOWNLOAD, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of ID_ABORT: Result := FS_FILE_USERABORT; @@ -1210,9 +1259,11 @@ function TMailRuCloudWFX.FsGetFile(RemoteName, LocalName: WideString; CopyFlags: exit; OperationErrorModeAbort: exit(FS_FILE_USERABORT); - OperationErrorModeRetry: begin; + OperationErrorModeRetry: + begin; RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountDownload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + while (ThreadRetryCountDownload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin ThreadRetryCountDownload.Items[GetCurrentThreadID()] := ThreadRetryCountDownload.Items[GetCurrentThreadID()] + 1; TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, DOWNLOAD_FILE_RETRY, [RemoteName, ThreadRetryCountDownload.Items[GetCurrentThreadID()], RetryAttempts]); Result := GetRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); @@ -1245,7 +1296,8 @@ function TMailRuCloudWFX.FsMkDir(Path: WideString): Boolean; RegisteredAccount := AccountSettings.GetAccountSettings(RealPath.account); Result := (mrOk = TRegistrationForm.ShowRegistration(FindTCWindow, SettingsManager.Settings.ConnectionSettings, RegisteredAccount)); - if Result then begin + if Result then + begin if RegisteredAccount.UseTCPasswordManager then //просим TC сохранить пароль Result := FS_FILE_OK = PasswordManager.SetPassword(RealPath.account, RegisteredAccount.password); if Result then @@ -1285,7 +1337,8 @@ function TMailRuCloudWFX.FsPutFile(LocalName, RemoteName: WideString; CopyFlags: if (CheckFlag(FS_COPYFLAGS_EXISTS_SAMECASE, CopyFlags) or CheckFlag(FS_COPYFLAGS_EXISTS_DIFFERENTCASE, CopyFlags)) and not(CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags)) then exit(FS_FILE_EXISTS); //Облако не поддерживает разные регистры - if CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags) then begin + if CheckFlag(FS_COPYFLAGS_OVERWRITE, CopyFlags) then + begin if not(ConnectionManager.Get(RealPath.account, getResult).deleteFile(RealPath.Path)) then exit(FS_FILE_NOTSUPPORTED); //Неизвестно, как перезаписать файл черз API, но мы можем его удалить end; @@ -1296,8 +1349,10 @@ function TMailRuCloudWFX.FsPutFile(LocalName, RemoteName: WideString; CopyFlags: exit; case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + OperationErrorModeAsk: + begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin case (MsgBox(ERR_UPLOAD_FILE_ASK, [LocalName], ERR_UPLOAD, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of ID_ABORT: Result := FS_FILE_USERABORT; @@ -1313,9 +1368,11 @@ function TMailRuCloudWFX.FsPutFile(LocalName, RemoteName: WideString; CopyFlags: exit; OperationErrorModeAbort: exit(FS_FILE_USERABORT); - OperationErrorModeRetry: begin; + OperationErrorModeRetry: + begin; RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountUpload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + while (ThreadRetryCountUpload.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin ThreadRetryCountUpload.Items[GetCurrentThreadID()] := ThreadRetryCountUpload.Items[GetCurrentThreadID()] + 1; TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, UPLOAD_FILE_RETRY, [LocalName, ThreadRetryCountUpload.Items[GetCurrentThreadID()], RetryAttempts]); Result := PutRemoteFile(RealPath, LocalName, RemoteName, CopyFlags); @@ -1341,7 +1398,8 @@ function TMailRuCloudWFX.FsRemoveDir(RemoteName: WideString): Boolean; if (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID) and Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) and ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Text.Contains(RemoteName)) then //файлы по удаляемому пути есть в блек-листе exit(false); ThreadListingAborted.TryGetValue(GetCurrentThreadID(), ListingAborted); - if ListingAborted then begin + if ListingAborted then + begin ThreadListingAborted.AddOrSetValue(GetCurrentThreadID(), false); exit(false); end; @@ -1351,9 +1409,11 @@ function TMailRuCloudWFX.FsRemoveDir(RemoteName: WideString): Boolean; Cloud := ConnectionManager.Get(RealPath.account, getResult); Result := Cloud.removeDir(RealPath.Path); - if (Result and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RealPath.account).IsRemoteDescriptionsSupported) then begin + if (Result and SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RealPath.account).IsRemoteDescriptionsSupported) then + begin ThreadFsStatusInfo.TryGetValue(GetCurrentThreadID, OperationContextId); //need to check operation context => directory can be deleted after moving operation - if OperationContextId = FS_STATUS_OP_RENMOV_MULTI then begin + if OperationContextId = FS_STATUS_OP_RENMOV_MULTI then + begin RenameRemoteFileDescription(RealPath, CurrentlyMovedDir, Cloud); end else @@ -1382,13 +1442,15 @@ function TMailRuCloudWFX.FsRenMovFile(OldName, NewName: PWideChar; Move, OverWri if OldRealPath.account <> NewRealPath.account then //разные аккаунты begin - if OldCloud.public_account then begin + if OldCloud.public_account then + begin TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_OPERATIONS_NOT_SUPPORTED); exit(FS_FILE_USERABORT); end; case SettingsManager.Settings.CopyBetweenAccountsMode of - CopyBetweenAccountsModeDisabled: begin + CopyBetweenAccountsModeDisabled: + begin TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_OPERATIONS_DISABLED); exit(FS_FILE_USERABORT); end; @@ -1404,14 +1466,17 @@ function TMailRuCloudWFX.FsRenMovFile(OldName, NewName: PWideChar; Move, OverWri if OverWrite and not(NewCloud.deleteFile(NewRealPath.Path)) then exit(FS_FILE_NOTSUPPORTED); //мы не умеем перезаписывать, но мы можем удалить существующий файл - if Move then begin + if Move then + begin Result := OldCloud.mvFile(OldRealPath.Path, NewRealPath.Path); if (FS_FILE_EXISTS = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then //TC сразу же попытается удалить каталог, чтобы избежать этого - внесем путь в своеобразный блеклист begin ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Add(OldRealPath.ToPath); - end else if (FS_FILE_OK = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then begin //Вытащим из блеклиста, если решили перезаписать + end else if (FS_FILE_OK = Result) and (ThreadFsRemoveDirSkippedPath.ContainsKey(GetCurrentThreadID)) then + begin //Вытащим из блеклиста, если решили перезаписать - if Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) then begin + if Assigned(ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID]) then + begin SkippedFoundIndex := ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].IndexOf(OldRealPath.ToPath); if (-1 <> SkippedFoundIndex) then ThreadFsRemoveDirSkippedPath.Items[GetCurrentThreadID].Delete(SkippedFoundIndex); @@ -1441,34 +1506,45 @@ procedure TMailRuCloudWFX.FsStatusInfo(RemoteDir: WideString; InfoStartEnd, Info BackgroundJobsCount: Integer; begin RealPath.FromPath(RemoteDir, ID_True); // RemoteDir always a directory - if (InfoStartEnd = FS_STATUS_START) then begin + if (InfoStartEnd = FS_STATUS_START) then + begin ThreadFsStatusInfo.AddOrSetValue(GetCurrentThreadID(), InfoOperation); case InfoOperation of - FS_STATUS_OP_LIST: begin - if (SettingsManager.Settings.DescriptionEnabled) and RealPath.IsInAccount() then begin - if ConnectionManager.Get(RealPath.account, getResult).getDescriptionFile(IncludeTrailingBackslash(RealPath.Path) + SettingsManager.Settings.DescriptionFileName, CurrentDescriptions.ionFilename) then begin + FS_STATUS_OP_LIST: + begin + if (SettingsManager.Settings.DescriptionEnabled) and RealPath.IsInAccount() then + begin + if ConnectionManager.Get(RealPath.account, getResult).getDescriptionFile(IncludeTrailingBackslash(RealPath.Path) + SettingsManager.Settings.DescriptionFileName, CurrentDescriptions.ionFilename) then + begin CurrentDescriptions.Read; end else begin CurrentDescriptions.Clear; end; end; end; - FS_STATUS_OP_GET_SINGLE: begin + FS_STATUS_OP_GET_SINGLE: + begin ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); end; - FS_STATUS_OP_GET_MULTI: begin + FS_STATUS_OP_GET_MULTI: + begin ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); end; - FS_STATUS_OP_PUT_SINGLE: begin + FS_STATUS_OP_PUT_SINGLE: + begin ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); end; - FS_STATUS_OP_PUT_MULTI: begin + FS_STATUS_OP_PUT_MULTI: + begin ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); end; - FS_STATUS_OP_RENMOV_SINGLE: begin + FS_STATUS_OP_RENMOV_SINGLE: + begin end; - FS_STATUS_OP_RENMOV_MULTI: begin - if ConnectionManager.Get(RealPath.account, getResult).public_account then begin + FS_STATUS_OP_RENMOV_MULTI: + begin + if ConnectionManager.Get(RealPath.account, getResult).public_account then + begin TCLogger.Log(LOG_LEVEL_WARNING, MSGTYPE_IMPORTANTERROR, ERR_DIRECT_COPY_SUPPORT); ThreadSkipListRenMov.AddOrSetValue(GetCurrentThreadID, true); end; @@ -1476,38 +1552,51 @@ procedure TMailRuCloudWFX.FsStatusInfo(RemoteDir: WideString; InfoStartEnd, Info ThreadCanAbortRenMov.AddOrSetValue(GetCurrentThreadID, true); ThreadFsRemoveDirSkippedPath.AddOrSetValue(GetCurrentThreadID, TStringList.Create()); end; - FS_STATUS_OP_DELETE: begin + FS_STATUS_OP_DELETE: + begin //ThreadSkipListDelete.Add(GetCurrentThreadID()); ThreadSkipListDelete.AddOrSetValue(GetCurrentThreadID, true); end; - FS_STATUS_OP_ATTRIB: begin + FS_STATUS_OP_ATTRIB: + begin end; - FS_STATUS_OP_MKDIR: begin + FS_STATUS_OP_MKDIR: + begin end; - FS_STATUS_OP_EXEC: begin + FS_STATUS_OP_EXEC: + begin end; - FS_STATUS_OP_CALCSIZE: begin + FS_STATUS_OP_CALCSIZE: + begin end; - FS_STATUS_OP_SEARCH: begin + FS_STATUS_OP_SEARCH: + begin end; - FS_STATUS_OP_SEARCH_TEXT: begin + FS_STATUS_OP_SEARCH_TEXT: + begin end; - FS_STATUS_OP_SYNC_SEARCH: begin + FS_STATUS_OP_SYNC_SEARCH: + begin end; - FS_STATUS_OP_SYNC_GET: begin + FS_STATUS_OP_SYNC_GET: + begin end; - FS_STATUS_OP_SYNC_PUT: begin + FS_STATUS_OP_SYNC_PUT: + begin end; - FS_STATUS_OP_SYNC_DELETE: begin + FS_STATUS_OP_SYNC_DELETE: + begin end; - FS_STATUS_OP_GET_MULTI_THREAD: begin + FS_STATUS_OP_GET_MULTI_THREAD: + begin ThreadRetryCountDownload.AddOrSetValue(GetCurrentThreadID(), 0); if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then BackgroundJobsCount := 0; ThreadBackgroundJobs.AddOrSetValue(RealPath.account, BackgroundJobsCount + 1); ThreadBackgroundThreads.AddOrSetValue(GetCurrentThreadID(), FS_STATUS_OP_GET_MULTI_THREAD); end; - FS_STATUS_OP_PUT_MULTI_THREAD: begin + FS_STATUS_OP_PUT_MULTI_THREAD: + begin ThreadRetryCountUpload.AddOrSetValue(GetCurrentThreadID(), 0); if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then BackgroundJobsCount := 0; @@ -1517,28 +1606,36 @@ procedure TMailRuCloudWFX.FsStatusInfo(RemoteDir: WideString; InfoStartEnd, Info end; exit; end; - if (InfoStartEnd = FS_STATUS_END) then begin + if (InfoStartEnd = FS_STATUS_END) then + begin ThreadFsStatusInfo.Remove(GetCurrentThreadID); case InfoOperation of - FS_STATUS_OP_LIST: begin + FS_STATUS_OP_LIST: + begin end; - FS_STATUS_OP_GET_SINGLE: begin + FS_STATUS_OP_GET_SINGLE: + begin end; - FS_STATUS_OP_GET_MULTI: begin + FS_STATUS_OP_GET_MULTI: + begin end; - FS_STATUS_OP_PUT_SINGLE: begin + FS_STATUS_OP_PUT_SINGLE: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_PUT_MULTI: begin + FS_STATUS_OP_PUT_MULTI: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_RENMOV_SINGLE: begin + FS_STATUS_OP_RENMOV_SINGLE: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_RENMOV_MULTI: begin + FS_STATUS_OP_RENMOV_MULTI: + begin ThreadSkipListRenMov.AddOrSetValue(GetCurrentThreadID, false); ThreadCanAbortRenMov.AddOrSetValue(GetCurrentThreadID, false); @@ -1548,38 +1645,50 @@ procedure TMailRuCloudWFX.FsStatusInfo(RemoteDir: WideString; InfoStartEnd, Info if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_DELETE: begin + FS_STATUS_OP_DELETE: + begin ThreadSkipListDelete.AddOrSetValue(GetCurrentThreadID(), false); if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_ATTRIB: begin + FS_STATUS_OP_ATTRIB: + begin end; - FS_STATUS_OP_MKDIR: begin + FS_STATUS_OP_MKDIR: + begin end; - FS_STATUS_OP_EXEC: begin + FS_STATUS_OP_EXEC: + begin end; - FS_STATUS_OP_CALCSIZE: begin + FS_STATUS_OP_CALCSIZE: + begin end; - FS_STATUS_OP_SEARCH: begin + FS_STATUS_OP_SEARCH: + begin end; - FS_STATUS_OP_SEARCH_TEXT: begin + FS_STATUS_OP_SEARCH_TEXT: + begin end; - FS_STATUS_OP_SYNC_SEARCH: begin + FS_STATUS_OP_SYNC_SEARCH: + begin end; - FS_STATUS_OP_SYNC_GET: begin + FS_STATUS_OP_SYNC_GET: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_SYNC_PUT: begin + FS_STATUS_OP_SYNC_PUT: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_SYNC_DELETE: begin + FS_STATUS_OP_SYNC_DELETE: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; end; - FS_STATUS_OP_GET_MULTI_THREAD: begin + FS_STATUS_OP_GET_MULTI_THREAD: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then @@ -1588,7 +1697,8 @@ procedure TMailRuCloudWFX.FsStatusInfo(RemoteDir: WideString; InfoStartEnd, Info ThreadBackgroundThreads.Remove(GetCurrentThreadID()); end; - FS_STATUS_OP_PUT_MULTI_THREAD: begin + FS_STATUS_OP_PUT_MULTI_THREAD: + begin if RealPath.IsInAccount() and SettingsManager.Settings.LogUserSpace then ConnectionManager.Get(RealPath.account, getResult).logUserSpaceInfo; if not ThreadBackgroundJobs.TryGetValue(RealPath.account, BackgroundJobsCount) then @@ -1616,20 +1726,24 @@ function TMailRuCloudWFX.GetRemoteFile(RemotePath: TRealPath; LocalName, RemoteN Result := Cloud.getFile(WideString(RemotePath.Path), LocalName, resultHash); - if Result = FS_FILE_OK then begin + if Result = FS_FILE_OK then + begin Item := FindListingItemByPath(CurrentListing, RemotePath); {Дополнительно проверим CRC скачанного файла} - if SettingsManager.Settings.CheckCRC then begin + if SettingsManager.Settings.CheckCRC then + begin if (resultHash <> EmptyWideStr) and (Item.hash <> resultHash) then exit(FS_FILE_READERROR); end; - if SettingsManager.Settings.PreserveFileTime then begin + if SettingsManager.Settings.PreserveFileTime then + begin if Item.mtime <> 0 then SetAllFileTime(ExpandUNCFileName(LocalName), DateTimeToFileTime(UnixToDateTime(Item.mtime))); end; - if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then begin + if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then + begin Cloud.deleteFile(RemotePath.Path); if (SettingsManager.Settings.DescriptionTrackCloudFS and AccountSettings.GetAccountSettings(RemotePath.account).IsRemoteDescriptionsSupported) then DeleteRemoteFileDescription(RemotePath, Cloud); @@ -1651,7 +1765,8 @@ function TMailRuCloudWFX.PutRemoteFile(RemotePath: TRealPath; LocalName, RemoteN Cloud := ConnectionManager.Get(RemotePath.account, getResult); Result := Cloud.putFile(WideString(LocalName), RemotePath.Path); - if Result = FS_FILE_OK then begin + if Result = FS_FILE_OK then + begin TCProgress.Progress(PWideChar(LocalName), PWideChar(RemotePath.Path), 100); TCLogger.Log(LOG_LEVEL_FILE_OPERATION, MSGTYPE_TRANSFERCOMPLETE, '%s -> %s', [LocalName, RemoteName]); if CheckFlag(FS_COPYFLAGS_MOVE, CopyFlags) then @@ -1723,13 +1838,17 @@ function TMailRuCloudWFX.RenMoveFileViaHash(OldCloud, NewCloud: TCloudMailRu; Ol Result := FS_FILE_NOTSUPPORTED; if OverWrite and not(NewCloud.deleteFile(NewRealPath.Path)) then exit; - if OldCloud.statusFile(OldRealPath.Path, CurrentItem) then begin + if OldCloud.statusFile(OldRealPath.Path, CurrentItem) then + begin Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.Path)) + ExtractFileName(NewRealPath.Path)); - if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then begin + if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then + begin case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + OperationErrorModeAsk: + begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin case (MsgBox(ERR_CLONE_FILE_ASK, [TCloudMailRu.ErrorCodeText(Result)], ERR_OPERATION, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of ID_ABORT: Result := FS_FILE_USERABORT; @@ -1744,9 +1863,11 @@ function TMailRuCloudWFX.RenMoveFileViaHash(OldCloud, NewCloud: TCloudMailRu; Ol exit; OperationErrorModeAbort: exit(FS_FILE_USERABORT); - OperationErrorModeRetry: begin; + OperationErrorModeRetry: + begin; RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := ThreadRetryCountRenMov.Items[GetCurrentThreadID()] + 1; TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, CLONE_FILE_RETRY, [TCloudMailRu.ErrorCodeText(Result), ThreadRetryCountRenMov.Items[GetCurrentThreadID()], RetryAttempts]); Result := NewCloud.addFileByIdentity(CurrentItem, IncludeTrailingPathDelimiter(ExtractFileDir(NewRealPath.Path)) + ExtractFileName(NewRealPath.Path)); @@ -1777,7 +1898,8 @@ function TMailRuCloudWFX.RenMoveFileViaPublicLink(OldCloud, NewCloud: TCloudMail if OverWrite and not(NewCloud.deleteFile(NewRealPath.Path)) then exit; - if OldCloud.statusFile(OldRealPath.Path, CurrentItem) then begin + if OldCloud.statusFile(OldRealPath.Path, CurrentItem) then + begin if not CurrentItem.isPublished then //create temporary weblink begin NeedUnpublish := true; @@ -1788,12 +1910,15 @@ function TMailRuCloudWFX.RenMoveFileViaPublicLink(OldCloud, NewCloud: TCloudMail end; end; Result := CloneWeblink(NewCloud, OldCloud, NewRealPath.Path, CurrentItem, NeedUnpublish); - if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then begin + if not(Result in [FS_FILE_OK, FS_FILE_EXISTS]) then + begin case SettingsManager.Settings.OperationErrorMode of - OperationErrorModeAsk: begin + OperationErrorModeAsk: + begin - while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + while (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin case (MsgBox(ERR_PUBLISH_FILE_ASK, [TCloudMailRu.ErrorCodeText(Result)], ERR_PUBLISH_FILE, MB_ABORTRETRYIGNORE + MB_ICONERROR)) of ID_ABORT: Result := FS_FILE_USERABORT; @@ -1809,9 +1934,11 @@ function TMailRuCloudWFX.RenMoveFileViaPublicLink(OldCloud, NewCloud: TCloudMail exit; OperationErrorModeAbort: exit(FS_FILE_USERABORT); - OperationErrorModeRetry: begin; + OperationErrorModeRetry: + begin; RetryAttempts := SettingsManager.Settings.RetryAttempts; - while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do begin + while (ThreadRetryCountRenMov.Items[GetCurrentThreadID()] <> RetryAttempts) and (not(Result in [FS_FILE_OK, FS_FILE_USERABORT])) do + begin ThreadRetryCountRenMov.Items[GetCurrentThreadID()] := ThreadRetryCountRenMov.Items[GetCurrentThreadID()] + 1; TCLogger.Log(LOG_LEVEL_DETAIL, msgtype_details, PUBLISH_FILE_RETRY, [TCloudMailRu.ErrorCodeText(Result), ThreadRetryCountRenMov.Items[GetCurrentThreadID()], RetryAttempts]); Result := CloneWeblink(NewCloud, OldCloud, NewRealPath.Path, CurrentItem, NeedUnpublish);