diff options
Diffstat (limited to 'UCore.pas')
| -rw-r--r-- | UCore.pas | 2676 |
1 files changed, 322 insertions, 2354 deletions
@@ -23,129 +23,38 @@ interface uses glib2, gtk2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore, uVFSprototypes; +// Panel utilities function FillPanel(List: TList; ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean): boolean; -function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; procedure FindNextSelected(ListView: TGTKListView; DataList: TList; var Item1, Item2: string); procedure UnselectAll(ListView: TGTKListView; DataList: TList); +procedure FillDirFiles(Engine: TPanelEngine; List: TList; const APath: string); +function GetFileInfoSL(Engine: TPanelEngine; const APath: string): PDataItemSL; -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: PInteger; - VFSAskPassword_domain: PPChar; - VFSAskPassword_password_save: PVFSPasswordSave; - VFSAskPassword_Display: boolean; - VFSAskPassword_Result: LongBool; - - VFSCallbackCancelled: boolean; - - VFSConnectionManagerMode: boolean; - VFSQuickConnectMode: boolean; - VFSDialogsParentWindow: PGtkWidget; - - FCancelRequested: boolean; - - constructor Create(CreateSuspended: boolean); - destructor Destroy; override; - end; +procedure DebugWriteListSL(List: TList); +procedure DebugWriteList(List: TList); - 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; +// Classic functions - don't need progress window +function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; +function CreateSymlink(const FileName, PossibleNewName: string; Engine: TPanelEngine) : boolean; +function EditSymlink(const FileName: string; Engine: TPanelEngine) : boolean; - constructor Create; - destructor Destroy; override; - procedure CancelIt; - function Cancelled: 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; +procedure GetDirSize(AListView: TGTKListView; Engine: TPanelEngine; DataList: TList; AllItems: boolean); + +// Other classes +procedure FillDefaultFstabMounterItems; + +function CRCGetInfo(FileName: string; Engine: TPanelEngine; var TargetName: string; var TargetCRC: LongWord; var Size: Int64): boolean; +function WriteCRCFile(Engine: TPanelEngine; TargetFile, SplitFileName: string; const FileSize: Int64; const FileCRC: Longword): boolean; +function ComputeBlockSize(TotalSize: Int64): longint; + +function PurgeDirectory(APath: string): boolean; +procedure CleanTempDirs; + + +type TGetDirSizeThread = class(TThread) private FCancelled: boolean; @@ -160,53 +69,7 @@ type TVFSCallbackThread = class(TThread) procedure CancelIt; 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); - -// Classic functions - don't need progress window -function CreateSymlink(const FileName, PossibleNewName: string; Engine: TPanelEngine) : boolean; -function EditSymlink(const FileName: string; Engine: TPanelEngine) : boolean; -procedure GetDirSize(AListView: TGTKListView; Engine: TPanelEngine; DataList: TList; AllItems: boolean); - - -type TMounterItem = class + TMounterItem = class public // Strings are in locale encoding (ANSI) DisplayText, MountPath, Device, IconPath, MountCommand, UmountCommand: string; @@ -226,19 +89,6 @@ type TMounterItem = class function GetURI(IncludePassword: boolean): string; end; -procedure FillDefaultFstabMounterItems; - -procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); - -function CRCGetInfo(FileName: string; Engine: TPanelEngine; var TargetName: string; var TargetCRC: LongWord; var Size: Int64): boolean; - -function ComputeBlockSize(TotalSize: Int64): longint; - -function PurgeDirectory(APath: string): boolean; -procedure CleanTempDirs; - -procedure DebugWriteListSL(List: TList); -procedure DebugWriteList(List: TList); {$IFDEF KYLIX} const INFINITE = Cardinal(-1); @@ -260,189 +110,13 @@ var LeftLocalEngine, RightLocalEngine: TPanelEngine; implementation (********************************************************************************************************************************) uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, - UNewDir, UFileAssoc, USymlink, UCoreClasses, URemoteWait, UMain, UGnome, - 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: PInteger; domain: PPChar; password_save: PVFSPasswordSave; - user_data: Pointer): LongBool; 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; + UNewDir, UFileAssoc, USymlink, UCoreClasses, URemoteWait, UMain, UGnome; - 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: Int64; user_data: Pointer): LongBool; 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 ClearListData(List: TList); @@ -569,15 +243,15 @@ begin ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 5: begin - s2 := FormatDate(ModifyTime, True, True); + s2 := FormatDate(mtime, True, True); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 6: begin - s2 := FormatDate(ModifyTime, False, True); + s2 := FormatDate(mtime, False, True); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 7: begin - s2 := FormatDate(ModifyTime, True, False); + s2 := FormatDate(mtime, True, False); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 8: begin @@ -628,778 +302,133 @@ begin end; (********************************************************************************************************************************) -function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; -var Error: integer; -begin - Result := False; - try - Error := Engine.MakeDir(IncludeTrailingPathDelimiter(Engine.Path) + NewDir); - if Error <> 0 then begin - Application.MessageBox(Format(LANGErrorCreatingNewDirectorySInSPanel, [StrToUTF8(NewDir), LANGPanelStrings[LeftPanel], GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); - Exit; - end; - Result := True; - except - on E: Exception do begin - Application.MessageBox(Format(LANGErrorCreatingNewDirectorySInSPanelNoPath, [LANGPanelStrings[LeftPanel], E.Message]), [mbOK], mbError, mbNone, mbOK); - Exit; - end; - 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^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk) then Exit; - Res := SenderThread.Engine.Remove(String(AFileRec^.FName)); -// DebugMsg(['Result : ', Res]); - if Res <> 0 then - if SkipAll then Result := True else - begin - Response := SenderThread.ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.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; - x: PDataItemSL; - +procedure FindNextSelected(ListView: TGTKListView; DataList: TList; var Item1, Item2: string); +var i: integer; + SelCount: longint; begin - SkipAll := False; - AList := TList.Create; - AList.Clear; - with SenderThread do 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) - then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) - else begin - x := Engine.GetFileInfoSL(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) - then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) - else begin - x := Engine.GetFileInfoSL(CurrPath + String(FName)); - if x <> nil then AList.Add(x); - end; - if Engine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); - Engine.ExplicitChDir('/'); - - 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; + SelCount := 0; + Item1 := ''; Item2 := ''; + if (not Assigned(ListView.Selected)) or PDataItem(ListView.Selected.Data)^.UpDir then Exit; + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do + with PDataItem(DataList[i])^ do + if Selected and (not UpDir) then Inc(SelCount); + Item1 := string(PDataItem(ListView.Selected.Data)^.FName); + if (PDataItem(ListView.Selected.Data)^.Selected and (SelCount > 0)) or (SelCount = 0) then begin + if ListView.ConvertToSorted(ListView.Selected.Index) < ListView.Items.Count then + for i := ListView.ConvertToSorted(ListView.Selected.Index) + 1 to DataList.Count - 1 do + if not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.Selected then begin + Item2 := string(PDataItem(DataList[ListView.ConvertFromSorted(i)])^.FName); 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])^.IsDir and - (not PDataItemSL(AList[i])^.IsLnk) and (i < AList.Count - 2) and (PDataItemSL(AList[i + 1])^.Level = 2) then + if (Item2 = '') and (ListView.ConvertToSorted(ListView.Selected.Index) > 0) then + for i := ListView.ConvertToSorted(ListView.Selected.Index) - 1 downto 0 do + if (not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.Selected) and + (not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.UpDir) then begin - Response := ShowDirDeleteDialog(4, Format(LANGTheDirectorySIsNotEmpty, [string(PDataItemSL(AList[i])^.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; + Item2 := string(PDataItem(DataList[ListView.ConvertFromSorted(i)])^.FName); + Break; end; - // Process delete - if not HandleDelete(AList[i]) then Break; - UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); - UpdateCaption1(PDataItemSL(AList[i])^.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; - - - - +end; +(********************************************************************************************************************************) +procedure UnselectAll(ListView: TGTKListView; DataList: TList); +var i: integer; +begin + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do + with PDataItem(DataList[i])^ do + if Selected then begin + Selected := False; + ListView.Items[i].RedrawRow; + end; +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; +procedure FillDirFiles(Engine: TPanelEngine; List: TList; const APath: string); + + procedure FillDirFilesRecurse(const LocalPath: string; ALevel: integer); + var LocalList: TList; + i: integer; + Item: PDataItem; + ItemSL: PDataItemSL; + ParentDir: string; 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; + LocalList := TList.Create; + if Engine.GetListing(LocalList, LocalPath, True, False, True) = 0 then begin + for i := 0 to LocalList.Count - 1 do begin + Item := LocalList[i]; + ItemSL := malloc(sizeof(TDataItemSL)); + memset(ItemSL, 0, sizeof(TDataItemSL)); + ItemSL^.DataItem := Item; + ItemSL^.Stage1 := True; + ItemSL^.IsOnRO := Engine.IsOnROMedium(string(Item^.FName)); + ItemSL^.Level := ALevel; + List.Add(ItemSL); + + if Item^.IsDir then begin + // Recurse to parent + ParentDir := IncludeTrailingPathDelimiter(string(Item^.FName)); + if Engine.ChangeDir(ParentDir) = 0 then + FillDirFilesRecurse(ParentDir, ALevel + 1); + + // Add end stage + ItemSL := DuplicateDataItem(ItemSL); + ItemSL^.Stage1 := False; + List.Add(ItemSL); 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: PDataItemSL; - 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.GetFileInfoSL(SourceFile); - if DataSrc = nil then Exit; - DataDest := DestEngine.GetFileInfoSL(DestFile); - if DataDest = nil then Exit; - if DataSrc^.Size <> DataDest^.Size then DestEngine.Remove(DestFile); - 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); - 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 - Result := TestCaseInsensitiveFS and DestEngine.TwoSameFiles(Path1, Path2); - 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 IsLnk then begin - // Explicit copy the file - if ParamBool3 or (not IsOnSameFS(String(FName), ExtractFileDir(Dst))) then begin - ErrorKind := DestEngine.MakeSymLink(Dst, String(LnkPointTo)); - if ErrorKind <> 0 then Result := ERRCreateLink; - if not ParamBool3 then begin - ErrorKind := SrcEngine.Remove(String(FName)); - if ErrorKind <> 0 then Result := ERRRemove; - end; - end else begin // Move the file - ErrorKind := DestEngine.RenameFile(String(FName), Dst); - if ErrorKind <> 0 then Result := ERRCopyMove; - end; - end else // is not link - if ParamBool3 then begin // Copy mode - if LocalCopyFile(String(FName), Dst, Append) then begin - if IsOnRO and ConfClearReadOnlyAttr and (Mode and S_IWUSR = 0) then Mode := Mode or S_IWUSR; - DestEngine.Chmod(Dst, Mode); - DestEngine.Chown(Dst, UID, GID); - DestEngine.ChangeTimes(Dst, mtime, atime); - end; - end else // Move mode - if IsOnSameFS(String(FName), ExtractFileDir(Dst)) then begin - if TwoSameFiles(String(FName), Dst, True) and (not TwoSameFiles(String(FName), Dst, False)) then begin - DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); - ErrorKind := DestEngine.RenameFile(String(FName), Dst + '_tcmd'); - if ErrorKind = 0 then ErrorKind := DestEngine.RenameFile(Dst + '_tcmd', Dst); - end else ErrorKind := DestEngine.RenameFile(String(FName), Dst); - if ErrorKind <> 0 then Result := ERRCopyMove; - end else begin - if LocalCopyFile(String(FName), Dst, Append) then begin - if IsOnRO and ConfClearReadOnlyAttr and (Mode and S_IWUSR = 0) then Mode := Mode or S_IWUSR; - DestEngine.Chmod(Dst, Mode); - DestEngine.Chown(Dst, UID, GID); - DestEngine.ChangeTimes(Dst, mtime, atime); - if not Cancelled then begin - ErrorKind := SrcEngine.Remove(String(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 else begin + // Clear remaining items (in case of error) + for i := 0 to LocalList.Count - 1 do + FreeDataItem(PDataItem(LocalList[i])); end; + LocalList.Free; end; - // Return False to break the processing (Cancel) - function HandleCopy(AFileRec: PDataItemSL; NewFilePath: string): boolean; - var Res, Response, ErrorKind, r: integer; - Item: PDataItemSL; - 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 (Mode and S_IWUSR = 0) then Mode := Mode or S_IWUSR; - DestEngine.Chmod(NewFilePath, Mode); - DestEngine.Chown(NewFilePath, UID, GID); - DestEngine.ChangeTimes(NewFilePath, mtime, atime); - if not ParamBool3 then SrcEngine.Remove(String(FName)); // Remove directory - Exit; - end; - - // First stage - copy data - if AFileRec^.IsDir then begin - Res := 0; - if AFileRec^.ForceMove and (not ParamBool3) - then begin - if TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), True) and (not - TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), False)) then - begin - DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); - ErrorKind := DestEngine.RenameFile(string(AFileRec^.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^.FName), string(AFileRec^.ADestination)); - if ErrorKind <> 0 then Res := ERRCopyMove - else Res := 0; - end else - if not DestEngine.DirectoryExists(NewFilePath, True) 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), True) then DestEngine.MakeDir(ExtractFileDir(NewFilePath)); - SetProgress1Params(AFileRec^.Size + Ord(AFileRec^.Size = 0)); - if AFileRec^.Size <= 1 then ParamFloat2 := 1 else ParamFloat2 := 100 / (AFileRec^.Size - 1); - CopyFilesWorker_ProgressFunc(SenderThread, 0); - Res := 0; - if DestEngine.FileExists(NewFilePath, True) and - (not (not ParamBool3 and (not TwoSameFiles(NewFilePath, AFileRec^.FName, False)) and TwoSameFiles(NewFilePath, AFileRec^.FName, True))) - then begin - Response := DefResponse; - Item := DestEngine.GetFileInfoSL(NewFilePath); - 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^.ModifyTime, True, True)]); - ToInfoLabel := Format(InfoLabelFormat, [FormatSize(AFileRec^.Size, 0), FormatDate(AFileRec^.ModifyTime, True, True)]); - Response := ShowOverwriteDialog(1 + Ord(ParamBool3), Format(LANGOverwriteS, [StrToUTF8(NewFilePath)]), FromInfoLabel, - Format(LANGWithFileS, [AFileRec^.FDisplayName]), ToInfoLabel, - ExtractFileName(StrToUTF8(NewFilePath)), ExtractFileName(AFileRec^.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^.ModifyTime < AFileRec^.ModifyTime)) 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^.IsDir then s1 := LANGTheDirectory else - if AFileRec^.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; +var root: PDataItemSL; +begin + root := GetFileInfoSL(Engine, APath); + if (root = nil) then begin + DebugMsg(['FillDirFiles: cannot stat ', APath]); + Exit; 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 SrcEngine.FillDirFiles(FullPath, AList, 1) - else begin - Info := SrcEngine.GetFileInfoSL(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); -// DebugMsg(['HandleProcessPattern: s = ', s]); - b := False; - if ParamDir then begin - b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s)) 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)); - end; - end; - if (not ParamDir) or (ParamDir and b and IsOnSameFS(ExcludeTrailingPathDelimiter(FullPath), s2)) - then begin - Info := SrcEngine.GetFileInfoSL(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 SrcEngine.FillDirFiles(FullPath, AList, 1); - end; + if (not root^.DataItem^.IsDir) then begin + DebugMsg(['FillDirFiles: path "', APath, '" is not a directory, cannot recurse.']); + FreeDataItem(root); + Exit; 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; + // Add starting item + root^.Stage1 := True; + root^.Level := 1; + List.Add(root); -{ 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); + // Recurse to child + FillDirFilesRecurse(APath, 2); - __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])^.Size > 0) and (not PDataItemSL(List[i])^.IsDir) and (not PDataItemSL(List[i])^.IsLnk) - then Inc(MaxSize, PDataItemSL(List[i])^.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])^.FName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.FName) - Length(CurrPath)), - PDataItemSL(List[i])^.IsDir and (not PDataItemSL(List[i])^.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])^.FDisplayName)])) else - if (SrcEngine as TVFSEngine).ArchiveMode then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.FDisplayName)])])) - else UpdateCaption1(Format(LANGFromS, [GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.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])^.FName), ParamBool3) and (not PDataItemSL(List[i])^.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])^.FName) then - if not HandleCopy(List[i], s) then begin - ErrorHappened := True; - Break; - end; - if (not PDataItemSL(List[i])^.IsDir) and (not PDataItemSL(List[i])^.IsLnk) - then Inc(ParamInt64, PDataItemSL(List[i])^.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']); + // Add ending item + root := GetFileInfoSL(Engine, APath); + root^.Stage1 := False; + root^.Level := 1; + List.Add(root); end; - -(********************************************************************************************************************************) -function ComputeBlockSize(TotalSize: Int64): longint; +function GetFileInfoSL(Engine: TPanelEngine; const APath: string): PDataItemSL; +var ItemSL: PDataItemSL; begin - if TotalSize < 512*1024 then Result := 32*1024 else - if TotalSize < 1024*1024 then Result := 64*1024 else - if TotalSize < 2048*1024 then Result := 96*1024 else - if TotalSize < 4096*1024 then Result := 128*1024 else - if TotalSize < 8192*1024 then Result := 256*1024 else -{ if TotalSize < 256*1024*1024 then Result := 512*1024 else - if TotalSize < 768*1024*1024 then Result := 2048*1024 else } - Result := 4096*1024; + ItemSL := malloc(sizeof(TDataItemSL)); + memset(ItemSL, 0, sizeof(TDataItemSL)); + ItemSL^.DataItem := Engine.GetFileInfo(APath, False, True); + ItemSL^.Stage1 := True; + ItemSL^.Level := 1; + Result := ItemSL; end; + (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) @@ -1420,9 +449,9 @@ begin try WriteLn('**** List Item idx ', i, '; base @ ', integer(List[i]), '; sizeof = ', SizeOf(List[i])); Item := List[i]; - WriteLn(' Stage1: ', Item^.Stage1, ', Level: ', Item^.Level, ', IsDir: ', Item^.IsDir, ', IsLnk: ', Item^.IsLnk, ', ForceMove: ', Item^.ForceMove{, ', Size: ', Item^.Size}); - WriteLn(' FName: ', Item^.FName); - WriteLn(' LnkPointTo: ', Item^.LnkPointTo); + WriteLn(' Stage1: ', Item^.Stage1, ', Level: ', Item^.Level, ', IsDir: ', Item^.DataItem^.IsDir, ', IsLnk: ', Item^.DataItem^.IsLnk, ', ForceMove: ', Item^.ForceMove{, ', Size: ', Item^.Size}); + WriteLn(' FName: ', Item^.DataItem^.FName); + WriteLn(' LnkPointTo: ', Item^.DataItem^.LnkPointTo); WriteLn(' ADestination: ', Item^.ADestination); except on E: Exception do @@ -1460,741 +489,29 @@ begin WriteLn('********************************************************'); end; -(********************************************************************************************************************************) -procedure FindNextSelected(ListView: TGTKListView; DataList: TList; var Item1, Item2: string); -var i: integer; - SelCount: longint; -begin - SelCount := 0; - Item1 := ''; Item2 := ''; - if (not Assigned(ListView.Selected)) or PDataItem(ListView.Selected.Data)^.UpDir then Exit; - if DataList.Count > 0 then - for i := 0 to DataList.Count - 1 do - with PDataItem(DataList[i])^ do - if Selected and (not UpDir) then Inc(SelCount); - Item1 := string(PDataItem(ListView.Selected.Data)^.FName); - if (PDataItem(ListView.Selected.Data)^.Selected and (SelCount > 0)) or (SelCount = 0) then begin - if ListView.ConvertToSorted(ListView.Selected.Index) < ListView.Items.Count then - for i := ListView.ConvertToSorted(ListView.Selected.Index) + 1 to DataList.Count - 1 do - if not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.Selected then begin - Item2 := string(PDataItem(DataList[ListView.ConvertFromSorted(i)])^.FName); - Break; - end; - if (Item2 = '') and (ListView.ConvertToSorted(ListView.Selected.Index) > 0) then - for i := ListView.ConvertToSorted(ListView.Selected.Index) - 1 downto 0 do - if (not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.Selected) and - (not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.UpDir) then - begin - Item2 := string(PDataItem(DataList[ListView.ConvertFromSorted(i)])^.FName); - Break; - end; - end; -end; -(********************************************************************************************************************************) -procedure UnselectAll(ListView: TGTKListView; DataList: TList); -var i: integer; -begin - if DataList.Count > 0 then - for i := 0 to DataList.Count - 1 do - with PDataItem(DataList[i])^ do - if Selected then begin - Selected := False; - ListView.Items[i].RedrawRow; - end; -end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) -function CRCGetInfo(FileName: string; Engine: TPanelEngine; var TargetName: string; var TargetCRC: LongWord; var Size: Int64): boolean; - - procedure ProcessLine(Str: string); - var UPS: string; - begin - try - TrimCRLFESC(Str); - if Length(Str) < 1 then Exit; - UPS := WideUpperCase(Str); - if Pos('FILENAME', UPS) = 1 then TargetName := Trim(Copy(Str, Pos('=', Str) + 1, Length(Str) - Pos('=', Str))) else - if Pos('SIZE', UPS) = 1 then Size := StrToInt64Def(Trim(Copy(Str, Pos('=', Str) + 1, Length(Str) - Pos('=', Str))), 0) else - if Pos('CRC32', UPS) = 1 then TargetCRC := StrToInt64Def('$' + Trim(Copy(Str, Pos('=', Str) + 1, Length(Str) - Pos('=', Str))), 0); - except end; - end; - -const CRCBlockSize = 32768; -var i, Error, Count, Start: integer; - FD: TEngineFileDes; - Buffer: Pointer; - s: string; +(********************************************************************************************************************************) +function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; +var Error: integer; begin Result := False; - if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.crc') - else FileName := FileName + '.crc'; try - Buffer := malloc(CRCBlockSize); - memset(Buffer, 0, CRCBlockSize); - except - Application.MessageBox(LANGAnErrorOccuredWhileInitializingMemoryBlock, [mbOK], mbError, mbNone, mbOK); - Exit; - end; - FD := Engine.OpenFile(FileName, omRead, Error); - if Error <> 0 then Exit; - - s := ''; - repeat - Count := Engine.ReadFile(FD, Buffer, CRCBlockSize, Error); + Error := Engine.MakeDir(IncludeTrailingPathDelimiter(Engine.Path) + NewDir); if Error <> 0 then begin - libc_free(Buffer); - Engine.CloseFile(FD); + Application.MessageBox(Format(LANGErrorCreatingNewDirectorySInSPanel, [StrToUTF8(NewDir), LANGPanelStrings[LeftPanel], GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); Exit; end; - // processing begins - Start := 1; - if Count > 0 then - for i := 0 to Count - 1 do - if (PByteArray(Buffer)^[i] in [13, 10]) or (i = Count - 1) then begin - s := s + Copy(PChar(Buffer), Start, i - Start + 1 + Ord(i = Count - 1)); - Start := i + 2; - if PByteArray(Buffer)^[i] in [13, 10] then begin - ProcessLine(s); - s := ''; - end; - end; - // processing ends - until Count < CRCBlockSize; - if Length(s) > 0 then ProcessLine(s); - - Engine.CloseFile(FD); - libc_free(Buffer); - Result := True; -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: PDataItemSL; - 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.GetFileInfoSL(FName); - if not Assigned(Stat) then Exit; - SetProgress1Params(Stat^.Size); - 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: PDataItemSL; -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, True) 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.GetFileInfoSL(ParamString2); - if Assigned(Stat) then MergeBlockSize := ComputeBlockSize(Stat^.Size) - else MergeBlockSize := 65536*4; - 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; - -(********************************************************************************************************************************) -function WriteCRCFile(Engine: TPanelEngine; TargetFile, SplitFileName: string; const FileSize: Int64; const FileCRC: Longword): boolean; -var FD: TEngineFileDes; - Error, Count: integer; - s: string; -begin - Result := False; - if Pos('.', TargetFile) > 1 then TargetFile := ChangeFileExt(TargetFile, '.crc') - else TargetFile := TargetFile + '.crc'; - FD := Engine.OpenFile(TargetFile, omWrite, Error); - if Error <> 0 then begin - Application.MessageBox(Format(LANGAnErrorOccuredWhileOpeningFileSS, [TargetFile, GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); - Exit; - end; - s := Format('filename=%s'#13#10'size=%d'#13#10'crc32=%s'#13#10, [SplitFileName, FileSize, WideUpperCase(IntToHex(FileCRC, 8))]); - Count := Engine.WriteFile(FD, @s[1], Length(s), Error); - if (Error <> 0) or (Count <> Length(s)) then begin - Application.MessageBox(Format(LANGAnErrorOccuredWhileWritingFileSS, [TargetFile, GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); - Exit; - end; - Engine.CloseFile(FD); - Result := 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; - begin - Result := False; - with SenderThread do begin - TDF := Engine.GetFileSystemFree(FilePath); - // 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']); - Engine.ExplicitChDir('/'); - 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: PDataItemSL; - b: boolean; - List: TList; -begin - with SenderThread do begin - Stat := Engine.GetFileInfoSL(ParamString1); - 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; - 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); + except + on E: Exception do begin + Application.MessageBox(Format(LANGErrorCreatingNewDirectorySInSPanelNoPath, [LANGPanelStrings[LeftPanel], E.Message]), [mbOK], mbError, mbNone, mbOK); 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 - TDF := Engine.GetFileSystemFree(FilePath); - // 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, ConfShowDotFiles, FilePath); - 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) 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 - TDF := Engine.GetFileSystemFree(FilePath); - 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; - 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^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.IsLnk) then Exit; - if (not AFileRec^.IsDir) and ParamBool1 and (ParamInt1 = 1) then Exit; // Directories only - if AFileRec^.IsDir and ParamBool1 and (ParamInt1 = 2) then Exit; // Files only - Res := Engine.Chmod(String(AFileRec^.FName), ParamCardinal1); -// DebugMsg(['Result : ', Res]); - if Res <> 0 then - if SkipAll then Result := True else - begin - Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.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; - CurrPath: string; - Fr: Single; - x: PDataItemSL; -begin - SkipAll := False; - with SenderThread do begin - AList := TList.Create; - AList.Clear; - 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 ParamBool1 - then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) - else begin - x := Engine.GetFileInfoSL(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 ParamBool1 - then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) - else begin - x := Engine.GetFileInfoSL(CurrPath + String(FName)); - if x <> nil then AList.Add(x); - end; - Engine.ExplicitChDir('/'); - 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])^.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^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.IsLnk)) or - ((not AFileRec^.IsDir) and ParamBool1) then Exit; - Res := Engine.Chown(String(AFileRec^.FName), ParamCardinal1, ParamCardinal2); -// DebugMsg(['Result : ', Res]); - if Res <> 0 then - if SkipAll then Result := True else - begin - Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.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; - CurrPath: string; - Fr: Single; - x: PDataItemSL; -begin - SkipAll := False; - with SenderThread do begin - AList := TList.Create; - AList.Clear; - 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 ParamBool1 - then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) - else begin - x := Engine.GetFileInfoSL(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 ParamBool1 - then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) - else begin - x := Engine.GetFileInfoSL(CurrPath + String(FName)); - if x <> nil then AList.Add(x); - end; - Engine.ExplicitChDir('/'); - 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])^.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; (********************************************************************************************************************************) @@ -2248,7 +565,7 @@ end; (********************************************************************************************************************************) function EditSymlink(const FileName: string; Engine: TPanelEngine) : boolean; -var Data: PDataItemSL; +var Data: PDataItem; AFSymLink: TFSymlink; function HandleEditSymlink(const ExistingName, PointTo: string): boolean; @@ -2298,7 +615,7 @@ var Data: PDataItemSL; begin Result := False; - Data := Engine.GetFileInfoSL(FileName); + Data := Engine.GetFileInfo(FileName, False, True); if Data = nil then begin Result := False; Exit; @@ -2317,342 +634,231 @@ begin AFSymLink.RelativeCheckButton.Visible := False; if AFSymlink.Run = mbOK then Result := HandleEditSymlink(UTF8ToStr(AFSymlink.FromEntry.Text), UTF8ToStr(AFSymlink.ToEntry.Text)); finally + FreeDataItem(Data); AFSymlink.Free; end; end; + (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); -var AFDirDelete: TFDirDelete; - AFOverwrite: TFOverwrite; - AFNewDir: TFNewDir; - b: boolean; +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure TGetDirSizeThread.Execute; 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; - + Result := Engine.GetDirSize(Path); + Finished := True; +end; -// Sleep(1000); -// WriteLn('ProcessProgressThread - ted mam lock ja! -- leave'); - SenderThread.GUIMutex.Release; +constructor TGetDirSizeThread.Create; +begin + inherited Create(True); + FreeOnTerminate := False; + FCancelled := False; + Finished := False; + Result := -1; +end; - -// DebugMsg(['Before refresh']); - Application.ProcessMessages; -// DebugMsg(['After refresh']); +procedure TGetDirSizeThread.CancelIt; +begin + FCancelled := True; + Engine.BreakProcessing(1); +end; +procedure GetDirSize(AListView: TGTKListView; Engine: TPanelEngine; DataList: TList; AllItems: boolean); +var t: time_t; + b: boolean; + FRemoteWait: TFRemoteWait; - // 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; + function DoGetDirSizeItem(Index: integer): boolean; + var Item: TGTKListItem; + Data: PDataItem; + APath, s: string; + ASize: Int64; +// List: TList; + Thread: TGetDirSizeThread; + begin + Result := True; + try + Item := AListView.Items[Index]; + if not Assigned(Item) then Exit; + Data := Item.Data; + if (not Assigned(Data)) or (not Data^.IsDir) then Exit; + APath := IncludeTrailingPathDelimiter(Engine.Path) + string(Data^.FName); +{ List := TList.Create; + Engine.FillDirFiles(APath, List, 1); + DebugWriteListSL(List); } - 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; + Thread := TGetDirSizeThread.Create; + try + Thread.Path := APath; + Thread.Engine := Engine; + Thread.Resume; +// Thread.Execute; + while not Thread.Finished do begin + Sleep(ConstInternalProgressTimer); + if not b and (__time(nil) >= t + 2) then begin + FRemoteWait := TFRemoteWait.Create(Application); +// FRemoteWait.Label2.Visible := False; + FRemoteWait.ParentForm := FMain; + FRemoteWait.ShowModal; + b := True; + end; + Application.ProcessMessages; + if FMainEscPressed or (Assigned(FRemoteWait) and FRemoteWait.Cancelled) then Thread.CancelIt; end; - SenderThread.FDialogShowDirDelete := False; - b := True; + ASize := Thread.Result; + finally + Thread.Free; 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 (ASize < 0) or FMainEscPressed or (Assigned(FRemoteWait) and FRemoteWait.Cancelled) then Exit; + Data^.Size := ASize; + s := FormatSize(ASize, 0); + libc_free(Data^.ColumnData[3]); +// Data^.ColumnData[3] := malloc(Length(s) + 1); +// memset(Data^.ColumnData[3], 0, Length(s) + 1); + Data^.ColumnData[3] := strdup(PChar(s)); + except end; + 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; +var i, j: integer; + Data: PDataItem; +begin + t := __time(nil); + b := False; + FRemoteWait := nil; + + if not AllItems then DoGetDirSizeItem(AListView.Selected.Index) else + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do begin + j := AListView.ConvertFromSorted(i); + Data := DataList[j]; + if Data^.IsDir and (not Data^.UpDir) then begin + if not DoGetDirSizeItem(j) then Break; + if FMainEscPressed then Break; + AListView.Items[j].RedrawRow; 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']); + if FRemoteWait <> nil then FRemoteWait.Free; + ChDir('/'); end; + (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure TWorkerThread.Execute; -begin - PrepareExecute; - if Assigned(WorkerProcedure) then WorkerProcedure(Self); -end; - -constructor TWorkerThread.Create; +(********************************************************************************************************************************) +function ComputeBlockSize(TotalSize: Int64): longint; 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; + if TotalSize < 512*1024 then Result := 32*1024 else + if TotalSize < 1024*1024 then Result := 64*1024 else + if TotalSize < 2048*1024 then Result := 96*1024 else + if TotalSize < 4096*1024 then Result := 128*1024 else + if TotalSize < 8192*1024 then Result := 256*1024 else +{ if TotalSize < 256*1024*1024 then Result := 512*1024 else + if TotalSize < 768*1024*1024 then Result := 2048*1024 else } + Result := 4096*1024; end; -destructor TWorkerThread.Destroy; -begin - GUIMutex.Free; - FCallbackLockEvent.Free; - inherited Destroy; -end; +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +function CRCGetInfo(FileName: string; Engine: TPanelEngine; var TargetName: string; var TargetCRC: LongWord; var Size: Int64): boolean; -procedure TWorkerThread.CancelIt; -begin - FCancelled := True; -end; + procedure ProcessLine(Str: string); + var UPS: string; + begin + try + TrimCRLFESC(Str); + if Length(Str) < 1 then Exit; + UPS := WideUpperCase(Str); + if Pos('FILENAME', UPS) = 1 then TargetName := Trim(Copy(Str, Pos('=', Str) + 1, Length(Str) - Pos('=', Str))) else + if Pos('SIZE', UPS) = 1 then Size := StrToInt64Def(Trim(Copy(Str, Pos('=', Str) + 1, Length(Str) - Pos('=', Str))), 0) else + if Pos('CRC32', UPS) = 1 then TargetCRC := StrToInt64Def('$' + Trim(Copy(Str, Pos('=', Str) + 1, Length(Str) - Pos('=', Str))), 0); + except end; + end; -function TWorkerThread.Cancelled: boolean; +const CRCBlockSize = 32768; +var i, Error, Count, Start: integer; + FD: TEngineFileDes; + Buffer: Pointer; + s: string; begin - Result := FCancelled or ProgressForm.Cancelled; -end; + Result := False; + if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.crc') + else FileName := FileName + '.crc'; + try + Buffer := malloc(CRCBlockSize); + memset(Buffer, 0, CRCBlockSize); + except + Application.MessageBox(LANGAnErrorOccuredWhileInitializingMemoryBlock, [mbOK], mbError, mbNone, mbOK); + Exit; + end; + FD := Engine.OpenFile(FileName, omRead, Error); + if Error <> 0 then Exit; -procedure TWorkerThread.UpdateProgress1(const Progress: Int64; const ProgressText: string); -begin -// DebugMsg([' ** TWorkerThread.UpdateProgress1(Progress = ', Progress, ', ProgressText = ', ProgressText]); - FProgress1Pos := Progress; - FProgress1Text := ProgressText; -end; + s := ''; + repeat + Count := Engine.ReadFile(FD, Buffer, CRCBlockSize, Error); + if Error <> 0 then begin + libc_free(Buffer); + Engine.CloseFile(FD); + Exit; + end; + // processing begins + Start := 1; + if Count > 0 then + for i := 0 to Count - 1 do + if (PByteArray(Buffer)^[i] in [13, 10]) or (i = Count - 1) then begin + s := s + Copy(PChar(Buffer), Start, i - Start + 1 + Ord(i = Count - 1)); + Start := i + 2; + if PByteArray(Buffer)^[i] in [13, 10] then begin + ProcessLine(s); + s := ''; + end; + end; + // processing ends + until Count < CRCBlockSize; + if Length(s) > 0 then ProcessLine(s); -procedure TWorkerThread.UpdateProgress2(const Progress: Int64; const ProgressText: string); -begin -// DebugMsg([' ** TWorkerThread.UpdateProgress2(Progress = ', Progress, ', ProgressText = ', ProgressText]); - FProgress2Pos := Progress; - FProgress2Text := ProgressText; + Engine.CloseFile(FD); + libc_free(Buffer); + Result := True; end; -procedure TWorkerThread.SetProgress1Params(const ProgressMax: Int64); -begin - FProgress1Max := ProgressMax; -end; -procedure TWorkerThread.SetProgress2Params(const ProgressMax: Int64); +(********************************************************************************************************************************) +function WriteCRCFile(Engine: TPanelEngine; TargetFile, SplitFileName: string; const FileSize: Int64; const FileCRC: Longword): boolean; +var FD: TEngineFileDes; + Error, Count: integer; + s: string; begin - FProgress2Max := ProgressMax; + Result := False; + if Pos('.', TargetFile) > 1 then TargetFile := ChangeFileExt(TargetFile, '.crc') + else TargetFile := TargetFile + '.crc'; + FD := Engine.OpenFile(TargetFile, omWrite, Error); + if Error <> 0 then begin + Application.MessageBox(Format(LANGAnErrorOccuredWhileOpeningFileSS, [TargetFile, GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); + Exit; + end; + s := Format('filename=%s'#13#10'size=%d'#13#10'crc32=%s'#13#10, [SplitFileName, FileSize, WideUpperCase(IntToHex(FileCRC, 8))]); + Count := Engine.WriteFile(FD, @s[1], Length(s), Error); + if (Error <> 0) or (Count <> Length(s)) then begin + Application.MessageBox(Format(LANGAnErrorOccuredWhileWritingFileSS, [TargetFile, GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); + Exit; + end; + Engine.CloseFile(FD); + Result := True; 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; (********************************************************************************************************************************) (********************************************************************************************************************************) @@ -2783,244 +989,6 @@ begin Result := HandleSystemCommand(s, Format(LANGErrorEject, [StrToUTF8(MountPath)])); end; -(********************************************************************************************************************************) -(********************************************************************************************************************************) -procedure TGetDirSizeThread.Execute; -begin - Result := Engine.GetDirSize(Path); - Finished := True; -end; - -constructor TGetDirSizeThread.Create; -begin - inherited Create(True); - FreeOnTerminate := False; - FCancelled := False; - Finished := False; - Result := -1; -end; - -procedure TGetDirSizeThread.CancelIt; -begin - FCancelled := True; - Engine.BreakProcessing(1); -end; - -procedure GetDirSize(AListView: TGTKListView; Engine: TPanelEngine; DataList: TList; AllItems: boolean); -var t: time_t; - b: boolean; - FRemoteWait: TFRemoteWait; - - function DoGetDirSizeItem(Index: integer): boolean; - var Item: TGTKListItem; - Data: PDataItem; - APath, s: string; - ASize: Int64; -// List: TList; - Thread: TGetDirSizeThread; - begin - Result := True; - try - Item := AListView.Items[Index]; - if not Assigned(Item) then Exit; - Data := Item.Data; - if (not Assigned(Data)) or (not Data^.IsDir) then Exit; - APath := IncludeTrailingPathDelimiter(Engine.Path) + string(Data^.FName); - -{ List := TList.Create; - Engine.FillDirFiles(APath, List, 1); - DebugWriteListSL(List); } - - Thread := TGetDirSizeThread.Create; - try - Thread.Path := APath; - Thread.Engine := Engine; - Thread.Resume; -// Thread.Execute; - while not Thread.Finished do begin - Sleep(ConstInternalProgressTimer); - if not b and (__time(nil) >= t + 2) then begin - FRemoteWait := TFRemoteWait.Create(Application); -// FRemoteWait.Label2.Visible := False; - FRemoteWait.ParentForm := FMain; - FRemoteWait.ShowModal; - b := True; - end; - Application.ProcessMessages; - if FMainEscPressed or (Assigned(FRemoteWait) and FRemoteWait.Cancelled) then Thread.CancelIt; - end; - ASize := Thread.Result; - finally - Thread.Free; - end; - - if (ASize < 0) or FMainEscPressed or (Assigned(FRemoteWait) and FRemoteWait.Cancelled) then Exit; - Data^.Size := ASize; - s := FormatSize(ASize, 0); - libc_free(Data^.ColumnData[3]); -// Data^.ColumnData[3] := malloc(Length(s) + 1); -// memset(Data^.ColumnData[3], 0, Length(s) + 1); - Data^.ColumnData[3] := strdup(PChar(s)); - except end; - end; - - -var i, j: integer; - Data: PDataItem; -begin - t := __time(nil); - b := False; - FRemoteWait := nil; - - if not AllItems then DoGetDirSizeItem(AListView.Selected.Index) else - if DataList.Count > 0 then - for i := 0 to DataList.Count - 1 do begin - j := AListView.ConvertFromSorted(i); - Data := DataList[j]; - if Data^.IsDir and (not Data^.UpDir) then begin - if not DoGetDirSizeItem(j) then Break; - if FMainEscPressed then Break; - AListView.Items[j].RedrawRow; - end; - end; - if FRemoteWait <> nil then FRemoteWait.Free; - ChDir('/'); -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, ConfShowDotFiles); - 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; (********************************************************************************************************************************) (********************************************************************************************************************************) |