(* 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, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore, uVFSprototypes, UCore; type TVFSCallbackThread = class(TThread) private FThreadID: __pthread_t; FCopyProgressFunc: TEngineProgressFunc; // * TODO: move to Create() ? procedure PrepareExecute; // Call this right after thread has been started public AEngine: TPanelEngine; APlugin: TVFSPlugin; 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; VFSCallbackCancelled: boolean; VFSConnectionManagerMode: boolean; VFSQuickConnectMode: boolean; VFSDialogsParentWindow: PGtkWidget; FCancelRequested: boolean; constructor Create(CreateSuspended: boolean); destructor Destroy; override; end; TWorkerThread = class(TVFSCallbackThread) private GUIMutex: TCriticalSection; protected procedure Execute; override; procedure CommitGUIUpdate; public FCancelled: boolean; // Data to update FProgress1Pos, FProgress2Pos, FProgress1Max, FProgress2Max: Int64; FProgress1Text, FProgress2Text, FLabel1Text, FLabel2Text: string; FGUIProgress1Pos, FGUIProgress2Pos, FGUIProgress1Max, FGUIProgress2Max: Int64; FGUIProgress1Text, FGUIProgress2Text, FGUILabel1Text, FGUILabel2Text: string; FGUIChanged: boolean; FCancelMessage: string; FDoneThread, FShowCancelMessage, FDialogShowDirDelete, FDialogShowOverwrite, FDialogShowNewDir, FDialogShowMsgBox: boolean; FDialogResultDirDelete, FDialogResultOverwrite, FDialogResultNewDir: integer; FDirDeleteButtonsType: integer; FDirDeleteLabel1Text, FDirDeleteLabel2Text, FDirDeleteLabel3Text, FDirDeleteCaption: string; FDirDeleteLabel2Visible, FDirDeleteLabel3Visible: boolean; FOverwriteButtonsType: integer; FOverwriteFromLabel, FOverwriteFromInfoLabel, FOverwriteToLabel, FOverwriteToInfoLabel, FOverwriteRenameStr, FOverwriteSourceFile, FOverwriteDestFile: string; FNewDirCaption, FNewDirLabel, FNewDirEdit: string; FMsgBoxText: string; FMsgBoxButtons: TMessageButtons; FMsgBoxStyle: TMessageStyle; FMsgBoxDefault, FMsgBoxEscape, FDialogResultMsgBox: TMessageButton; FCallbackLockEvent: TSimpleEvent; // Parameters ProgressForm: TFProgress; Engine, SrcEngine, DestEngine: TPanelEngine; LeftPanel: boolean; DataList: TList; ParamBool1, ParamBool2, ParamBool3, ParamBool4, ParamBool5: boolean; ParamString1, ParamString2, ParamString3: string; ParamPointer1: Pointer; ParamInt64: Int64; ParamInt1, ParamInt2: integer; ParamLongWord1: LongWord; ParamCardinal1, ParamCardinal2: Cardinal; ParamFloat1, ParamFloat2: Extended; ParamDataItem1: PDataItem; WorkerProcedure: procedure(SenderThread: TWorkerThread); SelectedItem: PDataItem; ExtractFromVFSMode, ExtractFromVFSAll: boolean; ErrorHappened: boolean; constructor Create; destructor Destroy; override; procedure CancelIt; function Cancelled: boolean; procedure PrepareJobFilesFromPanel(AList: TList; DoNotRecurse: boolean); 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: integer; const Label1Text: string; const Label2Text: string = ''; const Label3Text: string = ''; const DirDeleteCaption: string = ''): integer; function ShowOverwriteDialog(ButtonsType: integer; const FromLabel, FromInfoLabel, ToLabel, ToInfoLabel, RenameStr, SourceFile, DestFile: string): integer; function ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; function ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; Default, Escape: TMessageButton): TMessageButton; 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; Finished, CancelIt: boolean; 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; Finished: boolean; OpenResult: boolean; OpenError: PGError; constructor Create; destructor Destroy; override; end; // Thread aware functions (also half-thread-safe) without any piece of GTK code procedure DeleteFilesWorker(SenderThread: TWorkerThread); procedure CopyFilesWorker(SenderThread: TWorkerThread); procedure MergeFilesWorker(SenderThread: TWorkerThread); procedure SplitFilesWorker(SenderThread: TWorkerThread); procedure ChmodFilesWorker(SenderThread: TWorkerThread); procedure ChownFilesWorker(SenderThread: TWorkerThread); procedure DummyThreadWorker(SenderThread: TWorkerThread); // Worker threads utilities procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); implementation uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, UFileAssoc, UCoreClasses, URemoteWait, UMain, UGnome, UNewDir, 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; VFSDialogsParentWindow := FMain.FWidget; FCancelRequested := 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.FCancelRequested 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.VFSDialogsParentWindow, 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 = 0x', IntToHex(QWord(user_data), 16), ', ThreadID = 0x', IntToHex(pthread_self, 16)]); 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.FCancelRequested 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.VFSDialogsParentWindow, 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 = 0x', IntToHex(QWord(user_data), 16), ', ThreadID = 0x', IntToHex(pthread_self, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); 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; // Keep in sync with uVFSprototypes.pas/TVFSProgressCallback function vfs_copy_progress_callback(position: guint64; error: PGError; user_data: Pointer): gboolean; cdecl; begin // DebugMsg(['VFSCopyCallBackFunc called (iPos = ', iPos, ', iMax = ', iMax, ')']); Result := True; if not Assigned(user_data) then Exit; if Assigned(TVFSCallbackThread(user_data).FCopyProgressFunc) then try Result := TVFSCallbackThread(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; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.Execute; begin PrepareExecute; if Assigned(WorkerProcedure) then WorkerProcedure(Self); end; constructor TWorkerThread.Create; begin inherited Create(True); FreeOnTerminate := False; GUIMutex := TCriticalSection.Create; FCallbackLockEvent := TSimpleEvent.Create; FCancelled := False; ProgressForm := nil; Engine := nil; DataList := nil; ParamPointer1 := nil; WorkerProcedure := nil; SelectedItem := nil; FDoneThread := False; FShowCancelMessage := False; FDialogShowDirDelete := False; FDialogShowOverwrite := False; FDialogShowNewDir := False; FDialogShowMsgBox := False; ExtractFromVFSMode := False; ErrorHappened := False; ParamBool1 := False; ParamBool2 := False; ParamBool3 := False; ParamBool4 := False; ParamBool5 := False; FGUIChanged := False; end; destructor TWorkerThread.Destroy; begin GUIMutex.Free; FCallbackLockEvent.Free; inherited Destroy; end; procedure TWorkerThread.CancelIt; begin FCancelled := True; end; function TWorkerThread.Cancelled: boolean; begin Result := FCancelled or ProgressForm.Cancelled; 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 GUIMutex.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'); GUIMutex.Release; end; function TWorkerThread.ShowDirDeleteDialog(ButtonsType: integer; const Label1Text: string; const Label2Text: string = ''; const Label3Text: string = ''; const DirDeleteCaption: string = ''): integer; begin FDialogResultDirDelete := integer(mbCancel); FDirDeleteLabel1Text := Label1Text; FDirDeleteLabel2Text := Label2Text; FDirDeleteLabel3Text := Label3Text; FDirDeleteLabel2Visible := Label2Text <> ''; FDirDeleteLabel3Visible := Label3Text <> ''; FDirDeleteButtonsType := ButtonsType; if DirDeleteCaption = '' then FDirDeleteCaption := LANGRemoveDirectory else FDirDeleteCaption := DirDeleteCaption; FDialogShowDirDelete := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultDirDelete; end; function TWorkerThread.ShowOverwriteDialog(ButtonsType: integer; const FromLabel, FromInfoLabel, ToLabel, ToInfoLabel, RenameStr, SourceFile, DestFile: string): integer; begin FDialogResultOverwrite := integer(mbCancel); FOverwriteButtonsType := ButtonsType; FOverwriteFromLabel := FromLabel; FOverwriteFromInfoLabel := FromInfoLabel; FOverwriteToLabel := ToLabel; FOverwriteToInfoLabel := ToInfoLabel; FOverwriteRenameStr := RenameStr; FOverwriteSourceFile := SourceFile; FOverwriteDestFile := DestFile; FDialogShowOverwrite := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultOverwrite; 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; DoNotRecurse: boolean); var i: longint; CurrPath: string; InputFiles: TStringList; begin InputFiles := TStringList.Create; CurrPath := IncludeTrailingPathDelimiter(Engine.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 not files are selected, take into the account current active item if (InputFiles.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then InputFiles.Add(CurrPath + String(SelectedItem^.FName)); FillDirFiles(Engine, AList, InputFiles, DoNotRecurse, True); InputFiles.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); var AFDirDelete: TFDirDelete; AFOverwrite: TFOverwrite; AFNewDir: TFNewDir; b: boolean; begin DebugMsg([' ** ProcessProgressThread --begin']); b := False; try while not SenderThread.FDoneThread do begin // Write('.'); Sleep(ConstInternalProgressTimer); // DebugMsg([' ** ProcessProgressThread: updating UI (FProgress1Pos = ', SenderThread.FProgress1Pos, ', FProgress2Pos = ', SenderThread.FProgress2Pos]); // DebugMsg(['ProcessProgressThread - before mutex']); SenderThread.GUIMutex.Acquire; // WriteLn('ProcessProgressThread - ted mam lock ja! -- enter'); try if SenderThread.FGUIChanged then begin if SenderThread.FGUIProgress1Max > 1 then ProgressForm.ProgressBar.Fraction := SenderThread.FGUIProgress1Pos / SenderThread.FGUIProgress1Max else ProgressForm.ProgressBar.Fraction := 0; // ProgressForm.ProgressBar.Value := SenderThread.FGUIProgress1Pos; ProgressForm.ProgressBar.Text := SenderThread.FGUIProgress1Text; ProgressForm.Label2.Caption := SenderThread.FGUILabel1Text; if ProgressForm.FTwoBars then begin if SenderThread.FGUIProgress2Max > 1 then ProgressForm.ProgressBar2.Fraction := SenderThread.FGUIProgress2Pos / SenderThread.FGUIProgress2Max else ProgressForm.ProgressBar2.Fraction := 0; // ProgressForm.ProgressBar2.Value := SenderThread.FGUIProgress2Pos; ProgressForm.ProgressBar2.Text := SenderThread.FGUIProgress2Text; ProgressForm.Label3.Caption := SenderThread.FGUILabel2Text; end; ProgressForm.ProgressBar.Max := SenderThread.FGUIProgress1Max; ProgressForm.ProgressBar2.Max := SenderThread.FGUIProgress2Max; SenderThread.FGUIChanged := False; end; except on E: Exception do DebugMsg(['*** Exception raised in UCore.ProcessProgressThread::updating progress bars block (', E.ClassName, '): ', E.Message]); end; // Sleep(1000); // WriteLn('ProcessProgressThread - ted mam lock ja! -- leave'); SenderThread.GUIMutex.Release; // DebugMsg(['Before refresh']); Application.ProcessMessages; // DebugMsg(['After refresh']); // VFS callbacks if SenderThread.VFSAskQuestion_Display then begin SenderThread.VFSAskQuestion_Display := False; DebugMsg(['ProcessProgressThread - Main thread: displaying question dialog']); HandleVFSAskQuestionCallback(ProgressForm.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(ProgressForm.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; try if SenderThread.FDialogShowDirDelete then begin AFDirDelete := nil; try AFDirDelete := TFDirDelete.Create(SenderThread.ProgressForm as TComponent); AFDirDelete.Caption := SenderThread.FDirDeleteCaption; AFDirDelete.AddButtons(SenderThread.FDirDeleteButtonsType); AFDirDelete.Label1.Caption := SenderThread.FDirDeleteLabel1Text; AFDirDelete.Label2.Caption := SenderThread.FDirDeleteLabel2Text; AFDirDelete.Label3.Caption := SenderThread.FDirDeleteLabel3Text; AFDirDelete.Label2.Visible := SenderThread.FDirDeleteLabel2Visible; AFDirDelete.Label3.Visible := SenderThread.FDirDeleteLabel3Visible; SenderThread.FDialogResultDirDelete := Integer(AFDirDelete.Run); if (SenderThread.FDirDeleteButtonsType = 3) and (SenderThread.FDialogResultDirDelete = 2) and (not SenderThread.ParamBool3) then case Application.MessageBox(LANGIgnoreError, [mbYes, mbNo{, mbCancel}], mbWarning, mbYes, mbNo) of mbNo: SenderThread.FDialogResultDirDelete := 1; mbCancel: SenderThread.FDialogResultDirDelete := 0; end; finally AFDirDelete.Free; end; SenderThread.FDialogShowDirDelete := False; b := True; end; if SenderThread.FDialogShowOverwrite then begin AFOverwrite := nil; try AFOverwrite := TFOverwrite.Create(SenderThread.ProgressForm as TComponent); AFOverwrite.AddButtons(SenderThread.FOverwriteButtonsType); AFOverwrite.FromLabel.Caption := SenderThread.FOverwriteFromLabel; AFOverwrite.FromInfoLabel.Caption := SenderThread.FOverwriteFromInfoLabel; AFOverwrite.ToLabel.Caption := SenderThread.FOverwriteToLabel; AFOverwrite.ToInfoLabel.Caption := SenderThread.FOverwriteToInfoLabel; AFOverwrite.RenameStr := SenderThread.FOverwriteRenameStr; AFOverwrite.SourceFile := SenderThread.FOverwriteSourceFile; AFOverwrite.DestFile := SenderThread.FOverwriteDestFile; SenderThread.FDialogResultOverwrite := Integer(AFOverwrite.Run); SenderThread.FOverwriteRenameStr := UTF8ToStr(AFOverwrite.RenameStr); finally AFOverwrite.Free; end; SenderThread.FDialogShowOverwrite := False; b := True; end; if SenderThread.FDialogShowNewDir then begin AFNewDir := nil; try AFNewDir := TFNewDir.Create(SenderThread.ProgressForm as TComponent); AFNewDir.Caption := SenderThread.FNewDirCaption; AFNewDir.Label1.Caption := SenderThread.FNewDirLabel; AFNewDir.Entry.Text := SenderThread.FNewDirEdit; AFNewDir.Entry.SelectAll; SenderThread.FDialogResultNewDir := Integer(AFNewDir.Run); SenderThread.FNewDirEdit := AFNewDir.Entry.Text; finally AFNewDir.Free; end; SenderThread.FDialogShowNewDir := False; b := True; end; if SenderThread.FDialogShowMsgBox then begin SenderThread.FDialogResultMsgBox := Application.MessageBox(SenderThread.FMsgBoxText, SenderThread.FMsgBoxButtons, SenderThread.FMsgBoxStyle, SenderThread.FMsgBoxDefault, SenderThread.FMsgBoxEscape); SenderThread.FDialogShowMsgBox := False; b := True; end; finally // Unlock the waiting worker thread if b then begin b := False; SenderThread.FCallbackLockEvent.SetEvent; end; end; end; if SenderThread.FShowCancelMessage then if SenderThread.FCancelMessage = LANGUserCancelled then Application.MessageBox(SenderThread.FCancelMessage, [mbOK], mbWarning, mbNone, mbOK) else Application.MessageBox(SenderThread.FCancelMessage, [mbOK], mbError, mbNone, mbOK); except on E: Exception do DebugMsg(['*** Exception raised in UCore.ProcessProgressThread (', E.ClassName, '): ', E.Message]); end; DebugMsg([' ** ProcessProgressThread --end']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure DeleteFilesWorker(SenderThread: TWorkerThread); 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 := SenderThread.Engine.Remove(String(AFileRec^.DataItem^.FName), @Error); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin Response := SenderThread.ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeDeletedS, [Error^.message])); case Response of 1 : Result := True; 3 : begin SkipAll := True; Result := True; end; 2 : Result := HandleDelete(AFileRec); else Result := False; end; end; if Error <> nil then g_error_free(Error); end; var i: longint; AList: TList; CurrPath: string; Fr: Single; Response: integer; DeleteAll, SkipToNext: boolean; begin SkipAll := False; AList := TList.Create; with SenderThread do begin CurrPath := IncludeTrailingPathDelimiter(Engine.Path); PrepareJobFilesFromPanel(AList, False); // * TODO: catch the error if not Engine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); libc_chdir('/'); 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 Cancelled 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(4, Format(LANGTheDirectorySIsNotEmpty, [string(PDataItemSL(AList[i])^.DataItem^.FDisplayName)]), LANGDoYouWantToDeleteItWithAllItsFilesAndSubdirectories); case Response of 1 : ; // Do nothing in this case - I will not bother with changing the structure; it works :-) 2 : DeleteAll := True; 3 : 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; // * TODO: catch the error if not Engine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; SenderThread.FDoneThread := True; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) // Keep in sync with UEngines.pas/TEngineProgressFunc function CopyFilesWorker_ProgressFunc(Sender: Pointer; BytesDone: Int64; Error: PGError): boolean; cdecl; begin Result := True; // DebugMsg(['*** CopyFilesWorker: ProgressFunc called (Sender=', QWord(Sender), ', BytesDone=', BytesDone, ')']); try if Assigned(Sender) and (TObject(Sender) is TWorkerThread) then with TWorkerThread(Sender) do begin if BytesDone = 0 then UpdateProgress1(0, '0%') else UpdateProgress1(BytesDone, Format('%d%%', [Round(ParamFloat2 * BytesDone)])); UpdateProgress2(ParamInt64 + BytesDone, Format('%d%%', [Round(ParamFloat1 * (ParamInt64 + BytesDone))])); Result := not Cancelled; CommitGUIUpdate; end else DebugMsg(['*** CopyFilesWorker: Sender is not TWorkerThread']); except on E: Exception do DebugMsg(['*** Exception raised in ProgressFunc(Sender=', QWord(Sender), ', BytesDone=', BytesDone, '): (', E.ClassName, '): ', E.Message]); end; end; // Return True to ignore the error (Skip, Skip All, Ignore, Cancel) function CopyFilesWorker_ErrorFunc(Sender: Pointer; ErrorType, ErrorNum: integer; FileName: string): boolean; cdecl; var s, s2, s3: string; begin Result := False; with TWorkerThread(Sender) do begin if ParamBool2 then begin Result := True; Exit; end; case ErrorType of 0 : begin CancelIt; Exit; end; 1 : s := LANGMemoryAllocationFailed; 2 : s := LANGCannotOpenSourceFile; 3 : s := LANGCannotOpenDestinationFile; 4 : s := LANGCannotCloseDestinationFile; 5 : s := LANGCannotCloseSourceFile; 6 : s := LANGCannotReadFromSourceFile; 7 : s := LANGCannotWriteToDestinationFile; end; if ParamBool1 then s2 := LANGCopyError else s2 := LANGMoveError; if ErrorType <> 1 then s3 := StrToUTF8(FileName) else s3 := ''; // * TODO: fix error string case ShowDirDeleteDialog(3, s, s3, 'ahoj' { GetErrorString(ErrorNum)} , s2) of 0, 252 : begin // Cancel button, Escape Result := False; CancelIt; end; 2 : Result := True; // Ignore 3 : begin // Skip All ParamBool2 := True; { Skip All Err } Result := False; //** True? end; else {1, 124, 255 :} Result := False; // Skip end; end; end; procedure CopyFilesWorker(SenderThread: TWorkerThread); // ParamFloat1 = Fr - internal // ParamFloat2 = Fr2 - internal // ParamInt64 = SizeDone - internal // ParamBool1 = ModeCopy - internal // ParamBool2 = SkipAllErr - internal // ParamBool3 = CopyMode // ParamBool4 = QuickRename // ParamBool5 = OneFile // ParamString1 = NewPath // ParamString2 = Filepath // ParamDataItem1 = QuickRenameDataItem var DefResponse: integer; // Global variables for this function SkipAll: boolean; // Returns True if file was successfully copied, if not, the file will be deleted in LocalCopyFile function ManualCopyFile(SourceFile, DestFile: string; Append: boolean): boolean; var fsrc, fdst: TEngineFileDes; BSize: integer; Buffer: Pointer; BytesDone, BytesRead, BytesWritten: Int64; Res: boolean; Error: PGError; begin DebugMsg(['ManualCopyFile: ', SourceFile, ' ---> ', DestFile]); with SenderThread do begin Result := False; Error := nil; fsrc := SrcEngine.OpenFile(SourceFile, omRead, @Error); if fsrc = nil then begin // * TODO: set real error, also free it CopyFilesWorker_ErrorFunc(SenderThread, 2, 1 { Error }, SourceFile); // Cannot open source file Exit; end; if Append then fdst := DestEngine.OpenFile(DestFile, omAppend, @Error) else fdst := DestEngine.OpenFile(DestFile, omWrite, @Error); if fdst = nil then begin // * TODO: set real error, also free it SrcEngine.CloseFile(fsrc, nil); CopyFilesWorker_ErrorFunc(SenderThread, 3, 1 { Error }, SourceFile); // Cannot open target file Exit; end; BytesDone := 0; Res := True; BSize := DestEngine.GetBlockSize; Buffer := malloc(BSize); if Buffer = nil then begin CopyFilesWorker_ErrorFunc(SenderThread, 1, errno, SourceFile); // Memory allocation failed libc_free(Buffer); Exit; end; memset(Buffer, 0, BSize); BytesWritten := 0; repeat BytesRead := SrcEngine.ReadFile(fsrc, Buffer, BSize, @Error); if (BytesRead = 0) and (Error <> nil) then // * TODO: set real error, also free it Res := CopyFilesWorker_ErrorFunc(SenderThread, 6, 1 { Error }, SourceFile); // Cannot read from source file if BytesRead > 0 then begin Error := nil; BytesWritten := DestEngine.WriteFile(fdst, Buffer, BytesRead, @Error); if (BytesWritten < BytesRead) then // * TODO: set real error, also free it Res := CopyFilesWorker_ErrorFunc(SenderThread, 7, 1 { Error }, DestFile); // Cannot write to source file end; Inc(BytesDone, BytesRead); if not CopyFilesWorker_ProgressFunc(SenderThread, BytesDone, nil) then begin Res := False; Break; end; until (BytesRead = 0) or (BytesWritten < BytesRead); libc_free(Buffer); // * TODO: set real error, also free it if not DestEngine.CloseFile(fdst, nil) then begin CopyFilesWorker_ErrorFunc(SenderThread, 4, errno, DestFile); // Cannot close target file Exit; end; // * TODO: set real error, also free it if not SrcEngine.CloseFile(fsrc, nil) then begin CopyFilesWorker_ErrorFunc(SenderThread, 5, errno, SourceFile); // Cannot close source file Exit; end; Result := Res; end; end; // Returns True if the file was successfully copied and will be deleted on move function LocalCopyFile(SourceFile, DestFile: string; Append: boolean): boolean; var DataSrc, DataDest: PDataItem; begin Result := False; try with SenderThread do begin AEngine := nil; FCopyProgressFunc := CopyFilesWorker_ProgressFunc; // local -> local if (SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine) then Result := DestEngine.CopyFileIn(SourceFile, DestFile, Append, @CopyFilesWorker_ProgressFunc, SenderThread) else // 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); 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); end // VFS to VFS (not supported yet) else begin AEngine := SrcEngine; Result := ManualCopyFile(SourceFile, DestFile, Append); 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; end; except on E: Exception do DebugMsg(['*** Exception raised in LocalCopyFile(SourceFile=', SourceFile, ', DestFile=', DestFile, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); end; end; function IsOnSameFS(SrcPath, DestPath: string): boolean; begin with SenderThread do 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; end; function TwoSameFiles(Path1, Path2: string; TestCaseInsensitiveFS: boolean): boolean; begin with SenderThread do 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 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; end; function DoOperation(AFileRec: PDataItemSL; const Dst: string; var ErrorKind: integer; const Append: boolean): integer; begin ErrorKind := 0; Result := 0; try with SenderThread do with AFileRec^ do begin if DataItem^.IsLnk then begin // Explicit copy the file if ParamBool3 or (not IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst))) then begin // * TODO: check error ErrorKind := Ord(DestEngine.MakeSymLink(Dst, String(DataItem^.LnkPointTo), nil)); // if ErrorKind <> 0 then Result := ERRCreateLink; if not ParamBool3 then begin // * TODO: check error ErrorKind := Ord(SrcEngine.Remove(String(DataItem^.FName), nil)); // if ErrorKind <> 0 then Result := ERRRemove; end; end else begin // Move the file // * TODO: check error ErrorKind := Ord(DestEngine.RenameFile(String(DataItem^.FName), Dst, nil)); // if ErrorKind <> 0 then Result := ERRCopyMove; end; end else // is not link if ParamBool3 then begin // Copy mode if LocalCopyFile(String(DataItem^.FName), Dst, Append) 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']); // * TODO: check error ErrorKind := Ord(DestEngine.RenameFile(String(DataItem^.FName), Dst + '_tcmd', nil)); if ErrorKind = 0 then ErrorKind := Ord(DestEngine.RenameFile(Dst + '_tcmd', Dst, nil)); end else ErrorKind := Ord(DestEngine.RenameFile(String(DataItem^.FName), Dst, nil)); // if ErrorKind <> 0 then Result := ERRCopyMove; end else begin if LocalCopyFile(String(DataItem^.FName), Dst, Append) 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); if not Cancelled then begin ErrorKind := Ord(SrcEngine.Remove(String(DataItem^.FName), nil)); // if ErrorKind <> 0 then Result := ERRRemove; end; end; end; end; // DebugMsg(['(II) CopyFilesWorker.DoOperation: finished']); except on E: Exception do DebugMsg(['*** Exception raised in DoOperation(AFileRec=', QWord(AFileRec), ', Dst=', Dst, ', ErrorKind=', ErrorKind, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); end; end; // Return False to break the processing (Cancel) function HandleCopy(AFileRec: PDataItemSL; NewFilePath: string): boolean; var Res, Response, ErrorKind, r: integer; Item: PDataItem; s, s1, s3, cap: string; FromInfoLabel, ToInfoLabel, InfoLabelFormat: string; begin Result := True; try with SenderThread do begin // Second stage - change permissions if (not AFileRec^.Stage1) and (ParamBool3 or ((not ParamBool3) and (not AFileRec^.ForceMove))) then 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 not ParamBool3 then SrcEngine.Remove(String(DataItem^.FName), nil); // Remove directory Exit; end; // First stage - copy data if AFileRec^.DataItem^.IsDir then begin Res := 0; if AFileRec^.ForceMove and (not ParamBool3) 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']); // * TODO: check error ErrorKind := Ord(DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', nil)); if ErrorKind = 0 then ErrorKind := ord(DestEngine.RenameFile(ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), nil)); end else ErrorKind := Ord(DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), string(AFileRec^.ADestination), nil)); { if ErrorKind <> 0 then Res := ERRCopyMove else Res := 0; } end else if not DestEngine.DirectoryExists(NewFilePath, False) then begin // * TODO: check error ErrorKind := Ord(DestEngine.MakeDir(NewFilePath, nil)); { if ErrorKind <> 0 then Res := ERRMkDir else Res := 0; } 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)); if AFileRec^.DataItem^.Size <= 1 then ParamFloat2 := 1 else ParamFloat2 := 100 / (AFileRec^.DataItem^.Size - 1); CopyFilesWorker_ProgressFunc(SenderThread, 0, nil); Res := 0; if DestEngine.FileExists(NewFilePath, False) and (not (not ParamBool3 and (not TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, False)) and TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, True))) then begin Response := DefResponse; // * TODO: check error Item := DestEngine.GetFileInfo(NewFilePath, False, True, nil); if Item = nil then begin DebugMsg(['Something went terribly wrong during copy - Item := DestEngine.GetFileInfoSL(NewFilePath) == NULL!']); Result := False; Exit; end; if Response = 0 then begin case ConfSizeFormat of 5: InfoLabelFormat := '%s, %s'; else InfoLabelFormat := LANGOvewriteSBytesS; end; FromInfoLabel := Format(InfoLabelFormat, [FormatSize(Item^.Size, 0), FormatDate(Item^.mtime, True, True)]); ToInfoLabel := Format(InfoLabelFormat, [FormatSize(AFileRec^.DataItem^.Size, 0), FormatDate(AFileRec^.DataItem^.mtime, True, True)]); Response := ShowOverwriteDialog(1 + Ord(ParamBool3), Format(LANGOverwriteS, [StrToUTF8(NewFilePath)]), FromInfoLabel, Format(LANGWithFileS, [AFileRec^.DataItem^.FDisplayName]), ToInfoLabel, ExtractFileName(StrToUTF8(NewFilePath)), ExtractFileName(AFileRec^.DataItem^.FDisplayName), ExtractFileName(StrToUTF8(NewFilePath))); s := FOverwriteRenameStr; case Response of // 1: Overwrite // 3: Skip 2 {Overwrite All}, 5 {Overwrite All Older}, 6 {Skip All}: DefResponse := Response; 4 {Cancel}, 124 {Close Window}, 255: begin Result := False; Exit; end; 7: {Rename} begin NewFilePath := Copy(NewFilePath, 1, LastDelimiter(PathDelim, NewFilePath)) + s; Result := HandleCopy(AFileRec, NewFilePath); Exit; end; 8 {Append}: begin Res := DoOperation(AFileRec, NewFilePath, ErrorKind, True); end; end; end; // Remove destination file if exists and should be overwritten if (Response in [1, 2]) or ((Response = 5) and (Item^.mtime < AFileRec^.DataItem^.mtime)) then begin // * TODO: check error r := ord(DestEngine.Remove(NewFilePath, nil)); while r <> 0 do begin // * TODO: check error Res := ShowDirDeleteDialog(1, LANGTheFile, StrToUTF8(String(NewFilePath)), Format(LANGCouldNotBeDeletedS, ['ahoj' {GetErrorString(r)}]), LANGCopyError); case Res of 1: begin Result := True; Exit; end; // * TODO: check error 2: r := Ord(DestEngine.Remove(NewFilePath, nil)); 0, 124, 255: begin Result := False; Exit; end; end; end; Res := DoOperation(AFileRec, NewFilePath, ErrorKind, False); end; end else Res := DoOperation(AFileRec, NewFilePath, ErrorKind, False); end; // Error handling if (Res <> 0) and (not SkipAll) then begin if ParamBool3 then cap := LANGCopy else cap := LANGMove; // * TODO: port to GError { case Res of ERRCreateLink: begin s1 := LANGTheSymbolicLink; if ErrorKind = 0 then s3 := LANGCouldNotBeCreated else s3 := Format(LANGCouldNotBeCreatedS, [GetErrorString(ErrorKind)]); end; ERRMkDir: begin s1 := LANGTheDirectory; if ErrorKind = 0 then s3 := LANGCouldNotBeCreated else s3 := Format(LANGCouldNotBeCreatedS, [GetErrorString(ErrorKind)]); end; ERRRemove: begin if AFileRec^.DataItem^.IsDir then s1 := LANGTheDirectory else if AFileRec^.DataItem^.IsLnk then s1 := LANGTheSymbolicLink else s1 := LANGTheFile; if ErrorKind = 0 then s3 := LANGCouldNotBeDeleted else s3 := Format(LANGCouldNotBeDeletedS, [GetErrorString(ErrorKind)]); end; ERRCopyMove: begin if ParamBool3 then s1 := LANGCannotCopyFile else s1 := LANGCannotMoveFile; if ErrorKind = 0 then s3 := '' else s3 := GetErrorString(ErrorKind); end; end; } Response := ShowDirDeleteDialog(1, s1, StrToUTF8(String(NewFilePath)), s3, cap); case Response of 1 : Result := True; // Skip 2 : Result := HandleCopy(AFileRec, NewFilePath); // Retry 3 : begin // Skip All SkipAll := True; Result := True; end; 0, 124, 255 : Result := False; // Cancel end; end; end; // DebugMsg(['(II) CopyFilesWorker.HandleCopy: finished']); except on E: Exception do DebugMsg(['*** Exception raised in HandleCopy(AFileRec=', QWord(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; CurrPath, FullPath, ParamFileName: string; ParamDir, Ren: boolean); var s, s2: string; b, CaseInsensitiveRename: boolean; Info: PDataItemSL; InputFiles: TStringList; begin InputFiles := TStringList.Create; with SenderThread do begin if not Ren then begin InputFiles.Add(FullPath); end else begin s := ProcessPattern(DestEngine, ParamString1, CurrPath, ParamFileName, ParamDir); CaseInsensitiveRename := (WideCompareStr(ParamString1, ParamFileName) <> 0) and (WideCompareText(ParamString1, ParamFileName) = 0) and ParamDir and DestEngine.TwoSameFiles(IncludeTrailingPathDelimiter(CurrPath) + ParamString1, 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 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, True); end; InputFiles.Free; end; var i: longint; List: TList; CurrPath, SaveDestPath, SaveSrcPath, s: string; MaxSize: Int64; StartPassed: boolean; begin List := TList.Create; List.Clear; with SenderThread do begin ErrorHappened := False; FCancelled := False; SaveSrcPath := ''; CurrPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SaveDestPath := DestEngine.Path; ParamString1 := ExcludeTrailingPathDelimiter(ParamString1); if ParamString1 = '' then ParamString1 := PathDelim; // Prepare list of files to copy if ParamBool5 then begin // HandleVFSFromArchive if not ExtractFromVFSAll then HandleProcessPattern(List, CurrPath, ParamString2, ExtractFileName(ParamString2), False, False) else begin SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SrcEngine.SetPath('/'); CurrPath := '/'; HandleProcessPattern(List, '/', '/', '', True, False); end; end else if ParamBool4 then begin // Quick-Rename with ParamDataItem1^ do HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), True); end else begin // Not Quick-Rename if not ExtractFromVFSMode 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, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); if (List.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then with SelectedItem^ do HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); end else begin // Extract from VFS mode DebugMsg(['CopyFilesWorker: Should not be reached']); if (not ExtractFromVFSAll) and Assigned(SelectedItem) then HandleProcessPattern(List, CurrPath, CurrPath + String(SelectedItem^.FName), String(SelectedItem^.FName), SelectedItem^.IsDir and (not SelectedItem^.IsLnk), not ParamBool3) else begin SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SrcEngine.SetPath('/'); CurrPath := '/'; HandleProcessPattern(List, '/', '/', '', True, False); end; end; end; { 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.']); } DebugWriteListSL(List); __chdir('/'); // Compute total size of files to copy MaxSize := 0; ParamInt64 := 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 Inc(MaxSize, PDataItemSL(List[i])^.DataItem^.Size); SrcEngine.BlockSize := ComputeBlockSize(MaxSize); DestEngine.BlockSize := ComputeBlockSize(MaxSize); // Prepare the Progress window SetProgress2Params(MaxSize + Ord(MaxSize = 0)); UpdateProgress1(0, '0%'); UpdateProgress2(0, '0%'); CommitGUIUpdate; DefResponse := 0; ParamBool1 := ParamBool3; SkipAll := False; ParamBool2 := False; if MaxSize < 2 then ParamFloat1 := 1 else ParamFloat1 := 100 / (MaxSize - 1); 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, SenderThread); if DestEngine is TVFSEngine then StartPassed := StartPassed and (DestEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, SenderThread); 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, ParamString1, 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 UpdateCaption1(Format(LANGFromS, [string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])) else if (SrcEngine as TVFSEngine).ArchiveMode then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])])) else UpdateCaption1(Format(LANGFromS, [GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.DataItem^.FDisplayName))])); if not (DestEngine is TVFSEngine) then UpdateCaption2(Format(LANGToS, [StrToUTF8(s)])) else if (DestEngine as TVFSEngine).ArchiveMode then UpdateCaption2(Format(LANGToS, [Format(ConstFullPathFormatStr, [(DestEngine as TVFSEngine).ArchivePath, StrToUTF8(s)])])) else UpdateCaption2(Format(LANGToS, [GetURIPrefix((DestEngine as TVFSEngine).GetPathURI) + StrToUTF8(s)])); CommitGUIUpdate; if TwoSameFiles(s, string(PDataItemSL(List[i])^.DataItem^.FName), ParamBool3) 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; end; if (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) then Inc(ParamInt64, PDataItemSL(List[i])^.DataItem^.Size); if Cancelled 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, SenderThread); if DestEngine is TVFSEngine then (DestEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, SenderThread); 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; // * 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.']); end; SenderThread.FDoneThread := True; DebugMsg(['(II) CopyFilesWorker: finished']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure MergeFilesWorker(SenderThread: TWorkerThread); // ParamBool1 = HasInitialCRC // ParamString1 = NewPath // ParamString2 = FileName // ParamString3 = TargetName // ParamLongWord1 = TargetCRC // ParamInt64 = TargetSize var FD: TEngineFileDes; Count, MergeBlockSize: integer; Buffer: Pointer; CurrentCRC: LongWord; PrivateCancel: boolean; SizeDone: Int64; TargetName: string; Error: PGError; function PasteFile(FName: string): boolean; var FDR: TEngineFileDes; wCount: integer; Stat: PDataItem; begin Result := False; with SenderThread do begin if ParamBool1 then UpdateCaption2(Format(LANGToS, [StrToUTF8(FName)])) else UpdateCaption1(Format(LANGFromS, [StrToUTF8(FName)])); UpdateProgress1(0, '0 %'); CommitGUIUpdate; // * TODO: check error Stat := Engine.GetFileInfo(FName, True, True, nil); if not Assigned(Stat) then Exit; SetProgress1Params(Stat^.Size); FreeDataItem(Stat); // * TODO: check error Error := nil; FDR := Engine.OpenFile(FName, omRead, @Error); if FDR = nil then Exit; repeat // * TODO: check error Count := Engine.ReadFile(FDR, Buffer, MergeBlockSize, @Error); if Error <> nil then begin Engine.CloseFile(FD, nil); Exit; end; // * TODO: check error wCount := Engine.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 Exit; end; CurrentCRC := CRC32(CurrentCRC, Buffer, Count); UpdateProgress1(FProgress1Pos + Count, Format('%d %%', [Trunc((FProgress1Pos + Count) / FProgress1Max * 100)])); Inc(SizeDone, Count); if ParamBool1 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FProgress2Max * 100)])); CommitGUIUpdate; until (Count < MergeBlockSize) or Cancelled; // * TODO: set real error, also free it Engine.CloseFile(FDR, nil); end; Result := True; end; var CurrFile, SourcePath, TargetFinalName: string; HasFinalCRC, b: boolean; Stat: PDataItem; begin with SenderThread do begin HasFinalCRC := ParamBool1; TargetFinalName := ParamString3; if (Length(ParamString2) > 4) and (WideUpperCase(RightStr(ParamString2, 4)) = '.CRC') then CurrFile := ChangeFileExt(ExtractFileName(ParamString2), '.001') else CurrFile := ExtractFileName(ParamString2); SourcePath := ExtractFilePath(ParamString2); if ParamString3 = '' then ParamString3 := ChangeFileExt(ExtractFileName(ParamString2), '.out'); TargetName := ProcessPattern(Engine, ParamString1, Engine.Path, ParamString3, False); if Engine.FileExists(TargetName, False) then if ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(TargetName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes then begin // * TODO: check error { Error := Ord(Engine.Remove(TargetName, nil)); if Error <> 0 then begin FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), GetErrorString(Error)]); FShowCancelMessage := True; Exit; end; } end else Exit; // * TODO: check error Stat := Engine.GetFileInfo(ParamString2, 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; // * TODO: check error FD := Engine.OpenFile(TargetName, omWrite, @Error); if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), Error^.message]); FShowCancelMessage := True; libc_free(Buffer); Exit; end; CurrentCRC := 0; SizeDone := 0; PrivateCancel := False; if ParamBool1 then begin SetProgress2Params(ParamInt64); 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, Engine, TargetFinalName, ParamLongWord1, ParamInt64); 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 = ParamInt64) or Cancelled or PrivateCancel {or ((not b) and (not HasInitialCRC))} or (CurrFile = ''); // * TODO: check error if (not ParamBool1) and HasFinalCRC then Engine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName, nil); if Cancelled and (not PrivateCancel) then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; end; if not (Cancelled or PrivateCancel) then if HasFinalCRC then begin if CurrentCRC = ParamLongWord1 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); // * TODO: set real error, also free it Engine.CloseFile(FD, nil); end; libc_free(Buffer); SenderThread.FDoneThread := True; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure SplitFilesWorker(SenderThread: TWorkerThread); // ParamInt64 = SplitSize // ParamString1 = FileName // ParamString2 = NewPath // ParamBool1 = DeleteTarget const SplitBlockSize = 65536*4; var FD: TEngineFileDes; Error: PGError; FileCRC: LongWord; Buffer: Pointer; PrivateCancel: boolean; FilePath: string; SizeDone, TDF, FileSize, CurrSize: Int64; function WriteSplitPart(TargetFile: string; PartSize: Int64; var Written: Int64): boolean; var FDW: TEngineFileDes; Count, wCount, bl: integer; begin Result := False; Written := 0; with SenderThread do begin // * TODO: check error FDW := Engine.OpenFile(TargetFile, omWrite, @Error); DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); if Error <> nil then Exit; if ParamInt64 > 0 then begin UpdateCaption2(Format(LANGToS, [StrToUTF8(TargetFile)])); SetProgress1Params(PartSize); UpdateProgress1(0, '0 %'); end else UpdateCaption1(Format(LANGToS, [StrToUTF8(TargetFile)])); CommitGUIUpdate; repeat // * TODO: check error DebugMsg(['Seek to ', Engine.FileSeek(FD, SizeDone + Written, @Error), ', Written = ', Written]); if Written + SplitBlockSize > PartSize then bl := PartSize - Written else bl := SplitBlockSize; // * TODO: check error Count := Engine.ReadFile(FD, Buffer, bl, @Error); if (Error <> nil) or (Count <> bl) then begin // * TODO: set real error, also free it Engine.CloseFile(FDW, nil); DebugMsg(['Read Error: ', Error^.message, ', Count = ', Count, ', bl = ', bl]); // if (Count <> bl) and (Error = 0) then Error := EIO; Exit; end; // * TODO: check error wCount := Engine.WriteFile(FDW, Buffer, Count, @Error); Inc(Written, wCount); FileCRC := CRC32(FileCRC, Buffer, wCount); if (Error <> nil) or (Count <> wCount) then begin // * TODO: set real error, also free it Engine.CloseFile(FDW, nil); // * TODO: check error DebugMsg(['Write Error: ', Error^.message, ', Count = ', Count, ', wCount = ', wCount]); // if (wCount <> Count) and (Error = 0) then Error := ENOSPC; Exit; end; UpdateProgress1(FProgress1Pos + wCount, Format('%d %%', [Trunc((FProgress1Pos + wCount) / FProgress1Max * 100)])); if ParamInt64 > 0 then UpdateProgress2(FProgress2Pos + wCount, Format('%d %%', [Trunc((FProgress2Pos + wCount) / FProgress2Max * 100)])); CommitGUIUpdate; until (Written = PartSize) or Cancelled or PrivateCancel; // * TODO: set real error, also free it Engine.CloseFile(FDW, nil); end; 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; with SenderThread do begin Engine.GetFileSystemInfo(FilePath, x, TDF, xx); // Calculate part size if ParamInt64 = 0 then begin if FileSize - SizeDone > TDF then CurrSize := TDF else CurrSize := FileSize - SizeDone; end else if SizeDone + ParamInt64 > FileSize then CurrSize := FileSize - SizeDone else CurrSize := ParamInt64; 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; end; var i: integer; OriginalFName, st, FileName: string; ws: Int64; Stat: PDataItem; b: boolean; List: TList; x: Int64; xx: string; begin with SenderThread do begin // * TODO: check error Stat := Engine.GetFileInfo(ParamString1, True, True, nil); if not Assigned(Stat) then begin FCancelMessage := Format(LANGCannotOpenFileS, [StrToUTF8(ParamString1)]); FShowCancelMessage := True; Exit; end; if (ParamInt64 > 0) and (Stat^.Size > ParamInt64 * 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; // * TODO: check error FD := Engine.OpenFile(ParamString1, omRead, @Error); if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(ParamString1), Error^.message]); libc_free(Buffer); Exit; end; FilePath := IncludeTrailingPathDelimiter(ProcessPattern(Engine, ParamString2, Engine.Path, '', True)); FileName := ExtractFileName(ParamString1); OriginalFName := FileName; if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.001') else FileName := FileName + '.001'; PrivateCancel := False; if ParamInt64 > 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 Engine.GetFileSystemInfo(FilePath, x, TDF, xx); // Delete target files if necessary if ParamBool1 and ((TDF < 512) or (TDF < FileSize) or (TDF < ParamInt64)) then try if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); List.Clear; // * TODO: check error { Error := Engine.GetListing(List, FilePath, ConfShowDotFiles, False, False, nil); if (Error = 0) 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 Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + string(PDataItem(List[i])^.FName)); if Error <> 0 then ShowMessageBox(Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath)) + string(PDataItem(List[i])^.FDisplayName), GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); end; end; } except end; // Test for target file existence if Engine.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 // * TODO: check error { Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + FileName); if Error <> 0 then begin FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName), GetErrorString(Error)]); FShowCancelMessage := True; PrivateCancel := True; 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 (ParamInt64 > 0) then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, [Error^.message]); FShowCancelMessage := True; PrivateCancel := True; Break; end; Inc(SizeDone, ws); if ParamInt64 > 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 Cancelled or PrivateCancel or (FileName = ''); if Cancelled and (not PrivateCancel) then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; end; if not (Cancelled or PrivateCancel) then begin repeat Engine.GetFileSystemInfo(FilePath, x, TDF, xx); if (TDF < 512) and (not NewDiskQuestion) then Break; until (TDF >= 512) or PrivateCancel or Cancelled; if WriteCRCFile(ProgressForm, Engine, 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; // * TODO: set real error, also free it Engine.CloseFile(FD, nil); end; if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); List.Free; SenderThread.FDoneThread := True; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ChmodFilesWorker(SenderThread: TWorkerThread); // ParamBool1 = Recursive // ParamInt1 = All/Dir/Files // ParamCardinal1 = Mode var SkipAll: boolean; function HandleChmod(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; begin Result := True; with SenderThread do begin // 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 ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; if (not AFileRec^.DataItem^.IsDir) and ParamBool1 and (ParamInt1 = 1) then Exit; // Directories only if AFileRec^.DataItem^.IsDir and ParamBool1 and (ParamInt1 = 2) then Exit; // Files only // * TODO: check error Res := Engine.Chmod(String(AFileRec^.DataItem^.FName), ParamCardinal1, nil); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin // * TODO: check error Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChmoddedS, ['ahoj' {GetErrorString(Res)}]), LANGDialogChangePermissions); case Response of 1 : Result := True; 3 : begin SkipAll := True; Result := True; end; 2 : Result := HandleChmod(AFileRec); else Result := False; end; end; end; end; var i: longint; AList: TList; Fr: Single; begin SkipAll := False; AList := TList.Create; with SenderThread do begin PrepareJobFilesFromPanel(AList, not ParamBool1); 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 Cancelled 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; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; end; SenderThread.FDoneThread := True; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ChownFilesWorker(SenderThread: TWorkerThread); // ParamBool1 = Recursive // ParamCardinal1 = UID // ParamCardinal2 = GID var SkipAll: boolean; function HandleChown(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; begin Result := True; with SenderThread do begin // 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 ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk)) or ((not AFileRec^.DataItem^.IsDir) and ParamBool1) then Exit; // * TODO: check error Res := Engine.Chown(String(AFileRec^.DataItem^.FName), ParamCardinal1, ParamCardinal2, nil); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin // * TODO: check error Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChownedS, ['ahoj' {GetErrorString(Res)}]), LANGDialogChangeOwner); case Response of 1 : Result := True; 3 : begin SkipAll := True; Result := True; end; 2 : Result := HandleChown(AFileRec); else Result := False; end; end; end; end; var i: longint; AList: TList; Fr: Single; begin SkipAll := False; AList := TList.Create; with SenderThread do begin PrepareJobFilesFromPanel(AList, not ParamBool1); 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 Cancelled 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; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; end; SenderThread.FDoneThread := True; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure DummyThreadWorker(SenderThread: TWorkerThread); var i: integer; begin DebugMsg(['(II) DummyThreadWorker: begin']); with SenderThread do 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 Cancelled then Break; end; end; DebugMsg(['(II) DummyThreadWorker: finish']); SenderThread.FDoneThread := True; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TOpenDirThread.Create; begin inherited Create(True); FreeOnTerminate := False; Finished := False; CancelIt := 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 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 GoUp(APath); 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 CancelIt) then begin ChDirResult := ChangeDir(AEngine, APath, ASelItem, AAutoFallBack); if ChDirResult and (not CancelIt) then ListingResult := AEngine.GetListing(ADirList, AEngine.GetPath, ConfShowDotFiles, True, False, @ListingError); end; except on E: Exception do DebugMsg(['*** Exception raised in TOpenDirThread.Execute (', E.ClassName, '): ', E.Message]); end; RunningTime := MilliSecondsBetween(tt, Now); finally Finished := True; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TOpenConnectionThread.Create; begin inherited Create(True); FreeOnTerminate := False; Finished := 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 Finished := True; end; end; end.