diff options
Diffstat (limited to 'UCoreWorkers.pas')
| -rw-r--r-- | UCoreWorkers.pas | 2180 |
1 files changed, 2180 insertions, 0 deletions
diff --git a/UCoreWorkers.pas b/UCoreWorkers.pas new file mode 100644 index 0000000..bcdd07f --- /dev/null +++ b/UCoreWorkers.pas @@ -0,0 +1,2180 @@ +(* + Tux Commander - UCoreWorkers - worker threads, operations + Copyright (C) 2009 Tomas Bzatek <tbzatek@users.sourceforge.net> + 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; + 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): integer; + protected + procedure Execute; override; + public + APath: string; + ASelItem: string; + AAutoFallBack: boolean; + ADirList: TList; + ChDirResult, ListingResult, VFSOpenResult: integer; + Finished, CancelIt: boolean; + RunningTime: Int64; + AFullPath, AHighlightItem: string; + constructor Create; + destructor Destroy; override; + end; + + TOpenConnectionThread = class(TVFSCallbackThread) + private + protected + procedure Execute; override; + public + URI: string; + Finished: boolean; + OpenResult: boolean; + 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; + +function vfs_progress_callback(position, max: guint64; 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); + except + on E: Exception do DebugMsg(['*** Exception raised in vfs_progress_callback(position=', position, ', max=', max, ', 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; + x: PDataItemSL; +begin + CurrPath := IncludeTrailingPathDelimiter(Engine.Path); + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do + with PDataItem(DataList[i])^ do + if (not UpDir) and Selected then + if IsDir and (not IsLnk) and (not DoNotRecurse) + then FillDirFiles(Engine, AList, CurrPath + String(FName)) + else begin + x := GetFileInfoSL(Engine, CurrPath + String(FName)); + if x <> nil then AList.Add(x); + end; + if (AList.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then + with SelectedItem^ do + if IsDir and (not IsLnk) and (not DoNotRecurse) + then FillDirFiles(Engine, AList, CurrPath + String(FName)) + else begin + x := GetFileInfoSL(Engine, CurrPath + String(FName)); + if x <> nil then AList.Add(x); + end; +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; + + function HandleDelete(AFileRec: PDataItemSL): boolean; + var Res, Response: integer; + begin + Result := True; +// 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)); +// DebugMsg(['Result : ', Res]); + if Res <> 0 then + if SkipAll then Result := True else + begin + Response := SenderThread.ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), + Format(LANGCouldNotBeDeletedS, [GetErrorString(Res)])); + case Response of + 1 : Result := True; + 3 : begin + SkipAll := True; + Result := True; + end; + 2 : Result := HandleDelete(AFileRec); + else Result := False; + end; + end; + end; + +var i: longint; + AList: TList; + CurrPath: string; + Fr: Single; + Response: integer; + DeleteAll, SkipToNext: boolean; +begin + SkipAll := False; + AList := TList.Create; + AList.Clear; + with SenderThread do begin + CurrPath := IncludeTrailingPathDelimiter(Engine.Path); + PrepareJobFilesFromPanel(AList, False); + if Engine.ChangeDir(CurrPath) <> 0 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; + if Engine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + end; + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) + + // Return False to break the process + function CopyFilesWorker_ProgressFunc(Sender: Pointer; BytesDone: Int64): 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 := ''; + + case ShowDirDeleteDialog(3, s, s3, 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; + Error, BSize: integer; + Buffer: Pointer; + BytesDone, BytesRead, BytesWritten: Int64; + Res: boolean; + begin + DebugMsg(['ManualCopyFile: ', SourceFile, ' ---> ', DestFile]); + with SenderThread do begin + Result := False; + Error := 0; + fsrc := SrcEngine.OpenFile(SourceFile, omRead, Error); + if Error <> 0 then begin + CopyFilesWorker_ErrorFunc(SenderThread, 2, 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 Error <> 0 then begin + SrcEngine.CloseFile(fsrc); + CopyFilesWorker_ErrorFunc(SenderThread, 3, 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 <> 0) then + Res := CopyFilesWorker_ErrorFunc(SenderThread, 6, Error, SourceFile); // Cannot read from source file + if BytesRead > 0 then begin + BytesWritten := DestEngine.WriteFile(fdst, Buffer, BytesRead, Error); + if (BytesWritten < BytesRead) then + Res := CopyFilesWorker_ErrorFunc(SenderThread, 7, Error, DestFile); // Cannot write to source file + end; + Inc(BytesDone, BytesRead); + if not CopyFilesWorker_ProgressFunc(SenderThread, BytesDone) then begin + Res := False; + Break; + end; + until (BytesRead = 0) or (BytesWritten < BytesRead); + libc_free(Buffer); + + if DestEngine.CloseFile(fdst) <> 0 then begin + CopyFilesWorker_ErrorFunc(SenderThread, 4, errno, DestFile); // Cannot close target file + Exit; + end; + if SrcEngine.CloseFile(fsrc) <> 0 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(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ProgressFunc, @CopyFilesWorker_ErrorFunc, Append) + else + + // from local engine to VFS engine + if (SrcEngine is TLocalTreeEngine) and (DestEngine is TVFSEngine) then + begin + AEngine := DestEngine; + Result := (DestEngine as TVFSEngine).CopyFileInEx(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ErrorFunc, Append, + @vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_progress_callback, SenderThread); + 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(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ErrorFunc, Append, + @vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_progress_callback, SenderThread); + 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 + DataSrc := SrcEngine.GetFileInfo(SourceFile, False, True); + if DataSrc = nil then Exit; + DataDest := DestEngine.GetFileInfo(DestFile, False, True); + if (DataDest <> nil) and (DataSrc^.Size <> DataDest^.Size) then + DestEngine.Remove(DestFile); + 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 + ErrorKind := DestEngine.MakeSymLink(Dst, String(DataItem^.LnkPointTo)); + if ErrorKind <> 0 then Result := ERRCreateLink; + if not ParamBool3 then begin + ErrorKind := SrcEngine.Remove(String(DataItem^.FName)); + if ErrorKind <> 0 then Result := ERRRemove; + end; + end else begin // Move the file + ErrorKind := DestEngine.RenameFile(String(DataItem^.FName), Dst); + 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; + DestEngine.Chmod(Dst, DataItem^.Mode); + DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID); + DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime); + 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']); + ErrorKind := DestEngine.RenameFile(String(DataItem^.FName), Dst + '_tcmd'); + if ErrorKind = 0 then ErrorKind := DestEngine.RenameFile(Dst + '_tcmd', Dst); + end else ErrorKind := DestEngine.RenameFile(String(DataItem^.FName), Dst); + 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; + DestEngine.Chmod(Dst, DataItem^.Mode); + DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID); + DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime); + if not Cancelled then begin + ErrorKind := SrcEngine.Remove(String(DataItem^.FName)); + 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; + DestEngine.Chmod(NewFilePath, DataItem^.Mode); + DestEngine.Chown(NewFilePath, DataItem^.UID, DataItem^.GID); + DestEngine.ChangeTimes(NewFilePath, DataItem^.mtime, DataItem^.atime); + if not ParamBool3 then SrcEngine.Remove(String(DataItem^.FName)); // 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']); + ErrorKind := DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd'); + if ErrorKind = 0 then ErrorKind := DestEngine.RenameFile(ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination))); + end else ErrorKind := DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), string(AFileRec^.ADestination)); + if ErrorKind <> 0 then Res := ERRCopyMove + else Res := 0; + end else + if not DestEngine.DirectoryExists(NewFilePath, False) then begin + ErrorKind := DestEngine.MakeDir(NewFilePath); + if ErrorKind <> 0 then Res := ERRMkDir + else Res := 0; + end; + end else begin // not a directory + if not DestEngine.DirectoryExists(ExtractFileDir(NewFilePath), False) then DestEngine.MakeDir(ExtractFileDir(NewFilePath)); + 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); + 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; + Item := DestEngine.GetFileInfo(NewFilePath, False, True); + 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 + r := DestEngine.Remove(NewFilePath); + while r <> 0 do begin + Res := ShowDirDeleteDialog(1, LANGTheFile, StrToUTF8(String(NewFilePath)), + Format(LANGCouldNotBeDeletedS, [GetErrorString(r)]), LANGCopyError); + case Res of + 1: begin + Result := True; + Exit; + end; + 2: r := DestEngine.Remove(NewFilePath); + 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; + 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; + + procedure HandleProcessPattern(AList: TList; CurrPath, FullPath, ParamFileName: string; ParamDir, Ren: boolean); + var s, s2: string; + b, CaseInsensitiveRename: boolean; + Info: PDataItemSL; + begin + with SenderThread do + if not Ren then begin + if ParamDir then FillDirFiles(SrcEngine, AList, FullPath) + else begin + Info := GetFileInfoSL(SrcEngine, FullPath); + if Info = nil then DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']) + else AList.Add(Info); + end; + 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 FillDirFiles(SrcEngine, AList, FullPath); + end; + end; + +var i: longint; + List: TList; + CurrPath, SaveDestPath, SaveSrcPath, s: string; + MaxSize: Int64; +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; + + 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 + 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; + + // Free the objects + if List.Count > 0 then + for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); + List.Clear; + List.Free; + if DestEngine.ChangeDir(SaveDestPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if SaveSrcPath <> '' then CurrPath := SaveSrcPath; + if SrcEngine.ChangeDir(CurrPath) <> 0 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; + Error, 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; + 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; + Stat := Engine.GetFileInfo(FName, True, True); + if not Assigned(Stat) then Exit; + SetProgress1Params(Stat^.Size); + FreeDataItem(Stat); + FDR := Engine.OpenFile(FName, omRead, Error); + if Error <> 0 then Exit; + repeat + Count := Engine.ReadFile(FDR, Buffer, MergeBlockSize, Error); + if Error <> 0 then begin + Engine.CloseFile(FD); + Exit; + end; + wCount := Engine.WriteFile(FD, Buffer, Count, Error); + if (Error <> 0) or (Count <> wCount) then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [ExtractFileName(TargetName), GetErrorString(Error)]); + 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; + Engine.CloseFile(FDR); + 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 + Error := Engine.Remove(TargetName); + if Error <> 0 then begin + FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), GetErrorString(Error)]); + FShowCancelMessage := True; + Exit; + end; + end else Exit; + + Stat := Engine.GetFileInfo(ParamString2, True, True); + 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 := Engine.OpenFile(TargetName, omWrite, Error); + if Error <> 0 then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), GetErrorString(Error)]); + 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 = ''); + if (not ParamBool1) and HasFinalCRC then Engine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName); + 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); + Engine.CloseFile(FD); + 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: integer; + 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 + FDW := Engine.OpenFile(TargetFile, omWrite, Error); + DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); + if Error <> 0 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 + DebugMsg(['Seek to ', Engine.FileSeek(FD, SizeDone + Written, Error), ', Written = ', Written]); + if Written + SplitBlockSize > PartSize then bl := PartSize - Written + else bl := SplitBlockSize; + Count := Engine.ReadFile(FD, Buffer, bl, Error); + if (Error <> 0) or (Count <> bl) then begin + Engine.CloseFile(FDW); + DebugMsg(['Read Error: ', GetErrorString(Error), ', Count = ', Count, ', bl = ', bl]); + if (Count <> bl) and (Error = 0) then Error := EIO; + Exit; + end; + wCount := Engine.WriteFile(FDW, Buffer, Count, Error); + Inc(Written, wCount); + FileCRC := CRC32(FileCRC, Buffer, wCount); + if (Error <> 0) or (Count <> wCount) then begin + Engine.CloseFile(FDW); + DebugMsg(['Write Error: ', GetErrorString(Error), ', 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; + Engine.CloseFile(FDW); + 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 + Stat := Engine.GetFileInfo(ParamString1, True, True); + 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; + FD := Engine.OpenFile(ParamString1, omRead, Error); + if Error <> 0 then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(ParamString1), GetErrorString(Error)]); + 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; + Error := Engine.GetListing(List, FilePath, ConfShowDotFiles, False, False); + 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 + 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, [GetErrorString(Error)]); + 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(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; + Engine.CloseFile(FD); + 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 Res, Response: integer; + 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 + Res := Engine.Chmod(String(AFileRec^.DataItem^.FName), ParamCardinal1); +// DebugMsg(['Result : ', Res]); + if Res <> 0 then + if SkipAll then Result := True else + begin + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChmoddedS, + [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; + with SenderThread do begin + AList := TList.Create; + 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 Res, Response: integer; + 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; + Res := Engine.Chown(String(AFileRec^.DataItem^.FName), ParamCardinal1, ParamCardinal2); +// DebugMsg(['Result : ', Res]); + if Res <> 0 then + if SkipAll then Result := True else + begin + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChownedS, + [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; + with SenderThread do begin + AList := TList.Create; + 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 := 0; + ListingResult := 0; + VFSOpenResult := 0; + RunningTime := 0; +end; + +destructor TOpenDirThread.Destroy; +begin + inherited Destroy; +end; + +(********************************************************************************************************************************) +function TOpenDirThread.ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; + + 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; + Error : integer; +begin + 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 + if Engine is TVFSEngine + then Error := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self) + else Error := Engine.ChangeDir(APath); + + while AutoFallback and (Error <> 0) and (APath <> '/') do begin + GoUp(APath); + if Engine is TVFSEngine + then Error := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self) + else Error := Engine.ChangeDir(APath); + end; + // Going on... + if Error <> 0 then begin + Result := Error; + DebugMsg(['*** UCore.ChangeDir: error during Engine.ChangeDir: ', GetErrorString(Error)]); + Exit; + end; + Engine.Path := APath; + Result := 0; + except + on E: Exception do begin + DebugMsg(['*** Exception raised in UCore.ChangeDir (', E.ClassName, '): ', E.Message]); + Result := 1; + 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); + end else VFSOpenResult := 0; + + if (VFSOpenResult = 0) and (not CancelIt) then begin + ChDirResult := ChangeDir(AEngine, APath, ASelItem, AAutoFallBack); + if (ChDirResult = 0) and (not CancelIt) then + ListingResult := AEngine.GetListing(ADirList, AEngine.GetPath, ConfShowDotFiles, True, False); + 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; +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); + finally + Finished := True; + end; +end; + + +end. |