(* Tux Commander - UCoreWorkers - worker threads, operations Copyright (C) 2009 Tomas Bzatek Check for updates on tuxcmd.sourceforge.net This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) unit UCoreWorkers; interface uses glib2, gtk2, SyncObjs, Classes, GTKForms, ULibc, UEngines, UCoreUtils, UVFSCore, uVFSprototypes, UCore, UDirDelete; type TWorkerThreadJobType = (WORKER_JOB_DUMMY, WORKER_JOB_DELETE, WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_EXTRACT_TO_TEMP, WORKER_JOB_MERGE, WORKER_JOB_SPLIT, WORKER_JOB_CHMOD, WORKER_JOB_CHOWN); type TVFSCallbackThread = class(TThread) private FThreadID: __pthread_t; FFinished: boolean; VFSCallbackEvent: TSimpleEvent; VFSAskQuestion_Message: PChar; VFSAskQuestion_Choices: PPChar; VFSAskQuestion_Choice: PInteger; VFSAskQuestion_Display: boolean; VFSAskPassword_Message: PChar; VFSAskPassword_default_user: PChar; VFSAskPassword_default_domain: PChar; VFSAskPassword_default_password: PChar; VFSAskPassword_flags: TVFSAskPasswordFlags; VFSAskPassword_username: PPChar; VFSAskPassword_password: PPChar; VFSAskPassword_anonymous: Pgboolean; VFSAskPassword_domain: PPChar; VFSAskPassword_password_save: PVFSPasswordSave; VFSAskPassword_Display: boolean; VFSAskPassword_Result: boolean; procedure PrepareExecute; // Call this right after thread has been started public FCancelled: boolean; AEngine: TPanelEngine; APlugin: TVFSPlugin; // VFS callback dialogs have been cancelled VFSCallbackCancelled: boolean; // Connection manager VFSConnectionManagerMode: boolean; VFSQuickConnectMode: boolean; // Set this to properly handle modal dialogs DialogsParentWindow: TCustomGTKForm; constructor Create(CreateSuspended: boolean); destructor Destroy; override; end; TWorkerThread = class(TVFSCallbackThread) private FGUIMutex: TCriticalSection; FCallbackLockEvent: TSimpleEvent; // Copy worker progress values FTotalSize, FTotalDone, FFileSize: cuLongLong; FCopySkipAllErrors: boolean; FCopyErrorHandledInProgress: boolean; FCopySilentCancel: boolean; FCopyProgressFunc: TEngineProgressFunc; FCopySourceFile, FCopyDestFile: string; // Dialogs FCancelMessage: string; FShowCancelMessage, FDialogShowDirDelete, FDialogShowOverwrite, FDialogShowNewDir, FDialogShowMsgBox, FDialogShowInaccessible: boolean; FDialogResultDirDelete, FDialogResultOverwrite, FDialogResultNewDir, FDialogResultInaccessible: integer; FProgress1Pos, FProgress2Pos, FProgress1Max, FProgress2Max: Int64; FProgress1Text, FProgress2Text, FLabel1Text, FLabel2Text: string; FGUIProgress1Pos, FGUIProgress2Pos, FGUIProgress1Max, FGUIProgress2Max: Int64; FGUIProgress1Text, FGUIProgress2Text, FGUILabel1Text, FGUILabel2Text: string; FGUIChanged: boolean; FDirDeleteButtonsType: TFDirDeleteButtonSet; FDirDeleteText1, FDirDeleteFileName, FDirDeleteText2: string; FOverwriteShowAppend: boolean; FOverwriteSourceItem, FOverwriteDestItem: PDataItem; FOverwriteSourceFile, FOverwriteDestFile, FOverwriteRenameStr: string; FInaccessiblePaths: TStringList; FNewDirCaption, FNewDirLabel, FNewDirEdit: string; FMsgBoxText: string; FMsgBoxButtons: TMessageButtons; FMsgBoxStyle: TMessageStyle; FMsgBoxDefault, FMsgBoxEscape, FDialogResultMsgBox: TMessageButton; procedure UpdateProgress1(const Progress: Int64; const ProgressText: string); procedure UpdateProgress2(const Progress: Int64; const ProgressText: string); procedure SetProgress1Params(const ProgressMax: Int64); procedure SetProgress2Params(const ProgressMax: Int64); procedure UpdateCaption1(const CaptionText: string); procedure UpdateCaption2(const CaptionText: string); function ShowDirDeleteDialog(ButtonsType: TFDirDeleteButtonSet; const Text1, FileName, Text2: string): integer; function ShowOverwriteDialog(ShowAppend: boolean; SourceItem, DestItem: PDataItem; const SourceFile, DestFile: string; var RenameStr: string): integer; function ShowInaccessibleDialog(InaccessiblePaths: TStringList): integer; function ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; function ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; Default, Escape: TMessageButton): TMessageButton; procedure DeleteFilesWorker; procedure CopyFilesWorker; procedure MergeFilesWorker; procedure SplitFilesWorker; procedure ChmodFilesWorker; procedure ChownFilesWorker; procedure DummyThreadWorker; protected procedure Execute; override; procedure CommitGUIUpdate; public JobType: TWorkerThreadJobType; SrcEngine, DestEngine: TPanelEngine; ErrorHappened: boolean; // checked in UMain // For getting list of selected items in the panel DataList: TList; SelectedItem: PDataItem; CopyTargetPath: string; QuickRenameDataItem: PDataItem; ExtractFromVFSAll: boolean; ExtractFile: string; // full path to the file to extract (to a temp directory) ChmodMode: cuLong; ChmodRecurseType: integer; ChownUID, ChownGID: cuLong; ChownRecursive: boolean; MergeTargetCRC: Cardinal; MergeHasInitialCRC: boolean; MergeTargetFinalName: string; MergeTargetSize: Int64; MergeSourceFile: string; MergeTargetPath: string; SplitDeleteTarget: boolean; SplitMaxSize: Int64; SplitSourceFile: string; SplitTargetPath: string; constructor Create; destructor Destroy; override; procedure PrepareJobFilesFromPanel(AList: TList; InaccessiblePaths: TStringList; DoNotRecurse: boolean); end; TOpenDirThread = class(TVFSCallbackThread) private function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): boolean; protected procedure Execute; override; public APath: string; ASelItem: string; AAutoFallBack: boolean; ADirList: TList; RunningTime: Int64; AFullPath, AHighlightItem: string; ChDirResult, ListingResult, VFSOpenResult: boolean; ChDirError, ListingError, VFSOpenError: PGError; constructor Create; destructor Destroy; override; end; TOpenConnectionThread = class(TVFSCallbackThread) private protected procedure Execute; override; public URI: string; OpenResult: boolean; OpenError: PGError; constructor Create; destructor Destroy; override; end; // Worker threads utilities // These should be called from main thread procedure ProcessThreadEvents(SenderThread: TVFSCallbackThread); implementation uses SysUtils, DateUtils, StrUtils, UConfig, UOverwrite, ULocale, UCoreClasses, URemoteWait, UMain, UGnome, UNewDir, UProgress, UError, crc; (********************************************************************************************************************************) constructor TVFSCallbackThread.Create(CreateSuspended: boolean); begin inherited Create(CreateSuspended); APlugin := nil; VFSCallbackEvent := TSimpleEvent.Create; VFSAskQuestion_Display := False; VFSAskPassword_Display := False; VFSCallbackCancelled := False; VFSConnectionManagerMode := False; VFSQuickConnectMode := False; DialogsParentWindow := FMain; FFinished := False; FCancelled := False; end; destructor TVFSCallbackThread.Destroy; begin VFSCallbackEvent.Free; inherited Destroy; end; procedure TVFSCallbackThread.PrepareExecute; begin FThreadID := pthread_self; VFSCallbackCancelled := False; end; (********************************************************************************************************************************) procedure vfs_ask_question_callback(const AMessage: PChar; const Choices: PPChar; choice: PInteger; cancel_choice: Integer; user_data: Pointer); cdecl; var Thread: TVFSCallbackThread; begin Thread := user_data; if (Thread = nil) { or (not (Thread is TVFSCallbackThread))} then begin DebugMsg(['(ERROR): vfs_ask_question_callback: user_data is not TVFSCallbackThread, exiting.']); Exit; end; if Thread.FCancelled then begin DebugMsg(['!! (WARNING): vfs_ask_question_callback: FCancelRequested.']); if (choice <> nil) then choice^ := -1; Thread.VFSCallbackCancelled := True; Exit; end; if pthread_self = Application.ThreadID then begin DebugMsg(['!! (WARNING): vfs_ask_question_callback called from the main thread, expected spawn from a TVFSCallbackThread']); HandleVFSAskQuestionCallback(Thread.DialogsParentWindow.FWidget, AMessage, Choices, choice); if (choice <> nil) then Thread.VFSCallbackCancelled := (choice^ < 0) or (choice^ = cancel_choice); Exit; end; if pthread_self = Thread.FThreadID then begin DebugMsg(['******* vfs_ask_question_callback spawned, user_data = ', user_data, ', ThreadID = ', pthread_self]); Thread.VFSAskQuestion_Message := AMessage; Thread.VFSAskQuestion_Choices := Choices; Thread.VFSAskQuestion_Choice := choice; Thread.VFSAskQuestion_Display := True; Thread.VFSCallbackEvent.ResetEvent; Thread.VFSCallbackEvent.WaitFor(INFINITE); DebugMsg(['******* thread: resuming...']); if (choice <> nil) then Thread.VFSCallbackCancelled := (choice^ < 0) or (choice^ = cancel_choice); Exit; end; DebugMsg(['!! (ERROR): vfs_ask_question_callback spawned neither from the main thread nor from active TVFSCallbackThread, dropping the callback to prevent data corruption.']); DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', TVFSCallbackThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); end; function vfs_ask_password_callback(const AMessage: PChar; const default_user: PChar; const default_domain: PChar; const default_password: PChar; flags: TVFSAskPasswordFlags; username, password: PPChar; anonymous: Pgboolean; domain: PPChar; password_save: PVFSPasswordSave; user_data: Pointer): gboolean; cdecl; var Thread: TVFSCallbackThread; def_pass: PChar; begin Result := False; Thread := user_data; if (Thread = nil) { or (not (Thread is TVFSCallbackThread))} then begin DebugMsg(['(ERROR): vfs_ask_question_callback: user_data is not TVFSCallbackThread, exiting.']); Exit; end; if Thread.FCancelled then begin DebugMsg(['!! (WARNING): vfs_ask_password_callback: FCancelRequested.']); Result := False; Thread.VFSCallbackCancelled := True; Exit; end; def_pass := default_password; // Disable password saving if requested if ConfConnMgrDoNotSynchronizeKeyring then begin flags := flags and (not VFS_ASK_PASSWORD_SAVING_SUPPORTED); if password_save <> nil then password_save^ := VFS_PASSWORD_SAVE_NEVER; end; if ConfConnMgrDoNotSavePasswords then flags := flags and (not VFS_ASK_PASSWORD_SAVE_INTERNAL) else if Thread.VFSConnectionManagerMode then flags := flags or VFS_ASK_PASSWORD_SAVE_INTERNAL; // Use stored password, if previously set if (((flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE) or Thread.VFSConnectionManagerMode or Thread.VFSQuickConnectMode) and (password <> nil) and (Thread.AEngine is TVFSEngine) and (Length((Thread.AEngine as TVFSEngine).Password) > 0) then begin if not (Thread.AEngine as TVFSEngine).PasswordUsed then begin DebugMsg([' (II) vfs_ask_password_callback: reusing manually set password']); password^ := g_strdup(PChar((Thread.AEngine as TVFSEngine).Password)); (Thread.AEngine as TVFSEngine).PasswordUsed := True; if (password_save <> nil) and Thread.VFSConnectionManagerMode then if ConfConnMgrDoNotSynchronizeKeyring then password_save^ := VFS_PASSWORD_SAVE_NEVER else password_save^ := VFS_PASSWORD_SAVE_PERMANENTLY; Thread.VFSCallbackCancelled := False; Result := True; Exit; end else if (flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE then def_pass := PChar((Thread.AEngine as TVFSEngine).Password); end; // Ask for password if pthread_self = Application.ThreadID then begin DebugMsg(['!! (WARNING): vfs_ask_password_callback called from the main thread, expected spawn from a TVFSCallbackThread']); Result := HandleVFSAskPasswordCallback(Thread.DialogsParentWindow.FWidget, AMessage, default_user, default_domain, def_pass, flags, username, password, anonymous, domain, password_save); Thread.VFSCallbackCancelled := Result = False; end else if pthread_self = Thread.FThreadID then begin DebugMsg(['******* vfs_ask_password_callback spawned, user_data = ', user_data, ', ThreadID = ', pthread_self, ', Application.ThreadID = ', Application.ThreadID]); Thread.VFSAskPassword_Message := AMessage; Thread.VFSAskPassword_default_user := default_user; Thread.VFSAskPassword_default_domain := default_domain; Thread.VFSAskPassword_default_password := def_pass; Thread.VFSAskPassword_flags := flags; Thread.VFSAskPassword_username := username; Thread.VFSAskPassword_password := password; Thread.VFSAskPassword_anonymous := anonymous; Thread.VFSAskPassword_domain := domain; Thread.VFSAskPassword_password_save := password_save; Thread.VFSAskPassword_Display := True; Thread.VFSAskPassword_Result := False; Thread.VFSCallbackEvent.ResetEvent; Thread.VFSCallbackEvent.WaitFor(INFINITE); DebugMsg(['******* thread: resuming...']); Result := Thread.VFSAskPassword_Result; Thread.VFSCallbackCancelled := Result = False; end else begin DebugMsg(['!! (ERROR): vfs_ask_password_callback spawned neither from the main thread nor from active TVFSCallbackThread, dropping the callback to prevent data corruption.']); DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', TVFSCallbackThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); end; // Save password back to the engine if Result and (password <> nil) and (strlen(password^) > 0) and (Thread.AEngine is TVFSEngine) and (((flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE) or (Thread.VFSConnectionManagerMode and (password_save <> nil) and (password_save^ = VFS_PASSWORD_SAVE_PERMANENTLY))) then begin (Thread.AEngine as TVFSEngine).Password := string(password^); (Thread.AEngine as TVFSEngine).PasswordUsed := True; end; // Strip password saving if requested if ConfConnMgrDoNotSynchronizeKeyring and (password_save <> nil) then password_save^ := VFS_PASSWORD_SAVE_NEVER; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.Execute; begin PrepareExecute; try case JobType of WORKER_JOB_DUMMY: DummyThreadWorker; WORKER_JOB_DELETE: DeleteFilesWorker; WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_EXTRACT_TO_TEMP: CopyFilesWorker; WORKER_JOB_MERGE: MergeFilesWorker; WORKER_JOB_SPLIT: SplitFilesWorker; WORKER_JOB_CHMOD: ChmodFilesWorker; WORKER_JOB_CHOWN: ChownFilesWorker; end; finally FFinished := True; end; end; constructor TWorkerThread.Create; begin inherited Create(True); FreeOnTerminate := False; FGUIMutex := TCriticalSection.Create; FCallbackLockEvent := TSimpleEvent.Create; DataList := nil; SelectedItem := nil; FShowCancelMessage := False; FDialogShowDirDelete := False; FDialogShowOverwrite := False; FDialogShowNewDir := False; FDialogShowMsgBox := False; FDialogShowInaccessible := False; ErrorHappened := False; FGUIChanged := False; FCopyProgressFunc := nil; JobType := WORKER_JOB_DUMMY; // Defaults, keep in sync with class interface CopyTargetPath := ''; FCopySkipAllErrors := False; QuickRenameDataItem := nil; ExtractFromVFSAll := False; ExtractFile := ''; ChmodMode := 0; ChmodRecurseType := -1; ChownUID := 0; ChownGID := 0; ChownRecursive := False; MergeTargetCRC := 0; MergeHasInitialCRC := False; MergeTargetFinalName := ''; MergeTargetSize := 0; MergeSourceFile := ''; MergeTargetPath := ''; SplitDeleteTarget := False; SplitMaxSize := 0; SplitSourceFile := ''; SplitTargetPath := ''; end; destructor TWorkerThread.Destroy; begin FGUIMutex.Free; FCallbackLockEvent.Free; inherited Destroy; end; procedure TWorkerThread.UpdateProgress1(const Progress: Int64; const ProgressText: string); begin // DebugMsg([' ** TWorkerThread.UpdateProgress1(Progress = ', Progress, ', ProgressText = ', ProgressText]); FProgress1Pos := Progress; FProgress1Text := ProgressText; end; procedure TWorkerThread.UpdateProgress2(const Progress: Int64; const ProgressText: string); begin // DebugMsg([' ** TWorkerThread.UpdateProgress2(Progress = ', Progress, ', ProgressText = ', ProgressText]); FProgress2Pos := Progress; FProgress2Text := ProgressText; end; procedure TWorkerThread.SetProgress1Params(const ProgressMax: Int64); begin FProgress1Max := ProgressMax; end; procedure TWorkerThread.SetProgress2Params(const ProgressMax: Int64); begin FProgress2Max := ProgressMax; end; procedure TWorkerThread.UpdateCaption1(const CaptionText: string); begin FLabel1Text := CaptionText; end; procedure TWorkerThread.UpdateCaption2(const CaptionText: string); begin FLabel2Text := CaptionText; end; procedure TWorkerThread.CommitGUIUpdate; begin FGUIMutex.Acquire; // WriteLn('TWorkerThread.CommitGUIUpdate, ted mam lock ja! -- enter'); FGUIProgress1Pos := FProgress1Pos; FGUIProgress2Pos := FProgress2Pos; FGUIProgress1Max := FProgress1Max; FGUIProgress2Max := FProgress2Max; FGUIProgress1Text := FProgress1Text; FGUIProgress2Text := FProgress2Text; FGUILabel1Text := FLabel1Text; FGUILabel2Text := FLabel2Text; FGUIChanged := True; // Sleep(1000); // WriteLn('TWorkerThread.CommitGUIUpdate, ted mam lock ja! -- leave'); FGUIMutex.Release; end; function TWorkerThread.ShowDirDeleteDialog(ButtonsType: TFDirDeleteButtonSet; const Text1, FileName, Text2: string): integer; begin FDialogResultDirDelete := DIR_DELETE_CANCEL; FDirDeleteText1 := Text1; FDirDeleteFileName := FileName; FDirDeleteText2 := Text2; FDirDeleteButtonsType := ButtonsType; FDialogShowDirDelete := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultDirDelete; end; function TWorkerThread.ShowOverwriteDialog(ShowAppend: boolean; SourceItem, DestItem: PDataItem; const SourceFile, DestFile: string; var RenameStr: string): integer; begin FDialogResultOverwrite := OVERWRITE_CANCEL; FOverwriteShowAppend := ShowAppend; FOverwriteSourceItem := SourceItem; FOverwriteDestItem := DestItem; FOverwriteSourceFile := SourceFile; FOverwriteDestFile := DestFile; FDialogShowOverwrite := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultOverwrite; RenameStr := FOverwriteRenameStr; end; function TWorkerThread.ShowInaccessibleDialog(InaccessiblePaths: TStringList): integer; begin FDialogResultInaccessible := 0; FInaccessiblePaths := InaccessiblePaths; FDialogShowInaccessible := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultInaccessible; end; function TWorkerThread.ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; begin FNewDirCaption := Caption; FNewDirLabel := LabelCaption; FNewDirEdit := Edit; FDialogShowNewDir := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultNewDir; end; function TWorkerThread.ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; Default, Escape: TMessageButton): TMessageButton; begin FMsgBoxText := Text; FMsgBoxButtons := Buttons; FMsgBoxStyle := Style; FMsgBoxDefault := Default; FMsgBoxEscape := Escape; FDialogShowMsgBox := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultMsgBox; end; (********************************************************************************************************************************) procedure TWorkerThread.PrepareJobFilesFromPanel(AList: TList; InaccessiblePaths: TStringList; DoNotRecurse: boolean); var i: longint; CurrPath: string; InputFiles: TStringList; begin InputFiles := TStringList.Create; CurrPath := IncludeTrailingPathDelimiter(AEngine.Path); // Process selected files first if DataList.Count > 0 then for i := 0 to DataList.Count - 1 do with PDataItem(DataList[i])^ do if (not UpDir) and Selected then InputFiles.Add(CurrPath + String(FName)); // If no files are selected, take into account the current active item if (InputFiles.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then InputFiles.Add(CurrPath + String(SelectedItem^.FName)); FillDirFiles(AEngine, AList, InputFiles, DoNotRecurse, InaccessiblePaths, @FCancelled); InputFiles.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ProcessThreadEvents(SenderThread: TVFSCallbackThread); var AFDirDelete: TFDirDelete; AFOverwrite: TFOverwrite; AFNewDir: TFNewDir; AFProgress: TFProgress; AFRemoteWait: TFRemoteWait; ParentDialogForm: TCustomGTKForm; b, ShowRemoteWait: boolean; StartTime: TDateTime; InfoLabelFormat: string; begin DebugMsg([' ** ProcessThreadEvents --begin']); ShowRemoteWait := False; AFProgress := nil; AFRemoteWait := nil; ParentDialogForm := SenderThread.DialogsParentWindow; StartTime := Now; if SenderThread is TWorkerThread then begin AFProgress := TFProgress.Create(SenderThread.DialogsParentWindow); ParentDialogForm := AFProgress; case (SenderThread as TWorkerThread).JobType of WORKER_JOB_DUMMY: AFProgress.Label1.Caption := ''; WORKER_JOB_DELETE: AFProgress.Label1.Caption := LANGDelete; WORKER_JOB_COPY: AFProgress.Label1.Caption := LANGCopySC; WORKER_JOB_MOVE: AFProgress.Label1.Caption := LANGMoveRenameSC; WORKER_JOB_EXTRACT_TO_TEMP: AFProgress.Label1.Caption := 'Extract:'; WORKER_JOB_MERGE: AFProgress.Label1.Caption := LANGMergeSC; WORKER_JOB_SPLIT: AFProgress.Label1.Caption := LANGSplitSC; WORKER_JOB_CHMOD: AFProgress.Label1.Caption := LANGChmodProgress; WORKER_JOB_CHOWN: AFProgress.Label1.Caption := LANGChownProgress; end; AFProgress.SetNumBars((SenderThread as TWorkerThread).JobType in [WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_MERGE]); AFProgress.ProgressBar.Fraction := 0; AFProgress.ProgressBar2.Fraction := 0; AFProgress.ShowModal; end else if SenderThread is TOpenDirThread then begin AFRemoteWait := TFRemoteWait.Create(SenderThread.DialogsParentWindow); end; repeat b := False; // * TODO: transform to GMainLoop Sleep(ConstInternalProgressTimer); // Check for cancellation if ((AFProgress <> nil) and AFProgress.Cancelled) or ((AFRemoteWait <> nil) and AFRemoteWait.Cancelled) then SenderThread.FCancelled := True; // Display busy wait dialog after timeout for some operations if (AFRemoteWait <> nil) and (not ShowRemoteWait) and (MilliSecondsBetween(StartTime, Now) >= ConstRemoteWaitDialogDelay) then begin AFRemoteWait.ShowModal; ShowRemoteWait := True; ParentDialogForm := AFRemoteWait; end; // Update progress bars if SenderThread is TWorkerThread then with SenderThread as TWorkerThread do begin FGUIMutex.Acquire; if FGUIChanged then begin if FGUIProgress1Max > 1 then AFProgress.ProgressBar.Fraction := FGUIProgress1Pos / FGUIProgress1Max else AFProgress.ProgressBar.Fraction := 0; AFProgress.ProgressBar.Text := FGUIProgress1Text; AFProgress.Label2.Caption := FGUILabel1Text; if AFProgress.FTwoBars then begin if FGUIProgress2Max > 1 then AFProgress.ProgressBar2.Fraction := FGUIProgress2Pos / FGUIProgress2Max else AFProgress.ProgressBar2.Fraction := 0; AFProgress.ProgressBar2.Text := FGUIProgress2Text; AFProgress.Label3.Caption := FGUILabel2Text; end; AFProgress.ProgressBar.Max := FGUIProgress1Max; AFProgress.ProgressBar2.Max := FGUIProgress2Max; FGUIChanged := False; end; FGUIMutex.Release; end; Application.ProcessMessages; // VFS callbacks if SenderThread.VFSAskQuestion_Display then begin SenderThread.VFSAskQuestion_Display := False; DebugMsg(['ProcessProgressThread - Main thread: displaying question dialog']); HandleVFSAskQuestionCallback(ParentDialogForm.FWidget, SenderThread.VFSAskQuestion_Message, SenderThread.VFSAskQuestion_Choices, SenderThread.VFSAskQuestion_Choice); SenderThread.VFSCallbackEvent.SetEvent; end; if SenderThread.VFSAskPassword_Display then begin SenderThread.VFSAskPassword_Display := False; DebugMsg(['ProcessProgressThread - Main thread: displaying password prompt']); SenderThread.VFSAskPassword_Result := HandleVFSAskPasswordCallback(ParentDialogForm.FWidget, SenderThread.VFSAskPassword_Message, SenderThread.VFSAskPassword_default_user, SenderThread.VFSAskPassword_default_domain, SenderThread.VFSAskPassword_default_password, SenderThread.VFSAskPassword_flags, SenderThread.VFSAskPassword_username, SenderThread.VFSAskPassword_password, SenderThread.VFSAskPassword_anonymous, SenderThread.VFSAskPassword_domain, SenderThread.VFSAskPassword_password_save); SenderThread.VFSCallbackEvent.SetEvent; end; Application.ProcessMessages; // DirDelete dialogs if SenderThread is TWorkerThread then with SenderThread as TWorkerThread do try if FDialogShowDirDelete then begin AFDirDelete := nil; try AFDirDelete := TFDirDelete.Create(ParentDialogForm); AFDirDelete.AddButtons(FDirDeleteButtonsType); AFDirDelete.Label1.Caption := FDirDeleteText1; AFDirDelete.Label2.Caption := FDirDeleteFileName; AFDirDelete.Label3.Caption := FDirDeleteText2; AFDirDelete.Label3.Visible := Length(FDirDeleteText2) > 0; FDialogResultDirDelete := Integer(AFDirDelete.Run); if (FDirDeleteButtonsType = DIR_DELETE_SET_COPY_ERROR) and (FDialogResultDirDelete = DIR_DELETE_IGNORE) and (JobType = WORKER_JOB_MOVE) then case Application.MessageBox(LANGIgnoreError, [mbYes, mbNo{, mbCancel}], mbWarning, mbYes, mbNo) of mbNo: FDialogResultDirDelete := DIR_DELETE_IGNORE; mbCancel: FDialogResultDirDelete := DIR_DELETE_SKIP; end; finally AFDirDelete.Free; end; FDialogShowDirDelete := False; b := True; end; if FDialogShowOverwrite then begin AFOverwrite := nil; try AFOverwrite := TFOverwrite.Create(ParentDialogForm); AFOverwrite.AddButtons(FOverwriteShowAppend); case ConfSizeFormat of 5: InfoLabelFormat := '%s, %s'; else InfoLabelFormat := LANGOvewriteSBytesS; end; AFOverwrite.FromLabel.Caption := Format(LANGOverwriteS, [StrToUTF8(FOverwriteSourceItem^.FDisplayName)]); AFOverwrite.FromInfoLabel.Caption := Format(InfoLabelFormat, [FormatSize(FOverwriteSourceItem^.Size, 0), FormatDate(FOverwriteSourceItem^.mtime, True, True)]); AFOverwrite.ToLabel.Caption := Format(LANGWithFileS, [StrToUTF8(FOverwriteDestItem^.FDisplayName)]); AFOverwrite.ToInfoLabel.Caption := Format(InfoLabelFormat, [FormatSize(FOverwriteDestItem^.Size, 0), FormatDate(FOverwriteDestItem^.mtime, True, True)]); AFOverwrite.RenameStr := ExtractFileName(FOverwriteDestFile); AFOverwrite.SourceFile := FOverwriteSourceFile; AFOverwrite.DestFile := FOverwriteDestFile; FDialogResultOverwrite := Integer(AFOverwrite.Run); FOverwriteRenameStr := UTF8ToStr(AFOverwrite.RenameStr); finally AFOverwrite.Free; end; FDialogShowOverwrite := False; b := True; end; if FDialogShowInaccessible then begin FDialogResultInaccessible := ShowInaccessiblePathsDialog(ParentDialogForm.FWidget, FInaccessiblePaths); FDialogShowInaccessible := False; b := True; end; if FDialogShowNewDir then begin AFNewDir := nil; try AFNewDir := TFNewDir.Create(ParentDialogForm); AFNewDir.Caption := FNewDirCaption; AFNewDir.Label1.Caption := FNewDirLabel; AFNewDir.Entry.Text := FNewDirEdit; AFNewDir.Entry.SelectAll; FDialogResultNewDir := Integer(AFNewDir.Run); FNewDirEdit := AFNewDir.Entry.Text; finally AFNewDir.Free; end; FDialogShowNewDir := False; b := True; end; if FDialogShowMsgBox then begin FDialogResultMsgBox := Application.MessageBox(PGtkWindow(ParentDialogForm.FWidget), FMsgBoxText, FMsgBoxButtons, FMsgBoxStyle, FMsgBoxDefault, FMsgBoxEscape); FDialogShowMsgBox := False; b := True; end; finally // Unlock the waiting worker thread if b then FCallbackLockEvent.SetEvent; end; until SenderThread.FFinished; if SenderThread is TWorkerThread then with SenderThread as TWorkerThread do if FShowCancelMessage then begin if FCancelMessage = LANGUserCancelled then Application.MessageBox(PGtkWindow(ParentDialogForm.FWidget), FCancelMessage, [mbOK], mbWarning, mbNone, mbOK) else Application.MessageBox(PGtkWindow(ParentDialogForm.FWidget), FCancelMessage, [mbOK], mbError, mbNone, mbOK); end; // Close all dialogs if AFProgress <> nil then begin AFProgress.Close; AFProgress.Free; end; if AFRemoteWait <> nil then begin AFRemoteWait.Close; AFRemoteWait.Free; end; DebugMsg([' ** ProcessThreadEvents --end']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.DeleteFilesWorker; var SkipAll: boolean; // Return False to break the operation function HandleDelete(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; Error: PGError; begin Result := True; Error := nil; // DebugMsg(['Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if AFileRec^.DataItem^.IsDir and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; Res := AEngine.Remove(String(AFileRec^.DataItem^.FName), @Error); if not Res then begin if SkipAll then Result := True else begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error deleting file/directory', AFileRec^.DataItem^.FDisplayName, Error^.message); g_error_free(Error); case Response of DIR_DELETE_SKIP : Result := True; DIR_DELETE_SKIP_ALL : begin SkipAll := True; Result := True; end; DIR_DELETE_RETRY : Result := HandleDelete(AFileRec); else Result := False; end; end; end; end; var i: longint; AList: TList; InaccessiblePaths: TStringList; CurrPath: string; Fr: Single; Response: integer; DeleteAll, SkipToNext: boolean; begin SkipAll := False; AList := TList.Create; InaccessiblePaths := TStringList.Create; CurrPath := IncludeTrailingPathDelimiter(AEngine.Path); PrepareJobFilesFromPanel(AList, InaccessiblePaths, False); // * TODO: catch the error if not AEngine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); libc_chdir('/'); // * TODO: show warning about inaccessible paths before deletion starts? SetProgress1Params(AList.Count); CommitGUIUpdate; DeleteAll := False; SkipToNext := False; DebugWriteListSL(AList); if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); if AList.Count > 0 then for i := 0 to AList.Count - 1 do begin if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; Break; end; if SkipToNext and (PDataItemSL(AList[i])^.Level > 1) then Continue; if SkipToNext and (PDataItemSL(AList[i])^.Level = 1) and (not PDataItemSL(AList[i])^.Stage1) then begin SkipToNext := False; Continue; end; // Check for non-empty directory if (not DeleteAll) and (PDataItemSL(AList[i])^.Level = 1) and PDataItemSL(AList[i])^.Stage1 and PDataItemSL(AList[i])^.DataItem^.IsDir and (not PDataItemSL(AList[i])^.DataItem^.IsLnk) and (i < AList.Count - 2) and (PDataItemSL(AList[i + 1])^.Level = 2) then begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_NON_EMPTY, 'The directory is not empty, do you want to delete it with all its files and subdirectories?', PDataItemSL(AList[i])^.DataItem^.FDisplayName, ''); case Response of DIR_DELETE_DELETE : ; // Do nothing in this case - I will not bother with changing the structure; it works :-) DIR_DELETE_ALL : DeleteAll := True; DIR_DELETE_SKIP : SkipToNext := True; else Break; end; end; // Process delete if not HandleDelete(AList[i]) then Break; UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); CommitGUIUpdate; end; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; InaccessiblePaths.Free; // * TODO: catch the error if not AEngine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure GetCopyProgressErrorLabels(Thread: TWorkerThread; Error: PGError; var s1, s2: string); begin if (Thread.JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) then s1 := LANGCopyError else s1 := LANGMoveError; s2 := Thread.FCopySourceFile; if (Error^.domain = TUXCMD_ERROR) then case TuxcmdErrorEnum(Error^.code) of TUXCMD_ERROR_ALLOC_FAILED: s1 := LANGMemoryAllocationFailed; TUXCMD_ERROR_SOURCE_OPEN: s1 := LANGCannotOpenSourceFile; TUXCMD_ERROR_TARGET_OPEN: begin s1 := LANGCannotOpenDestinationFile; s2 := Thread.FCopyDestFile; end; TUXCMD_ERROR_SOURCE_READ: s1 := LANGCannotReadFromSourceFile; TUXCMD_ERROR_TARGET_WRITE: begin s1 := LANGCannotWriteToDestinationFile; s2 := Thread.FCopyDestFile; end; TUXCMD_ERROR_SOURCE_CLOSE: s1 := LANGCannotCloseSourceFile; TUXCMD_ERROR_TARGET_CLOSE: begin s1 := LANGCannotCloseDestinationFile; s2 := Thread.FCopyDestFile; end; TUXCMD_ERROR_RENAME: begin s1 := 'Cannot move the file to'; s2 := Thread.FCopyDestFile; end; end; end; // Keep in sync with uVFSprototypes.pas/TVFSProgressCallback function vfs_copy_progress_callback(position: guint64; error: PGError; user_data: Pointer): gboolean; cdecl; begin Result := True; if not Assigned(user_data) then Exit; if Assigned(TWorkerThread(user_data).FCopyProgressFunc) then try Result := TWorkerThread(user_data).FCopyProgressFunc(user_data, position, error); except on E: Exception do DebugMsg(['*** Exception raised in vfs_copy_progress_callback(position=', position, ', user_data=', user_data, '): (', E.ClassName, '): ', E.Message]); end; end; // Keep in sync with UEngines.pas/TEngineProgressFunc function CopyFilesWorker_ProgressFunc(Sender: Pointer; BytesDone: Int64; Error: PGError): boolean; cdecl; var s, s2: string; begin Result := True; try if Assigned(Sender) and (TObject(Sender) is TWorkerThread) then with TWorkerThread(Sender) do begin Result := not FCancelled; if Error <> nil then begin // Error handling if FCopySkipAllErrors then Exit; if (g_error_matches (Error, TUXCMD_ERROR, gint(TUXCMD_ERROR_CANCELLED))) then begin FCopyErrorHandledInProgress := True; FCopySilentCancel := True; Result := False; Exit; end; GetCopyProgressErrorLabels(TWorkerThread(Sender), Error, s, s2); case ShowDirDeleteDialog(DIR_DELETE_SET_COPY_ERROR, s, s2, StrToUTF8(Error^.message)) of DIR_DELETE_IGNORE : Result := True; DIR_DELETE_SKIP : Result := False; DIR_DELETE_SKIP_ALL : begin FCopySkipAllErrors := True; Result := False; end; DIR_DELETE_CANCEL, 124, 255 : begin Result := False; FCancelled := True; end; else begin Result := False; // Cancel FCopySilentCancel := True; end; end; FCopyErrorHandledInProgress := not Result; end else begin // Progress update if (BytesDone = 0) or (FFileSize = 0) then UpdateProgress1(0, '0%') else UpdateProgress1(BytesDone, Format('%d%%', [Round(BytesDone / FFileSize * 100)])); if FTotalSize = 0 then UpdateProgress2(0, '0%') else UpdateProgress2(FTotalDone + BytesDone, Format('%d%%', [Round((FTotalDone + BytesDone) / FTotalSize * 100)])); CommitGUIUpdate; end; end else DebugMsg(['*** CopyFilesWorker: Sender is not TWorkerThread']); except on E: Exception do DebugMsg(['*** Exception raised in ProgressFunc(Sender=', Sender, ', BytesDone=', BytesDone, '): (', E.ClassName, '): ', E.Message]); end; end; procedure TWorkerThread.CopyFilesWorker; var DefResponse: integer; // Global variables for this function procedure PropagateMaskedCopyError(Error: PPGError; LocalError: PGError; MaskErrorCode: TuxcmdErrorEnum); begin // Mask everything except of cancellation codes if (g_error_matches (LocalError, TUXCMD_ERROR, gint(TUXCMD_ERROR_CANCELLED))) then g_propagate_error (Error, LocalError) else begin g_set_error(Error, TUXCMD_ERROR, gint(MaskErrorCode), LocalError^.message); g_error_free(LocalError); end; end; // Returns True if file was successfully copied, if not, the file will be deleted in LocalCopyFile function ManualCopyFile(SourceFile, DestFile: string; Append: boolean; Error: PPGError): boolean; var fsrc, fdst: TEngineFileDes; BSize: integer; Buffer: Pointer; BytesDone, BytesRead, BytesWritten, BytesRemaining: Int64; LocalError: PGError; begin Result := False; LocalError := nil; BytesDone := 0; DebugMsg(['ManualCopyFile: ', SourceFile, ' ---> ', DestFile]); fsrc := SrcEngine.OpenFile(SourceFile, omRead, @LocalError); if fsrc = nil then begin PropagateMaskedCopyError(Error, LocalError, TUXCMD_ERROR_SOURCE_OPEN); CopyFilesWorker_ProgressFunc(Self, 0, Error^); // Cannot open source file Exit; end; if Append then fdst := DestEngine.OpenFile(DestFile, omAppend, @LocalError) else fdst := DestEngine.OpenFile(DestFile, omWrite, @LocalError); if fdst = nil then begin SrcEngine.CloseFile(fsrc, nil); PropagateMaskedCopyError(Error, LocalError, TUXCMD_ERROR_TARGET_OPEN); CopyFilesWorker_ProgressFunc(Self, 0, Error^); // Cannot open target file Exit; end; BSize := DestEngine.GetBlockSize; Buffer := malloc(BSize); if Buffer = nil then begin g_set_error(Error, TUXCMD_ERROR, gint(TUXCMD_ERROR_ALLOC_FAILED), '%m'); CopyFilesWorker_ProgressFunc(Self, 0, Error^); // Memory allocation failed Exit; end; repeat // Read block BytesRead := SrcEngine.ReadFile(fsrc, Buffer, BSize, @LocalError); if BytesRead < 0 then begin PropagateMaskedCopyError(Error, LocalError, TUXCMD_ERROR_SOURCE_READ); LocalError := nil; Result := CopyFilesWorker_ProgressFunc(Self, BytesDone, Error^); // Cannot read from source file if Result then begin g_error_free(Error^); Error^ := nil; Continue; end else Break; end; // Write block if BytesRead > 0 then begin BytesRemaining := BytesRead; repeat BytesWritten := DestEngine.WriteFile(fdst, Buffer + (BytesRead - BytesRemaining), BytesRemaining, @LocalError); if BytesWritten > 0 then BytesRemaining := BytesRemaining - BytesWritten; until (BytesRemaining = 0) or (BytesWritten <= 0); if BytesWritten < 0 then begin PropagateMaskedCopyError(Error, LocalError, TUXCMD_ERROR_TARGET_WRITE); LocalError := nil; Result := False; CopyFilesWorker_ProgressFunc(Self, BytesDone, Error^); // Cannot write to target file Break; end; end; // BytesRead == 0 means EOF BytesDone := BytesDone + BytesRead; Result := CopyFilesWorker_ProgressFunc(Self, BytesDone, nil); if not Result then Break; until BytesRead <= 0; libc_free(Buffer); if not DestEngine.CloseFile(fdst, @LocalError) then if Result then begin PropagateMaskedCopyError(Error, LocalError, TUXCMD_ERROR_TARGET_CLOSE); Result := False; SrcEngine.CloseFile(fsrc, nil); CopyFilesWorker_ProgressFunc(Self, BytesDone, Error^); // Cannot close target file Exit; end; if not SrcEngine.CloseFile(fsrc, @LocalError) then if Result then begin PropagateMaskedCopyError(Error, LocalError, TUXCMD_ERROR_SOURCE_CLOSE); Result := CopyFilesWorker_ProgressFunc(Self, BytesDone, Error^); // Cannot close source file if Result then begin // user has chosen to ignore the error g_error_free(Error^); Error^ := nil; end else Exit; end; end; // Returns True if the file was successfully copied and will be deleted on move function LocalCopyFile(SourceFile, DestFile: string; Append: boolean; Error: PPGError): boolean; var DataSrc, DataDest: PDataItem; begin Result := False; try AEngine := nil; FCopyProgressFunc := CopyFilesWorker_ProgressFunc; // local -> local if (SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine) then Result := DestEngine.CopyFileIn(SourceFile, DestFile, Append, @CopyFilesWorker_ProgressFunc, Self, Error) else // TODO: check for reported Append capability and fall back to manual copy if needed // from local engine to VFS engine if (SrcEngine is TLocalTreeEngine) and (DestEngine is TVFSEngine) then begin AEngine := DestEngine; Result := (DestEngine as TVFSEngine).CopyFileInEx(SourceFile, DestFile, Append, Error); end else // from VFS engine to local (most common use) if (SrcEngine is TVFSEngine) and (DestEngine is TLocalTreeEngine) then begin AEngine := SrcEngine; Result := (SrcEngine as TVFSEngine).CopyFileOutEx(SourceFile, DestFile, Append, Error); end // VFS to VFS (mostly unsupported) else begin AEngine := SrcEngine; Result := ManualCopyFile(SourceFile, DestFile, Append, Error); end; AEngine := nil; // Copy OK? (check size, otherwise delete target file) if (not Append) and (not Result) then begin // * TODO: check error DataSrc := SrcEngine.GetFileInfo(SourceFile, False, True, nil); if DataSrc = nil then Exit; // * TODO: check error DataDest := DestEngine.GetFileInfo(DestFile, False, True, nil); if (DataDest <> nil) and (DataSrc^.Size <> DataDest^.Size) then // * TODO: check error DestEngine.Remove(DestFile, nil); FreeDataItem(DataSrc); FreeDataItem(DataDest); end; except on E: Exception do begin Result := False; tuxcmd_set_error_from_exception(Error, E); DebugMsg(['*** Exception raised in LocalCopyFile(SourceFile=', SourceFile, ', DestFile=', DestFile, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); end; end; end; function IsOnSameFS(SrcPath, DestPath: string): boolean; begin if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and ((SrcEngine as TVFSEngine).ArchivePath <> '') and ((SrcEngine as TVFSEngine).ArchivePath = (DestEngine as TVFSEngine).ArchivePath) then Result := True else Result := DestEngine.IsOnSameFS(SrcPath, DestPath, False); end; function TwoSameFiles(Path1, Path2: string; TestCaseInsensitiveFS: boolean): boolean; begin if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and ((SrcEngine as TVFSEngine).ArchiveMode <> (DestEngine as TVFSEngine).ArchiveMode) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and ((SrcEngine as TVFSEngine).ArchivePath <> '') and ((SrcEngine as TVFSEngine).ArchivePath <> (DestEngine as TVFSEngine).ArchivePath) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and not (SrcEngine as TVFSEngine).ArchiveMode and not (DestEngine as TVFSEngine).ArchiveMode and ((SrcEngine as TVFSEngine).GetPathURI <> (DestEngine as TVFSEngine).GetPathURI) then Result := False else if WideCompareStr(Path1, Path2) = 0 then Result := True else // * FIXME: causes stat errors, no need to check every file. Result := TestCaseInsensitiveFS and DestEngine.TwoSameFiles(Path1, Path2, False); end; function DoOperation(AFileRec: PDataItemSL; const Dst: string; const Append: boolean; Error: PPGError): boolean; begin Result := False; try with AFileRec^ do begin if DataItem^.IsLnk then begin // Explicit copy the file if (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) or (not IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst))) then begin Result := DestEngine.MakeSymLink(Dst, String(DataItem^.LnkPointTo), Error); if Result and (JobType = WORKER_JOB_MOVE) then Result := SrcEngine.Remove(String(DataItem^.FName), Error); end else begin // Move the file Result := DestEngine.RenameFile(String(DataItem^.FName), Dst, Error); end; end else // is not a symlink if (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) then begin // Copy mode Result := LocalCopyFile(String(DataItem^.FName), Dst, Append, Error); if Result then begin if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; // * TODO: check error DestEngine.Chmod(Dst, DataItem^.Mode, nil); DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID, nil); DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime, nil); end; end else // Move mode if IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst)) then begin if TwoSameFiles(String(DataItem^.FName), Dst, True) and (not TwoSameFiles(String(DataItem^.FName), Dst, False)) then begin DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); Result := DestEngine.RenameFile(String(DataItem^.FName), Dst + '_tcmd', Error); if Result then Result := DestEngine.RenameFile(Dst + '_tcmd', Dst, Error); end else Result := DestEngine.RenameFile(String(DataItem^.FName), Dst, Error); end else begin Result := LocalCopyFile(String(DataItem^.FName), Dst, Append, Error); if Result then begin if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; // * TODO: check error DestEngine.Chmod(Dst, DataItem^.Mode, nil); DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID, nil); DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime, nil); Result := SrcEngine.Remove(String(DataItem^.FName), Error); end; end; end; // DebugMsg(['(II) CopyFilesWorker.DoOperation: finished']); except on E: Exception do begin Result := False; tuxcmd_set_error_from_exception(Error, E); DebugMsg(['*** Exception raised in DoOperation(AFileRec=', AFileRec, ', Dst=', Dst, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); end; end; end; // Return False to break the processing (Cancel) function HandleCopy(AFileRec: PDataItemSL; NewFilePath: string): boolean; var Response: integer; Res: boolean; Item: PDataItem; s, s2, s3: string; RenameStr: string; Error: PGError; begin Result := True; Res := True; Error := nil; try // Second stage - change permissions if (not AFileRec^.Stage1) and ((JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) or (not AFileRec^.ForceMove)) then begin with AFileRec^ do begin if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; // * TODO: check error DestEngine.Chmod(NewFilePath, DataItem^.Mode, nil); DestEngine.Chown(NewFilePath, DataItem^.UID, DataItem^.GID, nil); DestEngine.ChangeTimes(NewFilePath, DataItem^.mtime, DataItem^.atime, nil); if JobType = WORKER_JOB_MOVE then Res := SrcEngine.Remove(String(DataItem^.FName), @Error); // Remove directory end; end else // First stage - copy data if AFileRec^.DataItem^.IsDir then begin if AFileRec^.ForceMove and (JobType = WORKER_JOB_MOVE) then begin if TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.DataItem^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), True) and (not TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.DataItem^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), False)) then begin DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); Res := DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', @Error); if Res then Res := DestEngine.RenameFile(ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), @Error); end else Res := DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), string(AFileRec^.ADestination), @Error); end else if not DestEngine.DirectoryExists(NewFilePath, False) then begin Res := DestEngine.MakeDir(NewFilePath, @Error); end; end else begin // not a directory if not DestEngine.DirectoryExists(ExtractFileDir(NewFilePath), False) then // * TODO: check error DestEngine.MakeDir(ExtractFileDir(NewFilePath), nil); SetProgress1Params(AFileRec^.DataItem^.Size + Ord(AFileRec^.DataItem^.Size = 0)); FFileSize := AFileRec^.DataItem^.Size; CopyFilesWorker_ProgressFunc(Self, 0, nil); // Overwrite handling if DestEngine.FileExists(NewFilePath, False) and (not ((JobType = WORKER_JOB_MOVE) and (not TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, False)) and TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, True))) then begin Response := DefResponse; Item := DestEngine.GetFileInfo(NewFilePath, False, True, @Error); if Item = nil then begin // Display an error and bail out Res := False; end else begin if Response = 0 then begin RenameStr := ExtractFileName(NewFilePath); Response := ShowOverwriteDialog(JobType in [WORKER_JOB_COPY], Item, AFileRec^.DataItem, NewFilePath, AFileRec^.DataItem^.FName, RenameStr); case Response of // OVERWRITE_OVERWRITE // OVERWRITE_SKIP OVERWRITE_OVERWRITE_ALL, OVERWRITE_OVERWRITE_ALL_OLDER, OVERWRITE_SKIP_ALL: DefResponse := Response; OVERWRITE_RENAME: begin NewFilePath := Copy(NewFilePath, 1, LastDelimiter(PathDelim, NewFilePath)) + RenameStr; FCopyDestFile := NewFilePath; // ... for the label Result := HandleCopy(AFileRec, NewFilePath); Exit; end; OVERWRITE_APPEND: Res := DoOperation(AFileRec, NewFilePath, True, @Error); OVERWRITE_CANCEL, 124 {Close Window}, 255, 252: begin Result := False; Exit; end; end; end; // Remove destination file if exists and should be overwritten if (Response in [OVERWRITE_OVERWRITE, OVERWRITE_OVERWRITE_ALL]) or ((Response = OVERWRITE_OVERWRITE_ALL_OLDER) and (Item^.mtime < AFileRec^.DataItem^.mtime)) then begin while not DestEngine.Remove(NewFilePath, @Error) do begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error deleting file', StrToUTF8(String(NewFilePath)), Error^.message); g_error_free(Error); Error := nil; case Response of DIR_DELETE_SKIP: begin Result := True; Exit; end; DIR_DELETE_RETRY: ; // Continue DIR_DELETE_CANCEL, 124, 255: begin Result := False; Exit; end; else begin // Cancel Result := False; Exit; end; end; end; Res := DoOperation(AFileRec, NewFilePath, False, @Error); end; end; end else Res := DoOperation(AFileRec, NewFilePath, False, @Error); end; // Error handling if FCancelled then Exit; if (not Res) and (not FCopySkipAllErrors) then begin if FCopyErrorHandledInProgress then begin if FCopySilentCancel then Result := False; // Break the processing Exit; end; if (g_error_matches (Error, TUXCMD_ERROR, gint(TUXCMD_ERROR_CANCELLED))) then begin Result := False; Exit; end; GetCopyProgressErrorLabels(Self, Error, s, s2); s3 := StrToUTF8(Error^.message); if (Error^.domain = TUXCMD_ERROR) then case TuxcmdErrorEnum(Error^.code) of TUXCMD_ERROR_SYMLINK: begin s := LANGTheSymbolicLink; s2 := FCopyDestFile; s3 := Format(LANGCouldNotBeCreatedS, [StrToUTF8(Error^.message)]); end; TUXCMD_ERROR_MKDIR: begin s := LANGTheDirectory; s2 := FCopyDestFile; s3 := Format(LANGCouldNotBeCreatedS, [StrToUTF8(Error^.message)]); end; TUXCMD_ERROR_REMOVE: begin if AFileRec^.DataItem^.IsDir then s := LANGTheDirectory else if AFileRec^.DataItem^.IsLnk then s := LANGTheSymbolicLink else s := LANGTheFile; s2 := FCopyDestFile; s3 := Format(LANGCouldNotBeDeletedS, [StrToUTF8(Error^.message)]); end; end; Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, s, s2, s3); case Response of DIR_DELETE_SKIP : Result := True; // Skip DIR_DELETE_RETRY : Result := HandleCopy(AFileRec, NewFilePath); // Retry DIR_DELETE_SKIP_ALL : begin // Skip All FCopySkipAllErrors := True; Result := True; end; 0, 124, 255 : Result := False; // Cancel else begin Result := False; end; end; end; // DebugMsg(['(II) CopyFilesWorker.HandleCopy: finished']); except on E: Exception do DebugMsg(['*** Exception raised in HandleCopy(AFileRec=', AFileRec, ', NewFilePath=', NewFilePath, '): (', E.ClassName, '): ', E.Message]); end; end; // Can be called only once, otherwise sorting will fail and extract errors may appear // TODO: make this universal // TODO: this is complete mess, make it more clear procedure HandleProcessPattern(AList: TList; InaccessiblePaths: TStringList; CurrPath, FullPath, ParamFileName: string; ParamDir, Ren: boolean); var s, s2: string; b, CaseInsensitiveRename: boolean; Info: PDataItemSL; InputFiles: TStringList; begin InputFiles := TStringList.Create; if not Ren then begin InputFiles.Add(FullPath); end else begin s := ProcessPattern(DestEngine, CopyTargetPath, CurrPath, ParamFileName, ParamDir); CaseInsensitiveRename := (WideCompareStr(CopyTargetPath, ParamFileName) <> 0) and (WideCompareText(CopyTargetPath, ParamFileName) = 0) and ParamDir and DestEngine.TwoSameFiles(IncludeTrailingPathDelimiter(CurrPath) + CopyTargetPath, IncludeTrailingPathDelimiter(CurrPath) + ParamFileName, False); // DebugMsg(['HandleProcessPattern: s = ', s]); b := False; if ParamDir then begin b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s), False) and (not CaseInsensitiveRename); if (not b) and (s <> '/') then begin s2 := ExcludeTrailingPathDelimiter(s); s2 := ExcludeTrailingPathDelimiter(Copy(s2, 1, LastDelimiter('/', s2))); b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s2), False); end; end; if (not ParamDir) or (ParamDir and b and IsOnSameFS(ExcludeTrailingPathDelimiter(FullPath), s2)) then begin Info := GetFileInfoSL(SrcEngine, FullPath); if Info = nil then begin InaccessiblePaths.Add(FullPath); DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']); ErrorHappened := True; end else begin Info^.ADestination := strdup(PChar(s)); Info^.ForceMove := True; AList.Add(Info); end; end else InputFiles.Add(FullPath); end; FillDirFiles(SrcEngine, AList, InputFiles, False, InaccessiblePaths, @FCancelled); InputFiles.Free; end; var i: longint; List: TList; InaccessiblePaths: TStringList; SkipInaccessible: boolean; CurrPath, SaveDestPath, SaveSrcPath, s: string; StartPassed: boolean; begin FCopySilentCancel := False; List := TList.Create; InaccessiblePaths := TStringList.Create; ErrorHappened := False; SaveSrcPath := ''; CurrPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SaveDestPath := DestEngine.Path; CopyTargetPath := ExcludeTrailingPathDelimiter(CopyTargetPath); if CopyTargetPath = '' then CopyTargetPath := PathDelim; // '/' // Prepare list of files to copy if JobType = WORKER_JOB_EXTRACT_TO_TEMP then begin if not ExtractFromVFSAll then HandleProcessPattern(List, InaccessiblePaths, CurrPath, ExtractFile, ExtractFileName(ExtractFile), False, False) else begin SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SrcEngine.SetPath('/'); CurrPath := '/'; HandleProcessPattern(List, InaccessiblePaths, '/', '/', '', True, False); end; end else if QuickRenameDataItem <> nil then begin // Quick-Rename with QuickRenameDataItem^ do HandleProcessPattern(List, InaccessiblePaths, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), True); end else begin // Not Quick-Rename if JobType <> WORKER_JOB_EXTRACT_TO_TEMP then begin if DataList.Count > 0 then for i := 0 to DataList.Count - 1 do with PDataItem(DataList[i])^ do if (not UpDir) and Selected then HandleProcessPattern(List, InaccessiblePaths, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), JobType = WORKER_JOB_MOVE); if (List.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then with SelectedItem^ do HandleProcessPattern(List, InaccessiblePaths, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), JobType = WORKER_JOB_MOVE); end else begin // Extract from VFS mode DebugMsg(['CopyFilesWorker: Should not be reached']); if (not ExtractFromVFSAll) and Assigned(SelectedItem) then HandleProcessPattern(List, InaccessiblePaths, CurrPath, CurrPath + String(SelectedItem^.FName), String(SelectedItem^.FName), SelectedItem^.IsDir and (not SelectedItem^.IsLnk), JobType = WORKER_JOB_MOVE) else begin SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SrcEngine.SetPath('/'); CurrPath := '/'; HandleProcessPattern(List, InaccessiblePaths, '/', '/', '', True, False); end; end; end; // * TODO: cancellation check { if DestEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); } // For streaming type archives the list of files to copy strictly needs to be sorted globally according to inode_no if (SrcEngine is TVFSEngine) and (SrcEngine as TVFSEngine).ArchiveMode and (SrcEngine as TVFSEngine).ArchiveStreamingType then begin DebugMsg(['Archive type is streaming, performing global filelist sort...']); FillDirFiles_sort(List); end; DebugWriteListSL(List); SkipInaccessible := False; if InaccessiblePaths.Count > 0 then SkipInaccessible := ShowInaccessibleDialog(InaccessiblePaths) <> 1; if not SkipInaccessible then begin __chdir('/'); // Compute total size of files to copy FTotalSize := 0; FTotalDone := 0; if List.Count > 0 then for i := 0 to List.Count - 1 do if PDataItemSL(List[i])^.Stage1 and (PDataItemSL(List[i])^.DataItem^.Size > 0) and (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) then FTotalSize := FTotalSize + PDataItemSL(List[i])^.DataItem^.Size; SrcEngine.BlockSize := ComputeBlockSize(FTotalSize); DestEngine.BlockSize := ComputeBlockSize(FTotalSize); // Prepare the Progress window SetProgress2Params(FTotalSize + Ord(FTotalSize = 0)); UpdateProgress1(0, '0%'); UpdateProgress2(0, '0%'); CommitGUIUpdate; DefResponse := 0; FCopySkipAllErrors := False; if List.Count > 0 then begin StartPassed := True; if SrcEngine is TVFSEngine then StartPassed := StartPassed and (SrcEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, Self); if DestEngine is TVFSEngine then StartPassed := StartPassed and (DestEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, Self); if StartPassed then for i := 0 to List.Count - 1 do begin if Assigned(PDataItemSL(List[i])^.ADestination) then s := string(PDataItemSL(List[i])^.ADestination) else begin s := ProcessPattern(DestEngine, CopyTargetPath, CurrPath, Copy(PDataItemSL(List[i])^.DataItem^.FName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.DataItem^.FName) - Length(CurrPath)), PDataItemSL(List[i])^.DataItem^.IsDir and (not PDataItemSL(List[i])^.DataItem^.IsLnk)); // DebugMsg(['s2 = ', Copy(PDataItemSL(List[i])^.AName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.AName) - Length(CurrPath)), ', s = ', s]); end; if not (SrcEngine is TVFSEngine) then FCopySourceFile := string(PDataItemSL(List[i])^.DataItem^.FDisplayName) else if (SrcEngine as TVFSEngine).ArchiveMode then FCopySourceFile := Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.DataItem^.FDisplayName)]) else FCopySourceFile := GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.DataItem^.FDisplayName)); if not (DestEngine is TVFSEngine) then FCopyDestFile := StrToUTF8(s) else if (DestEngine as TVFSEngine).ArchiveMode then FCopyDestFile := Format(ConstFullPathFormatStr, [(DestEngine as TVFSEngine).ArchivePath, StrToUTF8(s)]) else FCopyDestFile := GetURIPrefix((DestEngine as TVFSEngine).GetPathURI) + StrToUTF8(s); UpdateCaption1(Format(LANGFromS, [FCopySourceFile])); UpdateCaption2(Format(LANGToS, [FCopyDestFile])); CommitGUIUpdate; if TwoSameFiles(s, string(PDataItemSL(List[i])^.DataItem^.FName), (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP])) and (not PDataItemSL(List[i])^.DataItem^.IsDir) then begin FCancelMessage := LANGCannotCopyFileToItself; FShowCancelMessage := True; ErrorHappened := True; Break; end; // * FIXME: why the hell we had something like this here?? // if s <> string(PDataItemSL(List[i])^.DataItem^.FName) then if not HandleCopy(List[i], s) then begin ErrorHappened := True; Break; // Cancelled end; if (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) then FTotalDone := FTotalDone + PDataItemSL(List[i])^.DataItem^.Size; if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; ErrorHappened := True; Break; end; end; // We need to ensure these to be called in case of error if SrcEngine is TVFSEngine then (SrcEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, Self); if DestEngine is TVFSEngine then (DestEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, Self); end; end; // Free the objects if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); List.Clear; List.Free; InaccessiblePaths.Free; // * TODO: check error if not DestEngine.ChangeDir(SaveDestPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); if SaveSrcPath <> '' then CurrPath := SaveSrcPath; // * TODO: check error if not SrcEngine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); DebugMsg(['(II) CopyFilesWorker: finished']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.MergeFilesWorker; var FD: TEngineFileDes; Count, MergeBlockSize: integer; Buffer: Pointer; CurrentCRC: LongWord; PrivateCancel: boolean; SizeDone: Int64; TargetName: string; function PasteFile(FName: string): boolean; var FDR: TEngineFileDes; wCount: integer; Stat: PDataItem; Error: PGError; begin Result := False; Error := nil; if MergeHasInitialCRC then UpdateCaption2(Format(LANGToS, [StrToUTF8(FName)])) else UpdateCaption1(Format(LANGFromS, [StrToUTF8(FName)])); UpdateProgress1(0, '0 %'); CommitGUIUpdate; Stat := AEngine.GetFileInfo(FName, True, True, nil); if not Assigned(Stat) then Exit; SetProgress1Params(Stat^.Size); FreeDataItem(Stat); FDR := AEngine.OpenFile(FName, omRead, @Error); if FDR = nil then Exit; repeat Count := AEngine.ReadFile(FDR, Buffer, MergeBlockSize, @Error); if Error <> nil then begin AEngine.CloseFile(FD, nil); Exit; end; wCount := AEngine.WriteFile(FD, Buffer, Count, @Error); if (Error <> nil) or (Count <> wCount) then begin FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [ExtractFileName(TargetName), Error^.message]); FShowCancelMessage := True; PrivateCancel := True; Result := True; // Fake this to don't show next disc dialog g_error_free(Error); Exit; end; CurrentCRC := CRC32(CurrentCRC, Buffer, Count); UpdateProgress1(FProgress1Pos + Count, Format('%d %%', [Trunc((FProgress1Pos + Count) / FProgress1Max * 100)])); SizeDone := SizeDone + Count; if MergeHasInitialCRC then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FProgress2Max * 100)])); CommitGUIUpdate; until (Count < MergeBlockSize) or FCancelled; AEngine.CloseFile(FDR, nil); Result := True; end; var CurrFile, SourcePath, TargetFinalName: string; HasFinalCRC, b: boolean; Stat: PDataItem; Error: PGError; begin Error := nil; HasFinalCRC := MergeHasInitialCRC; TargetFinalName := MergeTargetFinalName; if (Length(MergeSourceFile) > 4) and (WideUpperCase(RightStr(MergeSourceFile, 4)) = '.CRC') then CurrFile := ChangeFileExt(ExtractFileName(MergeSourceFile), '.001') else CurrFile := ExtractFileName(MergeSourceFile); SourcePath := ExtractFilePath(MergeSourceFile); if MergeTargetFinalName = '' then MergeTargetFinalName := ChangeFileExt(ExtractFileName(MergeSourceFile), '.out'); TargetName := ProcessPattern(AEngine, MergeTargetPath, AEngine.Path, MergeTargetFinalName, False); if AEngine.FileExists(TargetName, False) then if ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(TargetName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes then begin if not AEngine.Remove(TargetName, @Error) then begin FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), Error^.message]); FShowCancelMessage := True; g_error_free(Error); Exit; end; end else Exit; Stat := AEngine.GetFileInfo(MergeSourceFile, True, True, nil); if Assigned(Stat) then MergeBlockSize := ComputeBlockSize(Stat^.Size) else MergeBlockSize := 65536*4; FreeDataItem(Stat); try Buffer := malloc(MergeBlockSize); memset(Buffer, 0, MergeBlockSize); except FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; FShowCancelMessage := True; Exit; end; FD := AEngine.OpenFile(TargetName, omWrite, @Error); if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), Error^.message]); FShowCancelMessage := True; libc_free(Buffer); g_error_free(Error); Exit; end; CurrentCRC := 0; SizeDone := 0; PrivateCancel := False; if MergeHasInitialCRC then begin SetProgress2Params(MergeTargetSize); UpdateProgress2(0, '0 %'); UpdateCaption2(Format(LANGFromS, [StrToUTF8(TargetName)])); CommitGUIUpdate; end; { else begin Label2.XAlign := 0; Label2.XPadding := 20; end; } repeat b := PasteFile(IncludeTrailingPathDelimiter(SourcePath) + CurrFile); if not b then begin PrivateCancel := ShowNewDirDialog(LANGMergeCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(SourcePath)) <> integer(mbOK); if not PrivateCancel then begin SourcePath := UTF8ToStr(FNewDirEdit); if not HasFinalCRC then HasFinalCRC := CRCGetInfo(IncludeTrailingPathDelimiter(SourcePath) + CurrFile, AEngine, TargetFinalName, MergeTargetCRC, MergeTargetSize); Continue; end; end; try CurrFile := Copy(CurrFile, 1, LastDelimiter('.', CurrFile)) + Format('%.3d', [StrToInt( Copy(CurrFile, LastDelimiter('.', CurrFile) + 1, Length(CurrFile) - LastDelimiter('.', CurrFile))) + 1]); except CurrFile := ''; end; until (SizeDone = MergeTargetSize) or FCancelled or PrivateCancel {or ((not b) and (not HasInitialCRC))} or (CurrFile = ''); libc_free(Buffer); if (not MergeHasInitialCRC) and HasFinalCRC then begin if not AEngine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName, @Error) then begin FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [StrToUTF8(ExtractFileName(TargetName)), Error^.message]); FShowCancelMessage := True; g_error_free(Error); AEngine.CloseFile(FD, nil); Exit; end; end; if FCancelled and (not PrivateCancel) then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; end; if not (FCancelled or PrivateCancel) then if HasFinalCRC then begin if CurrentCRC = MergeTargetCRC then ShowMessageBox(Format(LANGMergeOfSSucceeded, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK) else ShowMessageBox(LANGWarningCreatedFileFailsCRCCheck, [mbOK], mbWarning, mbNone, mbOK); end else ShowMessageBox(Format(LANGMergeOfSSucceeded_NoCRCFileAvailable, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK); if not AEngine.CloseFile(FD, @Error) then begin FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [StrToUTF8(ExtractFileName(TargetName)), Error^.message]); FShowCancelMessage := True; g_error_free(Error); end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.SplitFilesWorker; const SplitBlockSize = 65536*4; var FD: TEngineFileDes; FileCRC: LongWord; Buffer: Pointer; PrivateCancel: boolean; FilePath: string; SizeDone, TDF, FileSize, CurrSize: Int64; Error: PGError; function WriteSplitPart(TargetFile: string; PartSize: Int64; var Written: Int64): boolean; var FDW: TEngineFileDes; Count, wCount, bl: integer; begin Result := False; Written := 0; DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); FDW := AEngine.OpenFile(TargetFile, omWrite, @Error); if Error <> nil then Exit; if SplitMaxSize > 0 then begin UpdateCaption2(Format(LANGToS, [StrToUTF8(TargetFile)])); SetProgress1Params(PartSize); UpdateProgress1(0, '0 %'); end else UpdateCaption1(Format(LANGToS, [StrToUTF8(TargetFile)])); CommitGUIUpdate; repeat DebugMsg(['Seek to ', AEngine.FileSeek(FD, SizeDone + Written, @Error), ', Written = ', Written]); if Error <> nil then begin AEngine.CloseFile(FDW, nil); Exit; end; if Written + SplitBlockSize > PartSize then bl := PartSize - Written else bl := SplitBlockSize; Count := AEngine.ReadFile(FD, Buffer, bl, @Error); if (Error <> nil) or (Count <> bl) then begin AEngine.CloseFile(FDW, nil); if Error <> nil then DebugMsg(['Read Error: ', Error^.message, ', Count = ', Count, ', bl = ', bl]); Exit; end; wCount := AEngine.WriteFile(FDW, Buffer, Count, @Error); Written := Written + wCount; FileCRC := CRC32(FileCRC, Buffer, wCount); if (Error <> nil) or (Count <> wCount) then begin AEngine.CloseFile(FDW, nil); if Error <> nil then DebugMsg(['Write Error: ', Error^.message, ', Count = ', Count, ', wCount = ', wCount]); Exit; end; UpdateProgress1(FProgress1Pos + wCount, Format('%d %%', [Trunc((FProgress1Pos + wCount) / FProgress1Max * 100)])); if SplitMaxSize > 0 then UpdateProgress2(FProgress2Pos + wCount, Format('%d %%', [Trunc((FProgress2Pos + wCount) / FProgress2Max * 100)])); CommitGUIUpdate; until (Written = PartSize) or FCancelled or PrivateCancel; if not AEngine.CloseFile(FDW, @Error) then Exit; DebugMsg(['-- Closing file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize, ', Written = ', Written]); Result := True; end; // Returns True if it should break the process function NewDiskQuestion: boolean; var x: Int64; xx: string; begin Result := False; AEngine.GetFileSystemInfo(FilePath, x, TDF, xx); // Calculate part size if SplitMaxSize = 0 then begin if FileSize - SizeDone > TDF then CurrSize := TDF else CurrSize := FileSize - SizeDone; end else if SizeDone + SplitMaxSize > FileSize then CurrSize := FileSize - SizeDone else CurrSize := SplitMaxSize; if (TDF < 512) {or (CurrSize < 512)} or (TDF < CurrSize) then begin DebugMsg(['-- New disk question']); libc_chdir('/'); PrivateCancel := ShowNewDirDialog(LANGSplitCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(FilePath)) <> integer(mbOK); if not PrivateCancel then FilePath := UTF8ToStr(FNewDirEdit); Result := PrivateCancel; end; end; var i: integer; OriginalFName, st, FileName: string; ws: Int64; Stat: PDataItem; b: boolean; List: TList; x: Int64; xx: string; begin Error := nil; Stat := AEngine.GetFileInfo(SplitSourceFile, True, True, @Error); if not Assigned(Stat) then begin FCancelMessage := Format('Cannot open file ''%s'': %s', [StrToUTF8(SplitSourceFile), Error^.message]); FShowCancelMessage := True; g_error_free(Error); Exit; end; if (SplitMaxSize > 0) and (Stat^.Size > SplitMaxSize * 999) then begin FCancelMessage := LANGCannotSplitTheFileToMoreThan999Parts; FShowCancelMessage := True; Exit; end; FileSize := Stat^.Size; FreeDataItem(Stat); SizeDone := 0; FileCRC := 0; List := TList.Create; try Buffer := malloc(SplitBlockSize); memset(Buffer, 0, SplitBlockSize); except FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; FShowCancelMessage := True; Exit; end; FD := AEngine.OpenFile(SplitSourceFile, omRead, @Error); if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(SplitSourceFile), Error^.message]); libc_free(Buffer); g_error_free(Error); Exit; end; FilePath := IncludeTrailingPathDelimiter(ProcessPattern(AEngine, SplitTargetPath, AEngine.Path, '', True)); FileName := ExtractFileName(SplitSourceFile); OriginalFName := FileName; if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.001') else FileName := FileName + '.001'; PrivateCancel := False; if SplitMaxSize > 0 then begin SetProgress2Params(FileSize); UpdateProgress2(0, '0 %'); end else begin SetProgress1Params(FileSize); UpdateProgress1(0, '0 %'); end; UpdateCaption1(Format(LANGFromS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + OriginalFName)])); CommitGUIUpdate; repeat AEngine.GetFileSystemInfo(FilePath, x, TDF, xx); // Delete target files if necessary if SplitDeleteTarget and ((TDF < 512) or (TDF < FileSize) or (TDF < SplitMaxSize)) then try if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); List.Clear; b := AEngine.GetListing(List, FilePath, ConfShowDotFiles, False, False, nil); if b and (List.Count > 0) then begin st := ''; if List.Count < 6 then begin for i := 0 to List.Count - 1 do st := st + ' ' + string(PDataItem(List[i])^.FDisplayName) + #10; b := ShowMessageBox(Format(LANGThereAreSomeFilesInTheTargetDirectorySDoYouWantToDeleteThem, [StrToUTF8(st)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; end else b := ShowMessageBox(Format(LANGThereAreDFilesInTheTargetDirectoryDoYouWantToDeleteThem, [List.Count]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; if b then for i := 0 to List.Count - 1 do begin if not AEngine.Remove(IncludeTrailingPathDelimiter(FilePath) + string(PDataItem(List[i])^.FName), @Error) then begin ShowMessageBox(Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath)) + string(PDataItem(List[i])^.FDisplayName), Error^.message]), [mbOK], mbError, mbNone, mbOK); g_error_free(Error); Error := nil; end; end; end; except end; // Test for target file existence if AEngine.FileExists(IncludeTrailingPathDelimiter(FilePath) + FileName, False) then begin b := ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; if b then begin if not AEngine.Remove(IncludeTrailingPathDelimiter(FilePath) + FileName, @Error) then begin FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName), Error^.message]); FShowCancelMessage := True; PrivateCancel := True; g_error_free(Error); Error := nil; Break; end; end else begin PrivateCancel := True; Break; end; end; // Free space check if NewDiskQuestion then Break; // Writing ws := 0; if (CurrSize >= 512) and (TDF >= CurrSize) then begin b := WriteSplitPart(IncludeTrailingPathDelimiter(FilePath) + FileName, CurrSize, ws); if (not b) and (SplitMaxSize > 0) then begin if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, [Error^.message]); g_error_free(Error); Error := nil; end else FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, ['(unknown)']); FShowCancelMessage := True; PrivateCancel := True; Break; end; SizeDone := SizeDone + ws; if SplitMaxSize > 0 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])) else UpdateProgress1(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])); CommitGUIUpdate; end; // Free space check - New disk question after operation if NewDiskQuestion then Break; // Change filename if ws > 0 then try FileName := Copy(FileName, 1, LastDelimiter('.', FileName)) + Format('%.3d', [StrToInt(Copy(FileName, LastDelimiter('.', FileName) + 1, Length(FileName) - LastDelimiter('.', FileName))) + 1]); except FileName := ''; end; until (SizeDone = FileSize) or FCancelled or PrivateCancel or (FileName = ''); if FCancelled and (not PrivateCancel) then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; end; if not (FCancelled or PrivateCancel) then begin repeat AEngine.GetFileSystemInfo(FilePath, x, TDF, xx); if (TDF < 512) and (not NewDiskQuestion) then Break; until (TDF >= 512) or PrivateCancel or FCancelled; if WriteCRCFile(DialogsParentWindow, AEngine, IncludeTrailingPathDelimiter(FilePath) + FileName, OriginalFName, SizeDone, FileCRC) then ShowMessageBox(Format(LANGSplitOfSSucceeded, [StrToUTF8(OriginalFName)]), [mbOK], mbInfo, mbNone, mbOK) else begin FCancelMessage := Format(LANGSplitOfSFailed, [StrToUTF8(OriginalFName)]); FShowCancelMessage := True; end; end; AEngine.CloseFile(FD, nil); if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); List.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.ChmodFilesWorker; var SkipAll: boolean; function HandleChmod(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; Error: PGError; begin Result := True; Error := nil; // DebugMsg(['Chmod Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if AFileRec^.DataItem^.IsDir and (ChmodRecurseType >= 0) and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; if (not AFileRec^.DataItem^.IsDir) and (ChmodRecurseType >= 0) and (ChmodRecurseType = 1) then Exit; // Directories only if AFileRec^.DataItem^.IsDir and (ChmodRecurseType >= 0) and (ChmodRecurseType = 2) then Exit; // Files only Res := AEngine.Chmod(String(AFileRec^.DataItem^.FName), ChmodMode, @Error); if not Res then begin if SkipAll then Result := True else begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error changing permissions', AFileRec^.DataItem^.FDisplayName, Error^.message); g_error_free(Error); case Response of DIR_DELETE_SKIP : Result := True; DIR_DELETE_SKIP_ALL : begin SkipAll := True; Result := True; end; DIR_DELETE_RETRY : Result := HandleChmod(AFileRec); else Result := False; end; end; end; end; var i: longint; AList: TList; InaccessiblePaths: TStringList; Fr: Single; SkipInaccessible: boolean; begin SkipAll := False; AList := TList.Create; InaccessiblePaths := TStringList.Create; PrepareJobFilesFromPanel(AList, InaccessiblePaths, ChmodRecurseType < 0); SkipInaccessible := False; if InaccessiblePaths.Count > 0 then SkipInaccessible := ShowInaccessibleDialog(InaccessiblePaths) <> 1; if not SkipInaccessible then begin libc_chdir('/'); SetProgress1Params(AList.Count); UpdateProgress1(0, '0 %'); CommitGUIUpdate; // DebugWriteListSL(AList); if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); if AList.Count > 0 then for i := 0 to AList.Count - 1 do begin if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; Break; end; // Process chmod if not HandleChmod(AList[i]) then Break; UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); CommitGUIUpdate; end; end; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; InaccessiblePaths.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.ChownFilesWorker; var SkipAll: boolean; function HandleChown(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; Error: PGError; begin Result := True; Error := nil; // DebugMsg(['Chown Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if (AFileRec^.DataItem^.IsDir and ChownRecursive and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk)) or ((not AFileRec^.DataItem^.IsDir) and ChownRecursive) then Exit; Res := AEngine.Chown(String(AFileRec^.DataItem^.FName), ChownUID, ChownGID, @Error); if not Res then begin if SkipAll then Result := True else begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error changing owner', AFileRec^.DataItem^.FDisplayName, Error^.message); g_error_free(Error); case Response of DIR_DELETE_SKIP : Result := True; DIR_DELETE_SKIP_ALL : begin SkipAll := True; Result := True; end; DIR_DELETE_RETRY : Result := HandleChown(AFileRec); else Result := False; end; end; end; end; var i: longint; AList: TList; InaccessiblePaths: TStringList; Fr: Single; SkipInaccessible: boolean; begin SkipAll := False; AList := TList.Create; InaccessiblePaths := TStringList.Create; PrepareJobFilesFromPanel(AList, InaccessiblePaths, not ChownRecursive); SkipInaccessible := False; if InaccessiblePaths.Count > 0 then SkipInaccessible := ShowInaccessibleDialog(InaccessiblePaths) <> 1; if not SkipInaccessible then begin libc_chdir('/'); SetProgress1Params(AList.Count); UpdateProgress1(0, '0 %'); CommitGUIUpdate; // DebugWriteListSL(AList); if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); if AList.Count > 0 then for i := 0 to AList.Count - 1 do begin if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; Break; end; // Process chmod if not HandleChown(AList[i]) then Break; UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); CommitGUIUpdate; end; end; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; InaccessiblePaths.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.DummyThreadWorker; var i: integer; begin DebugMsg(['(II) DummyThreadWorker: begin']); SetProgress1Params(100); SetProgress2Params(100); UpdateProgress1(0, '0 %'); UpdateProgress2(100, '100 %'); CommitGUIUpdate; for i := 1 to 100 do begin Sleep(100); DebugMsg([' (II) DummyThreadWorker: done ', i, ' / 100']); UpdateProgress1(i, Format('%d%%', [i])); UpdateCaption1(Format('Test %d test', [i])); UpdateProgress2(101-i, Format('%d%%', [101-i])); UpdateCaption2(Format('Test %d test', [101-i])); CommitGUIUpdate; if FCancelled then Break; end; DebugMsg(['(II) DummyThreadWorker: finish']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TOpenDirThread.Create; begin inherited Create(True); FreeOnTerminate := False; ChDirResult := False; ListingResult := False; VFSOpenResult := False; ChDirError := nil; ListingError := nil; VFSOpenError := nil; RunningTime := 0; end; destructor TOpenDirThread.Destroy; begin if VFSOpenError <> nil then g_error_free(VFSOpenError); if ChDirError <> nil then g_error_free(ChDirError); if ListingError <> nil then g_error_free(ListingError); inherited Destroy; end; (********************************************************************************************************************************) function TOpenDirThread.ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): boolean; procedure GoUp(var NewPath: string); var x: integer; begin if NewPath = PathDelim then Exit; NewPath := ExcludeTrailingPathDelimiter(NewPath); if Length(Trim(NewPath)) < 2 then Exit; x := PosEnd(PathDelim, NewPath); SelItem := Copy(NewPath, x + 1, Length(NewPath) - x); NewPath := Copy(NewPath, 1, x); NewPath := IncludeTrailingPathDelimiter(NewPath); end; var APath: string; begin Result := False; try APath := Engine.Path; if Path = '..' then GoUp(APath) else begin APath := IncludeTrailingPathDelimiter(APath); Path := IncludeTrailingPathDelimiter(Path); if (Length(Path) > 0) and (Path[1] <> '/') then APath := APath + Path else APath := Path; APath := IncludeTrailingPathDelimiter(APath); end; // AutoFallback loop repeat if ChDirError <> nil then begin g_error_free(ChDirError); ChDirError := nil; end; if Engine is TVFSEngine then Result := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self, @ChDirError) else Result := Engine.ChangeDir(APath, @ChDirError); if not Result then begin PrefixTuxcmdError(@ChDirError, ExcludeTrailingPathDelimiter(APath)); GoUp(APath); end; until Result or (not AutoFallback) or (Length(APath) <= 1); if Result then Engine.Path := APath; except on E: Exception do begin Result := False; DebugMsg(['*** Exception raised in UCore.ChangeDir (', E.ClassName, '): ', E.Message]); end; end; end; procedure TOpenDirThread.Execute; var tt: TDateTime; xEngine: TVFSEngine; begin PrepareExecute; try tt := Now; try if APlugin <> nil then begin xEngine := TVFSEngine.Create(APlugin); xEngine.ParentEngine := AEngine; AEngine.LastHighlightItem := AHighlightItem; xEngine.SavePath := AEngine.Path; // AEngine must be set here since VFSOpenEx callbacks will reference it AEngine := xEngine; VFSOpenResult := (AEngine as TVFSEngine).VFSOpenEx(AFullPath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self, @VFSOpenError); end else VFSOpenResult := True; if VFSOpenResult and (not FCancelled) then begin ChDirResult := ChangeDir(AEngine, APath, ASelItem, AAutoFallBack); if ChDirResult and (not FCancelled) then begin ListingResult := AEngine.GetListing(ADirList, AEngine.GetPath, ConfShowDotFiles, True, False, @ListingError); if not ListingResult then PrefixTuxcmdError(@ListingError, AEngine.GetPath); end; end; except on E: Exception do DebugMsg(['*** Exception raised in TOpenDirThread.Execute (', E.ClassName, '): ', E.Message]); end; RunningTime := MilliSecondsBetween(tt, Now); finally FFinished := True; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TOpenConnectionThread.Create; begin inherited Create(True); FreeOnTerminate := False; OpenResult := False; OpenError := nil; end; destructor TOpenConnectionThread.Destroy; begin inherited Destroy; end; procedure TOpenConnectionThread.Execute; begin PrepareExecute; try OpenResult := (AEngine as TVFSEngine).VFSOpenURI(URI, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self, @OpenError); finally FFinished := True; end; end; end.