diff options
| -rw-r--r-- | UChecksum.pas | 8 | ||||
| -rw-r--r-- | UChecksumDruid.pas | 12 | ||||
| -rw-r--r-- | UConfig.pas | 4 | ||||
| -rw-r--r-- | UConnectionManager.pas | 2 | ||||
| -rw-r--r-- | UCore.pas | 2676 | ||||
| -rw-r--r-- | UCoreUtils.pas | 12 | ||||
| -rw-r--r-- | UCoreWorkers.pas | 2180 | ||||
| -rw-r--r-- | UEngines.pas | 765 | ||||
| -rw-r--r-- | UGnome.pas | 10 | ||||
| -rw-r--r-- | UMain.pas | 40 | ||||
| -rw-r--r-- | USearch.pas | 24 | ||||
| -rw-r--r-- | vfs/UVFSCore.pas | 541 | ||||
| -rw-r--r-- | vfs/uVFSprototypes.pas | 240 |
13 files changed, 3105 insertions, 3409 deletions
diff --git a/UChecksum.pas b/UChecksum.pas index 90eb029..b7ef508 100644 --- a/UChecksum.pas +++ b/UChecksum.pas @@ -201,11 +201,11 @@ var FD: TEngineFileDes; Error, Count, i, Start: integer; Buffer: Pointer; s: string; - Stat: PDataItemSL; + Stat: PDataItem; IsMD5: boolean; begin Result := False; - Stat := Engine.GetFileInfoSL(FileName); + Stat := Engine.GetFileInfo(FileName, True, True); if (Stat <> nil) and (Stat.Size > 128*1024) then begin i := integer(Application.MessageBox(Format(LANGTheFileSYouAreTryingToOpenIsQuiteBig, [StrToUTF8(ExtractFileName(FileName))]), [mbYes, mbNo], mbWarning, mbNone, mbNo)); if (i = integer(mbNo)) or (i = 251) then Exit; @@ -269,7 +269,7 @@ var Item: TFileListItem; ListItem: TGTKListItem; S1, S2: string; i: integer; - Stat: PDataItemSL; + Stat: PDataItem; begin TrimCRLFESC(s); if Length(s) < 1 then Exit; @@ -312,7 +312,7 @@ begin Item.Name := ExtractFileName(s2); Item.FullPath := IncludeTrailingPathDelimiter(Path) + s2; end; - Stat := Engine.GetFileInfoSL(Item.FullPath); + Stat := Engine.GetFileInfo(Item.FullPath, True, True); if Assigned(Stat) then begin Item.Size := Stat.Size; FreeDataItem(Stat); diff --git a/UChecksumDruid.pas b/UChecksumDruid.pas index 346dc3f..7745fad 100644 --- a/UChecksumDruid.pas +++ b/UChecksumDruid.pas @@ -423,7 +423,7 @@ procedure TFChecksumDruid.Process; const Ext: array[boolean] of string = ('.md5', '.sfv'); var i: integer; MaxSize, LastValue: Int64; - Stat: PDataItemSL; + Stat: PDataItem; s, s2: string; begin if FileNames.Count = 0 then begin @@ -443,7 +443,7 @@ begin // Compute maximal size of selected files MaxSize := 0; for i := 0 to FileNames.Count - 1 do begin - Stat := Engine.GetFileInfoSL(FileNames[i]); + Stat := Engine.GetFileInfo(FileNames[i], True, True); if Assigned(Stat) then begin Inc(MaxSize, Stat.Size); FreeDataItem(Stat); @@ -458,7 +458,7 @@ begin for i := 0 to FileNames.Count - 1 do begin ProcessingLabel.Caption := Format(LANGCCHKSUMNowProcessingFileS, [StrToUTF8(ExtractFileName(FileNames[i]))]); LastValue := Progress.Value; - Stat := Engine.GetFileInfoSL(FileNames[i]); + Stat := Engine.GetFileInfo(FileNames[i], True, True); Application.ProcessMessages; try if ProcessFile(FileNames[i], SFVRadioButton.Checked, s) then begin @@ -591,7 +591,7 @@ end; procedure TFChecksumDruid.WriteSFVComment(const FName: string); var i, Error, Count: integer; - Stat: PDataItemSL; + Stat: PDataItem; s: string; begin FileDes := Engine.OpenFile(FName, omWrite, Error); @@ -613,10 +613,10 @@ begin '; http://tuxcmd.sourceforge.net/'#13#10'; '#13#10'; /----'#13#10, [ConstAboutVersion, ConstAboutBuildDate, SysUtils.FormatDateTime('mm.dd.yyyy "at" hh:nn:ss', Now)]); for i := 0 to FileNames.Count - 1 do begin - Stat := Engine.GetFileInfoSL(FileNames[i]); + Stat := Engine.GetFileInfo(FileNames[i], True, True); if Assigned(Stat) then begin s := s + Format('; %s %s %s'#13#10, [PadRightStr(IntToStr(Stat^.Size), 11), - FormatDate(Stat^.ModifyTime, True, True, 999, 999, 1, '%Y-%m-%d', '%k:%M.%S'), ExtractFileName(FileNames[i])]); + FormatDate(Stat^.mtime, True, True, 999, 999, 1, '%Y-%m-%d', '%k:%M.%S'), ExtractFileName(FileNames[i])]); FreeDataItem(Stat); end; end; diff --git a/UConfig.pas b/UConfig.pas index 33828a7..2c419b7 100644 --- a/UConfig.pas +++ b/UConfig.pas @@ -25,8 +25,8 @@ uses Classes, ULocale; resourcestring ConstAppTitle = 'Tux Commander'; - ConstAboutVersion = '0.6.71-dev'; - ConstAboutBuildDate = '2009-11-17'; + ConstAboutVersion = '0.6.72-dev'; + ConstAboutBuildDate = '2009-11-28'; {$IFDEF FPC} {$INCLUDE fpcver.inc} diff --git a/UConnectionManager.pas b/UConnectionManager.pas index 62b34b9..a89147d 100644 --- a/UConnectionManager.pas +++ b/UConnectionManager.pas @@ -24,7 +24,7 @@ interface uses glib2, gdk2, gtk2, pango, SysUtils, Types, Classes, GTKControls, GTKForms, GTKStdCtrls, GTKExtCtrls, GTKConsts, GTKView, GTKUtils, GTKDialogs, GTKPixbuf, GTKClasses, GTKMenus, - UCore, UCoreClasses, UVFSCore, UEngines; + UCore, UCoreWorkers, UCoreClasses, UVFSCore, UEngines; type TFConnectionManager = class(TGTKDialog) @@ -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; (********************************************************************************************************************************) (********************************************************************************************************************************) diff --git a/UCoreUtils.pas b/UCoreUtils.pas index 95ca5a8..203fbc7 100644 --- a/UCoreUtils.pas +++ b/UCoreUtils.pas @@ -761,9 +761,9 @@ var Path : string; function CaseDirExists(DPath, DFileName: string): boolean; begin if (WideCompareStr(Pattern, FileName) <> 0) and (WideCompareText(Pattern, FileName) = 0) and Directory and - Engine.TwoSameFiles(DPath + Pattern, DPath + FileName) + Engine.TwoSameFiles(DPath + Pattern, DPath + FileName, True) then Result := False - else Result := Engine.DirectoryExists(DPath + DFileName); + else Result := Engine.DirectoryExists(DPath + DFileName, True); end; @@ -1509,11 +1509,11 @@ begin 4 : if Data1^.Size > Data2^.Size then Result := -1 else if Data1^.Size < Data2^.Size then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); - 5, 6 : if Data1^.ModifyTime > Data2^.ModifyTime then Result := -1 else - if Data1^.ModifyTime < Data2^.ModifyTime then Result := 1 else + 5, 6 : if Data1^.mtime > Data2^.mtime then Result := -1 else + if Data1^.mtime < Data2^.mtime then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); - 7 : if StripDate(Data1^.ModifyTime) > StripDate(Data2^.ModifyTime) then Result := -1 else - if StripDate(Data1^.ModifyTime) < StripDate(Data2^.ModifyTime) then Result := 1 else + 7 : if StripDate(Data1^.mtime) > StripDate(Data2^.mtime) then Result := -1 else + if StripDate(Data1^.mtime) < StripDate(Data2^.mtime) then Result := 1 else Result := CompareTextsEx(Data1^.FDisplayName, Data2^.FDisplayName); 8 : if Data1^.UID > Data2^.UID then Result := -1 else if Data1^.UID < Data2^.UID then Result := 1 else diff --git a/UCoreWorkers.pas b/UCoreWorkers.pas new file mode 100644 index 0000000..bcdd07f --- /dev/null +++ b/UCoreWorkers.pas @@ -0,0 +1,2180 @@ +(* + Tux Commander - UCoreWorkers - worker threads, operations + Copyright (C) 2009 Tomas Bzatek <tbzatek@users.sourceforge.net> + Check for updates on tuxcmd.sourceforge.net + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) +unit UCoreWorkers; +interface + +uses glib2, gtk2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore, uVFSprototypes, UCore; + +type TVFSCallbackThread = class(TThread) + private + FThreadID: __pthread_t; + FCopyProgressFunc: TEngineProgressFunc; + procedure PrepareExecute; // Call this right after thread has been started + public + AEngine: TPanelEngine; + APlugin: TVFSPlugin; + + VFSCallbackEvent: TSimpleEvent; + VFSAskQuestion_Message: PChar; + VFSAskQuestion_Choices: PPChar; + VFSAskQuestion_Choice: PInteger; + VFSAskQuestion_Display: boolean; + + VFSAskPassword_Message: PChar; + VFSAskPassword_default_user: PChar; + VFSAskPassword_default_domain: PChar; + VFSAskPassword_default_password: PChar; + VFSAskPassword_flags: TVFSAskPasswordFlags; + VFSAskPassword_username: PPChar; + VFSAskPassword_password: PPChar; + VFSAskPassword_anonymous: Pgboolean; + VFSAskPassword_domain: PPChar; + VFSAskPassword_password_save: PVFSPasswordSave; + VFSAskPassword_Display: boolean; + VFSAskPassword_Result: boolean; + + VFSCallbackCancelled: boolean; + + VFSConnectionManagerMode: boolean; + VFSQuickConnectMode: boolean; + VFSDialogsParentWindow: PGtkWidget; + + FCancelRequested: boolean; + + constructor Create(CreateSuspended: boolean); + destructor Destroy; override; + end; + + TWorkerThread = class(TVFSCallbackThread) + private + GUIMutex: TCriticalSection; + protected + procedure Execute; override; + procedure CommitGUIUpdate; + public + FCancelled: boolean; + + // Data to update + FProgress1Pos, FProgress2Pos, FProgress1Max, FProgress2Max: Int64; + FProgress1Text, FProgress2Text, FLabel1Text, FLabel2Text: string; + FGUIProgress1Pos, FGUIProgress2Pos, FGUIProgress1Max, FGUIProgress2Max: Int64; + FGUIProgress1Text, FGUIProgress2Text, FGUILabel1Text, FGUILabel2Text: string; + FGUIChanged: boolean; + + FCancelMessage: string; + FDoneThread, FShowCancelMessage, + FDialogShowDirDelete, FDialogShowOverwrite, FDialogShowNewDir, FDialogShowMsgBox: boolean; + FDialogResultDirDelete, FDialogResultOverwrite, FDialogResultNewDir: integer; + + FDirDeleteButtonsType: integer; + FDirDeleteLabel1Text, FDirDeleteLabel2Text, FDirDeleteLabel3Text, FDirDeleteCaption: string; + FDirDeleteLabel2Visible, FDirDeleteLabel3Visible: boolean; + + FOverwriteButtonsType: integer; + FOverwriteFromLabel, FOverwriteFromInfoLabel, FOverwriteToLabel, FOverwriteToInfoLabel, + FOverwriteRenameStr, FOverwriteSourceFile, FOverwriteDestFile: string; + + FNewDirCaption, FNewDirLabel, FNewDirEdit: string; + FMsgBoxText: string; + FMsgBoxButtons: TMessageButtons; + FMsgBoxStyle: TMessageStyle; + FMsgBoxDefault, FMsgBoxEscape, FDialogResultMsgBox: TMessageButton; + + FCallbackLockEvent: TSimpleEvent; + + // Parameters + ProgressForm: TFProgress; + Engine, SrcEngine, DestEngine: TPanelEngine; + LeftPanel: boolean; + DataList: TList; + ParamBool1, ParamBool2, ParamBool3, ParamBool4, ParamBool5: boolean; + ParamString1, ParamString2, ParamString3: string; + ParamPointer1: Pointer; + ParamInt64: Int64; + ParamInt1, ParamInt2: integer; + ParamLongWord1: LongWord; + ParamCardinal1, ParamCardinal2: Cardinal; + ParamFloat1, ParamFloat2: Extended; + ParamDataItem1: PDataItem; + WorkerProcedure: procedure(SenderThread: TWorkerThread); + SelectedItem: PDataItem; + ExtractFromVFSMode, ExtractFromVFSAll: boolean; + ErrorHappened: boolean; + + constructor Create; + destructor Destroy; override; + procedure CancelIt; + function Cancelled: boolean; + + procedure PrepareJobFilesFromPanel(AList: TList; DoNotRecurse: boolean); + + procedure UpdateProgress1(const Progress: Int64; const ProgressText: string); + procedure UpdateProgress2(const Progress: Int64; const ProgressText: string); + procedure SetProgress1Params(const ProgressMax: Int64); + procedure SetProgress2Params(const ProgressMax: Int64); + procedure UpdateCaption1(const CaptionText: string); + procedure UpdateCaption2(const CaptionText: string); + + function ShowDirDeleteDialog(ButtonsType: integer; const Label1Text: string; const Label2Text: string = ''; + const Label3Text: string = ''; const DirDeleteCaption: string = ''): integer; + function ShowOverwriteDialog(ButtonsType: integer; const FromLabel, FromInfoLabel, ToLabel, ToInfoLabel, RenameStr, + SourceFile, DestFile: string): integer; + function ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; + function ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; + Default, Escape: TMessageButton): TMessageButton; + end; + + TOpenDirThread = class(TVFSCallbackThread) + private + function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; + protected + procedure Execute; override; + public + APath: string; + ASelItem: string; + AAutoFallBack: boolean; + ADirList: TList; + ChDirResult, ListingResult, VFSOpenResult: integer; + Finished, CancelIt: boolean; + RunningTime: Int64; + AFullPath, AHighlightItem: string; + constructor Create; + destructor Destroy; override; + end; + + TOpenConnectionThread = class(TVFSCallbackThread) + private + protected + procedure Execute; override; + public + URI: string; + Finished: boolean; + OpenResult: boolean; + constructor Create; + destructor Destroy; override; + end; + + +// Thread aware functions (also half-thread-safe) without any piece of GTK code +procedure DeleteFilesWorker(SenderThread: TWorkerThread); +procedure CopyFilesWorker(SenderThread: TWorkerThread); +procedure MergeFilesWorker(SenderThread: TWorkerThread); +procedure SplitFilesWorker(SenderThread: TWorkerThread); +procedure ChmodFilesWorker(SenderThread: TWorkerThread); +procedure ChownFilesWorker(SenderThread: TWorkerThread); +procedure DummyThreadWorker(SenderThread: TWorkerThread); + +// Worker threads utilities +procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); + + +implementation + +uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, + UFileAssoc, UCoreClasses, URemoteWait, UMain, UGnome, UNewDir, + crc; + + +(********************************************************************************************************************************) +constructor TVFSCallbackThread.Create(CreateSuspended: boolean); +begin + inherited Create(CreateSuspended); + APlugin := nil; + VFSCallbackEvent := TSimpleEvent.Create; + VFSAskQuestion_Display := False; + VFSAskPassword_Display := False; + VFSCallbackCancelled := False; + VFSConnectionManagerMode := False; + VFSQuickConnectMode := False; + VFSDialogsParentWindow := FMain.FWidget; + FCancelRequested := False; +end; + +destructor TVFSCallbackThread.Destroy; +begin + VFSCallbackEvent.Free; + inherited Destroy; +end; + +procedure TVFSCallbackThread.PrepareExecute; +begin + FThreadID := pthread_self; + VFSCallbackCancelled := False; +end; + +(********************************************************************************************************************************) +procedure vfs_ask_question_callback(const AMessage: PChar; const Choices: PPChar; choice: PInteger; cancel_choice: Integer; user_data: Pointer); cdecl; +var Thread: TVFSCallbackThread; +begin + Thread := user_data; + if (Thread = nil) { or (not (Thread is TVFSCallbackThread))} then begin + DebugMsg(['(ERROR): vfs_ask_question_callback: user_data is not TVFSCallbackThread, exiting.']); + Exit; + end; + if Thread.FCancelRequested then begin + DebugMsg(['!! (WARNING): vfs_ask_question_callback: FCancelRequested.']); + if (choice <> nil) then choice^ := -1; + Thread.VFSCallbackCancelled := True; + Exit; + end; + if pthread_self = Application.ThreadID then begin + DebugMsg(['!! (WARNING): vfs_ask_question_callback called from the main thread, expected spawn from a TVFSCallbackThread']); + HandleVFSAskQuestionCallback(Thread.VFSDialogsParentWindow, AMessage, Choices, choice); + if (choice <> nil) then Thread.VFSCallbackCancelled := (choice^ < 0) or (choice^ = cancel_choice); + Exit; + end; + if pthread_self = Thread.FThreadID then begin + DebugMsg(['******* vfs_ask_question_callback spawned, user_data = 0x', IntToHex(QWord(user_data), 16), ', ThreadID = 0x', IntToHex(pthread_self, 16)]); + Thread.VFSAskQuestion_Message := AMessage; + Thread.VFSAskQuestion_Choices := Choices; + Thread.VFSAskQuestion_Choice := choice; + Thread.VFSAskQuestion_Display := True; + Thread.VFSCallbackEvent.ResetEvent; + Thread.VFSCallbackEvent.WaitFor(INFINITE); + DebugMsg(['******* thread: resuming...']); + if (choice <> nil) then Thread.VFSCallbackCancelled := (choice^ < 0) or (choice^ = cancel_choice); + Exit; + end; + DebugMsg(['!! (ERROR): vfs_ask_question_callback spawned neither from the main thread nor from active TVFSCallbackThread, dropping the callback to prevent data corruption.']); + DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', TVFSCallbackThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); +end; + +function vfs_ask_password_callback(const AMessage: PChar; const default_user: PChar; const default_domain: PChar; const default_password: PChar; flags: TVFSAskPasswordFlags; + username, password: PPChar; anonymous: Pgboolean; domain: PPChar; password_save: PVFSPasswordSave; + user_data: Pointer): gboolean; cdecl; +var Thread: TVFSCallbackThread; + def_pass: PChar; +begin + Result := False; + Thread := user_data; + if (Thread = nil) { or (not (Thread is TVFSCallbackThread))} then begin + DebugMsg(['(ERROR): vfs_ask_question_callback: user_data is not TVFSCallbackThread, exiting.']); + Exit; + end; + if Thread.FCancelRequested then begin + DebugMsg(['!! (WARNING): vfs_ask_password_callback: FCancelRequested.']); + Result := False; + Thread.VFSCallbackCancelled := True; + Exit; + end; + + def_pass := default_password; + + // Disable password saving if requested + if ConfConnMgrDoNotSynchronizeKeyring then begin + flags := flags and (not VFS_ASK_PASSWORD_SAVING_SUPPORTED); + if password_save <> nil then password_save^ := VFS_PASSWORD_SAVE_NEVER; + end; + if ConfConnMgrDoNotSavePasswords then flags := flags and (not VFS_ASK_PASSWORD_SAVE_INTERNAL) else + if Thread.VFSConnectionManagerMode then flags := flags or VFS_ASK_PASSWORD_SAVE_INTERNAL; + + // Use stored password, if previously set + if (((flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE) or Thread.VFSConnectionManagerMode or Thread.VFSQuickConnectMode) and + (password <> nil) and (Thread.AEngine is TVFSEngine) and (Length((Thread.AEngine as TVFSEngine).Password) > 0) then + begin + if not (Thread.AEngine as TVFSEngine).PasswordUsed then begin + DebugMsg([' (II) vfs_ask_password_callback: reusing manually set password']); + password^ := g_strdup(PChar((Thread.AEngine as TVFSEngine).Password)); + (Thread.AEngine as TVFSEngine).PasswordUsed := True; + if (password_save <> nil) and Thread.VFSConnectionManagerMode then + if ConfConnMgrDoNotSynchronizeKeyring then password_save^ := VFS_PASSWORD_SAVE_NEVER + else password_save^ := VFS_PASSWORD_SAVE_PERMANENTLY; + Thread.VFSCallbackCancelled := False; + Result := True; + Exit; + end else + if (flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE then + def_pass := PChar((Thread.AEngine as TVFSEngine).Password); + end; + + // Ask for password + if pthread_self = Application.ThreadID then begin + DebugMsg(['!! (WARNING): vfs_ask_password_callback called from the main thread, expected spawn from a TVFSCallbackThread']); + Result := HandleVFSAskPasswordCallback(Thread.VFSDialogsParentWindow, AMessage, default_user, default_domain, def_pass, flags, username, password, anonymous, domain, password_save); + Thread.VFSCallbackCancelled := Result = False; + end else + if pthread_self = Thread.FThreadID then begin + DebugMsg(['******* vfs_ask_password_callback spawned, user_data = 0x', IntToHex(QWord(user_data), 16), ', ThreadID = 0x', IntToHex(pthread_self, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); + Thread.VFSAskPassword_Message := AMessage; + Thread.VFSAskPassword_default_user := default_user; + Thread.VFSAskPassword_default_domain := default_domain; + Thread.VFSAskPassword_default_password := def_pass; + Thread.VFSAskPassword_flags := flags; + Thread.VFSAskPassword_username := username; + Thread.VFSAskPassword_password := password; + Thread.VFSAskPassword_anonymous := anonymous; + Thread.VFSAskPassword_domain := domain; + Thread.VFSAskPassword_password_save := password_save; + Thread.VFSAskPassword_Display := True; + Thread.VFSAskPassword_Result := False; + Thread.VFSCallbackEvent.ResetEvent; + Thread.VFSCallbackEvent.WaitFor(INFINITE); + DebugMsg(['******* thread: resuming...']); + Result := Thread.VFSAskPassword_Result; + Thread.VFSCallbackCancelled := Result = False; + end else + begin + DebugMsg(['!! (ERROR): vfs_ask_password_callback spawned neither from the main thread nor from active TVFSCallbackThread, dropping the callback to prevent data corruption.']); + DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', TVFSCallbackThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); + end; + + // Save password back to the engine + if Result and (password <> nil) and (strlen(password^) > 0) and (Thread.AEngine is TVFSEngine) and + (((flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE) or + (Thread.VFSConnectionManagerMode and (password_save <> nil) and (password_save^ = VFS_PASSWORD_SAVE_PERMANENTLY))) then + begin + (Thread.AEngine as TVFSEngine).Password := string(password^); + (Thread.AEngine as TVFSEngine).PasswordUsed := True; + end; + + // Strip password saving if requested + if ConfConnMgrDoNotSynchronizeKeyring and (password_save <> nil) then + password_save^ := VFS_PASSWORD_SAVE_NEVER; +end; + +function vfs_progress_callback(position, max: guint64; user_data: Pointer): gboolean; cdecl; +begin +// DebugMsg(['VFSCopyCallBackFunc called (iPos = ', iPos, ', iMax = ', iMax, ')']); + Result := True; + if not Assigned(user_data) then Exit; + if Assigned(TVFSCallbackThread(user_data).FCopyProgressFunc) then + try + Result := TVFSCallbackThread(user_data).FCopyProgressFunc(user_data, position); + except + on E: Exception do DebugMsg(['*** Exception raised in vfs_progress_callback(position=', position, ', max=', max, ', user_data=', user_data, '): (', E.ClassName, '): ', E.Message]); + end; +end; + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure TWorkerThread.Execute; +begin + PrepareExecute; + if Assigned(WorkerProcedure) then WorkerProcedure(Self); +end; + +constructor TWorkerThread.Create; +begin + inherited Create(True); + FreeOnTerminate := False; + GUIMutex := TCriticalSection.Create; + FCallbackLockEvent := TSimpleEvent.Create; + FCancelled := False; + ProgressForm := nil; + Engine := nil; + DataList := nil; + ParamPointer1 := nil; + WorkerProcedure := nil; + SelectedItem := nil; + FDoneThread := False; + FShowCancelMessage := False; + FDialogShowDirDelete := False; + FDialogShowOverwrite := False; + FDialogShowNewDir := False; + FDialogShowMsgBox := False; + ExtractFromVFSMode := False; + ErrorHappened := False; + ParamBool1 := False; + ParamBool2 := False; + ParamBool3 := False; + ParamBool4 := False; + ParamBool5 := False; + FGUIChanged := False; +end; + +destructor TWorkerThread.Destroy; +begin + GUIMutex.Free; + FCallbackLockEvent.Free; + inherited Destroy; +end; + +procedure TWorkerThread.CancelIt; +begin + FCancelled := True; +end; + +function TWorkerThread.Cancelled: boolean; +begin + Result := FCancelled or ProgressForm.Cancelled; +end; + +procedure TWorkerThread.UpdateProgress1(const Progress: Int64; const ProgressText: string); +begin +// DebugMsg([' ** TWorkerThread.UpdateProgress1(Progress = ', Progress, ', ProgressText = ', ProgressText]); + FProgress1Pos := Progress; + FProgress1Text := ProgressText; +end; + +procedure TWorkerThread.UpdateProgress2(const Progress: Int64; const ProgressText: string); +begin +// DebugMsg([' ** TWorkerThread.UpdateProgress2(Progress = ', Progress, ', ProgressText = ', ProgressText]); + FProgress2Pos := Progress; + FProgress2Text := ProgressText; +end; + +procedure TWorkerThread.SetProgress1Params(const ProgressMax: Int64); +begin + FProgress1Max := ProgressMax; +end; + +procedure TWorkerThread.SetProgress2Params(const ProgressMax: Int64); +begin + FProgress2Max := ProgressMax; +end; + +procedure TWorkerThread.UpdateCaption1(const CaptionText: string); +begin + FLabel1Text := CaptionText; +end; + +procedure TWorkerThread.UpdateCaption2(const CaptionText: string); +begin + FLabel2Text := CaptionText; +end; + +procedure TWorkerThread.CommitGUIUpdate; +begin + GUIMutex.Acquire; +// WriteLn('TWorkerThread.CommitGUIUpdate, ted mam lock ja! -- enter'); + FGUIProgress1Pos := FProgress1Pos; + FGUIProgress2Pos := FProgress2Pos; + FGUIProgress1Max := FProgress1Max; + FGUIProgress2Max := FProgress2Max; + FGUIProgress1Text := FProgress1Text; + FGUIProgress2Text := FProgress2Text; + FGUILabel1Text := FLabel1Text; + FGUILabel2Text := FLabel2Text; + FGUIChanged := True; +// Sleep(1000); +// WriteLn('TWorkerThread.CommitGUIUpdate, ted mam lock ja! -- leave'); + GUIMutex.Release; +end; + +function TWorkerThread.ShowDirDeleteDialog(ButtonsType: integer; const Label1Text: string; const Label2Text: string = ''; const Label3Text: string = ''; const DirDeleteCaption: string = ''): integer; +begin + FDialogResultDirDelete := integer(mbCancel); + FDirDeleteLabel1Text := Label1Text; + FDirDeleteLabel2Text := Label2Text; + FDirDeleteLabel3Text := Label3Text; + FDirDeleteLabel2Visible := Label2Text <> ''; + FDirDeleteLabel3Visible := Label3Text <> ''; + FDirDeleteButtonsType := ButtonsType; + if DirDeleteCaption = '' then FDirDeleteCaption := LANGRemoveDirectory + else FDirDeleteCaption := DirDeleteCaption; + FDialogShowDirDelete := True; + FCallbackLockEvent.ResetEvent; + FCallbackLockEvent.WaitFor(INFINITE); + Result := FDialogResultDirDelete; +end; + +function TWorkerThread.ShowOverwriteDialog(ButtonsType: integer; const FromLabel, FromInfoLabel, ToLabel, ToInfoLabel, RenameStr, SourceFile, DestFile: string): integer; +begin + FDialogResultOverwrite := integer(mbCancel); + FOverwriteButtonsType := ButtonsType; + FOverwriteFromLabel := FromLabel; + FOverwriteFromInfoLabel := FromInfoLabel; + FOverwriteToLabel := ToLabel; + FOverwriteToInfoLabel := ToInfoLabel; + FOverwriteRenameStr := RenameStr; + FOverwriteSourceFile := SourceFile; + FOverwriteDestFile := DestFile; + FDialogShowOverwrite := True; + FCallbackLockEvent.ResetEvent; + FCallbackLockEvent.WaitFor(INFINITE); + Result := FDialogResultOverwrite; +end; + +function TWorkerThread.ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; +begin + FNewDirCaption := Caption; + FNewDirLabel := LabelCaption; + FNewDirEdit := Edit; + FDialogShowNewDir := True; + FCallbackLockEvent.ResetEvent; + FCallbackLockEvent.WaitFor(INFINITE); + Result := FDialogResultNewDir; +end; + +function TWorkerThread.ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; Default, Escape: TMessageButton): TMessageButton; +begin + FMsgBoxText := Text; + FMsgBoxButtons := Buttons; + FMsgBoxStyle := Style; + FMsgBoxDefault := Default; + FMsgBoxEscape := Escape; + FDialogShowMsgBox := True; + FCallbackLockEvent.ResetEvent; + FCallbackLockEvent.WaitFor(INFINITE); + Result := FDialogResultMsgBox; +end; + + +(********************************************************************************************************************************) +procedure TWorkerThread.PrepareJobFilesFromPanel(AList: TList; DoNotRecurse: boolean); +var i: longint; + CurrPath: string; + x: PDataItemSL; +begin + CurrPath := IncludeTrailingPathDelimiter(Engine.Path); + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do + with PDataItem(DataList[i])^ do + if (not UpDir) and Selected then + if IsDir and (not IsLnk) and (not DoNotRecurse) + then FillDirFiles(Engine, AList, CurrPath + String(FName)) + else begin + x := GetFileInfoSL(Engine, CurrPath + String(FName)); + if x <> nil then AList.Add(x); + end; + if (AList.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then + with SelectedItem^ do + if IsDir and (not IsLnk) and (not DoNotRecurse) + then FillDirFiles(Engine, AList, CurrPath + String(FName)) + else begin + x := GetFileInfoSL(Engine, CurrPath + String(FName)); + if x <> nil then AList.Add(x); + end; +end; + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); +var AFDirDelete: TFDirDelete; + AFOverwrite: TFOverwrite; + AFNewDir: TFNewDir; + b: boolean; +begin + DebugMsg([' ** ProcessProgressThread --begin']); + b := False; + try + while not SenderThread.FDoneThread do begin +// Write('.'); + Sleep(ConstInternalProgressTimer); +// DebugMsg([' ** ProcessProgressThread: updating UI (FProgress1Pos = ', SenderThread.FProgress1Pos, ', FProgress2Pos = ', SenderThread.FProgress2Pos]); + + +// DebugMsg(['ProcessProgressThread - before mutex']); + SenderThread.GUIMutex.Acquire; +// WriteLn('ProcessProgressThread - ted mam lock ja! -- enter'); + + try + if SenderThread.FGUIChanged then begin + if SenderThread.FGUIProgress1Max > 1 + then ProgressForm.ProgressBar.Fraction := SenderThread.FGUIProgress1Pos / SenderThread.FGUIProgress1Max + else ProgressForm.ProgressBar.Fraction := 0; +// ProgressForm.ProgressBar.Value := SenderThread.FGUIProgress1Pos; + ProgressForm.ProgressBar.Text := SenderThread.FGUIProgress1Text; + ProgressForm.Label2.Caption := SenderThread.FGUILabel1Text; + if ProgressForm.FTwoBars then begin + if SenderThread.FGUIProgress2Max > 1 + then ProgressForm.ProgressBar2.Fraction := SenderThread.FGUIProgress2Pos / SenderThread.FGUIProgress2Max + else ProgressForm.ProgressBar2.Fraction := 0; +// ProgressForm.ProgressBar2.Value := SenderThread.FGUIProgress2Pos; + ProgressForm.ProgressBar2.Text := SenderThread.FGUIProgress2Text; + ProgressForm.Label3.Caption := SenderThread.FGUILabel2Text; + end; + ProgressForm.ProgressBar.Max := SenderThread.FGUIProgress1Max; + ProgressForm.ProgressBar2.Max := SenderThread.FGUIProgress2Max; + SenderThread.FGUIChanged := False; + end; + except + on E: Exception do DebugMsg(['*** Exception raised in UCore.ProcessProgressThread::updating progress bars block (', E.ClassName, '): ', E.Message]); + end; + + +// Sleep(1000); +// WriteLn('ProcessProgressThread - ted mam lock ja! -- leave'); + SenderThread.GUIMutex.Release; + + +// DebugMsg(['Before refresh']); + Application.ProcessMessages; +// DebugMsg(['After refresh']); + + + // VFS callbacks + if SenderThread.VFSAskQuestion_Display then begin + SenderThread.VFSAskQuestion_Display := False; + DebugMsg(['ProcessProgressThread - Main thread: displaying question dialog']); + HandleVFSAskQuestionCallback(ProgressForm.FWidget, SenderThread.VFSAskQuestion_Message, SenderThread.VFSAskQuestion_Choices, SenderThread.VFSAskQuestion_Choice); + SenderThread.VFSCallbackEvent.SetEvent; + end; + if SenderThread.VFSAskPassword_Display then begin + SenderThread.VFSAskPassword_Display := False; + DebugMsg(['ProcessProgressThread - Main thread: displaying password prompt']); + SenderThread.VFSAskPassword_Result := HandleVFSAskPasswordCallback(ProgressForm.FWidget, + SenderThread.VFSAskPassword_Message, + SenderThread.VFSAskPassword_default_user, + SenderThread.VFSAskPassword_default_domain, + SenderThread.VFSAskPassword_default_password, + SenderThread.VFSAskPassword_flags, + SenderThread.VFSAskPassword_username, + SenderThread.VFSAskPassword_password, + SenderThread.VFSAskPassword_anonymous, + SenderThread.VFSAskPassword_domain, + SenderThread.VFSAskPassword_password_save); + SenderThread.VFSCallbackEvent.SetEvent; + end; + + + try + if SenderThread.FDialogShowDirDelete then begin + AFDirDelete := nil; + try + AFDirDelete := TFDirDelete.Create(SenderThread.ProgressForm as TComponent); + AFDirDelete.Caption := SenderThread.FDirDeleteCaption; + AFDirDelete.AddButtons(SenderThread.FDirDeleteButtonsType); + AFDirDelete.Label1.Caption := SenderThread.FDirDeleteLabel1Text; + AFDirDelete.Label2.Caption := SenderThread.FDirDeleteLabel2Text; + AFDirDelete.Label3.Caption := SenderThread.FDirDeleteLabel3Text; + AFDirDelete.Label2.Visible := SenderThread.FDirDeleteLabel2Visible; + AFDirDelete.Label3.Visible := SenderThread.FDirDeleteLabel3Visible; + SenderThread.FDialogResultDirDelete := Integer(AFDirDelete.Run); + if (SenderThread.FDirDeleteButtonsType = 3) and (SenderThread.FDialogResultDirDelete = 2) and (not SenderThread.ParamBool3) + then case Application.MessageBox(LANGIgnoreError, [mbYes, mbNo{, mbCancel}], mbWarning, mbYes, mbNo) of + mbNo: SenderThread.FDialogResultDirDelete := 1; + mbCancel: SenderThread.FDialogResultDirDelete := 0; + end; + finally + AFDirDelete.Free; + end; + SenderThread.FDialogShowDirDelete := False; + b := True; + end; + + if SenderThread.FDialogShowOverwrite then begin + AFOverwrite := nil; + try + AFOverwrite := TFOverwrite.Create(SenderThread.ProgressForm as TComponent); + AFOverwrite.AddButtons(SenderThread.FOverwriteButtonsType); + AFOverwrite.FromLabel.Caption := SenderThread.FOverwriteFromLabel; + AFOverwrite.FromInfoLabel.Caption := SenderThread.FOverwriteFromInfoLabel; + AFOverwrite.ToLabel.Caption := SenderThread.FOverwriteToLabel; + AFOverwrite.ToInfoLabel.Caption := SenderThread.FOverwriteToInfoLabel; + AFOverwrite.RenameStr := SenderThread.FOverwriteRenameStr; + AFOverwrite.SourceFile := SenderThread.FOverwriteSourceFile; + AFOverwrite.DestFile := SenderThread.FOverwriteDestFile; + SenderThread.FDialogResultOverwrite := Integer(AFOverwrite.Run); + SenderThread.FOverwriteRenameStr := UTF8ToStr(AFOverwrite.RenameStr); + finally + AFOverwrite.Free; + end; + SenderThread.FDialogShowOverwrite := False; + b := True; + end; + + if SenderThread.FDialogShowNewDir then begin + AFNewDir := nil; + try + AFNewDir := TFNewDir.Create(SenderThread.ProgressForm as TComponent); + AFNewDir.Caption := SenderThread.FNewDirCaption; + AFNewDir.Label1.Caption := SenderThread.FNewDirLabel; + AFNewDir.Entry.Text := SenderThread.FNewDirEdit; + AFNewDir.Entry.SelectAll; + SenderThread.FDialogResultNewDir := Integer(AFNewDir.Run); + SenderThread.FNewDirEdit := AFNewDir.Entry.Text; + finally + AFNewDir.Free; + end; + SenderThread.FDialogShowNewDir := False; + b := True; + end; + + if SenderThread.FDialogShowMsgBox then begin + SenderThread.FDialogResultMsgBox := Application.MessageBox(SenderThread.FMsgBoxText, SenderThread.FMsgBoxButtons, + SenderThread.FMsgBoxStyle, SenderThread.FMsgBoxDefault, + SenderThread.FMsgBoxEscape); + SenderThread.FDialogShowMsgBox := False; + b := True; + end; + finally + // Unlock the waiting worker thread + if b then begin + b := False; + SenderThread.FCallbackLockEvent.SetEvent; + end; + end; + end; + if SenderThread.FShowCancelMessage then + if SenderThread.FCancelMessage = LANGUserCancelled + then Application.MessageBox(SenderThread.FCancelMessage, [mbOK], mbWarning, mbNone, mbOK) + else Application.MessageBox(SenderThread.FCancelMessage, [mbOK], mbError, mbNone, mbOK); + except + on E: Exception do DebugMsg(['*** Exception raised in UCore.ProcessProgressThread (', E.ClassName, '): ', E.Message]); + end; + DebugMsg([' ** ProcessProgressThread --end']); +end; + + + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure DeleteFilesWorker(SenderThread: TWorkerThread); +var SkipAll: boolean; + + function HandleDelete(AFileRec: PDataItemSL): boolean; + var Res, Response: integer; + begin + Result := True; +// DebugMsg(['Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); + if AFileRec^.DataItem^.IsDir and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; + Res := SenderThread.Engine.Remove(String(AFileRec^.DataItem^.FName)); +// DebugMsg(['Result : ', Res]); + if Res <> 0 then + if SkipAll then Result := True else + begin + Response := SenderThread.ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), + Format(LANGCouldNotBeDeletedS, [GetErrorString(Res)])); + case Response of + 1 : Result := True; + 3 : begin + SkipAll := True; + Result := True; + end; + 2 : Result := HandleDelete(AFileRec); + else Result := False; + end; + end; + end; + +var i: longint; + AList: TList; + CurrPath: string; + Fr: Single; + Response: integer; + DeleteAll, SkipToNext: boolean; +begin + SkipAll := False; + AList := TList.Create; + AList.Clear; + with SenderThread do begin + CurrPath := IncludeTrailingPathDelimiter(Engine.Path); + PrepareJobFilesFromPanel(AList, False); + if Engine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + libc_chdir('/'); + + SetProgress1Params(AList.Count); + CommitGUIUpdate; + DeleteAll := False; + SkipToNext := False; + +// DebugWriteListSL(AList); + + if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); + if AList.Count > 0 then + for i := 0 to AList.Count - 1 do begin + if Cancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + Break; + end; + if SkipToNext and (PDataItemSL(AList[i])^.Level > 1) then Continue; + if SkipToNext and (PDataItemSL(AList[i])^.Level = 1) and (not PDataItemSL(AList[i])^.Stage1) then begin + SkipToNext := False; + Continue; + end; + // Check for non-empty directory + if (not DeleteAll) and (PDataItemSL(AList[i])^.Level = 1) and PDataItemSL(AList[i])^.Stage1 and PDataItemSL(AList[i])^.DataItem^.IsDir and + (not PDataItemSL(AList[i])^.DataItem^.IsLnk) and (i < AList.Count - 2) and (PDataItemSL(AList[i + 1])^.Level = 2) then + begin + Response := ShowDirDeleteDialog(4, Format(LANGTheDirectorySIsNotEmpty, [string(PDataItemSL(AList[i])^.DataItem^.FDisplayName)]), + LANGDoYouWantToDeleteItWithAllItsFilesAndSubdirectories); + case Response of + 1 : ; // Do nothing in this case - I will not bother with changing the structure; it works :-) + 2 : DeleteAll := True; + 3 : SkipToNext := True; + else Break; + end; + end; + // Process delete + if not HandleDelete(AList[i]) then Break; + UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); + UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); + CommitGUIUpdate; + end; + + // Free the objects + if AList.Count > 0 then + for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); + AList.Clear; + AList.Free; + if Engine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + end; + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) + + // Return False to break the process + function CopyFilesWorker_ProgressFunc(Sender: Pointer; BytesDone: Int64): boolean; cdecl; + begin + Result := True; +// DebugMsg(['*** CopyFilesWorker: ProgressFunc called (Sender=', QWord(Sender), ', BytesDone=', BytesDone, ')']); + try + if Assigned(Sender) and (TObject(Sender) is TWorkerThread) then + with TWorkerThread(Sender) do begin + if BytesDone = 0 then UpdateProgress1(0, '0%') + else UpdateProgress1(BytesDone, Format('%d%%', [Round(ParamFloat2 * BytesDone)])); + UpdateProgress2(ParamInt64 + BytesDone, Format('%d%%', [Round(ParamFloat1 * (ParamInt64 + BytesDone))])); + Result := not Cancelled; + CommitGUIUpdate; + end else DebugMsg(['*** CopyFilesWorker: Sender is not TWorkerThread']); + except + on E: Exception do DebugMsg(['*** Exception raised in ProgressFunc(Sender=', QWord(Sender), ', BytesDone=', BytesDone, '): (', E.ClassName, '): ', E.Message]); + end; + end; + + // Return True to ignore the error (Skip, Skip All, Ignore, Cancel) + function CopyFilesWorker_ErrorFunc(Sender: Pointer; ErrorType, ErrorNum: integer; FileName: string): boolean; cdecl; + var s, s2, s3: string; + begin + Result := False; + with TWorkerThread(Sender) do begin + if ParamBool2 then begin + Result := True; + Exit; + end; + case ErrorType of + 0 : begin + CancelIt; + Exit; + end; + 1 : s := LANGMemoryAllocationFailed; + 2 : s := LANGCannotOpenSourceFile; + 3 : s := LANGCannotOpenDestinationFile; + 4 : s := LANGCannotCloseDestinationFile; + 5 : s := LANGCannotCloseSourceFile; + 6 : s := LANGCannotReadFromSourceFile; + 7 : s := LANGCannotWriteToDestinationFile; + end; + if ParamBool1 then s2 := LANGCopyError + else s2 := LANGMoveError; + if ErrorType <> 1 then s3 := StrToUTF8(FileName) + else s3 := ''; + + case ShowDirDeleteDialog(3, s, s3, GetErrorString(ErrorNum), s2) of + 0, 252 : begin // Cancel button, Escape + Result := False; + CancelIt; + end; + 2 : Result := True; // Ignore + 3 : begin // Skip All + ParamBool2 := True; { Skip All Err } + Result := False; //** True? + end; + else {1, 124, 255 :} Result := False; // Skip + end; + end; + end; + + +procedure CopyFilesWorker(SenderThread: TWorkerThread); +// ParamFloat1 = Fr - internal +// ParamFloat2 = Fr2 - internal +// ParamInt64 = SizeDone - internal +// ParamBool1 = ModeCopy - internal +// ParamBool2 = SkipAllErr - internal +// ParamBool3 = CopyMode +// ParamBool4 = QuickRename +// ParamBool5 = OneFile +// ParamString1 = NewPath +// ParamString2 = Filepath +// ParamDataItem1 = QuickRenameDataItem +var DefResponse: integer; // Global variables for this function + SkipAll: boolean; + + + + // Returns True if file was successfully copied, if not, the file will be deleted in LocalCopyFile + function ManualCopyFile(SourceFile, DestFile: string; Append: boolean): boolean; + var fsrc, fdst: TEngineFileDes; + Error, BSize: integer; + Buffer: Pointer; + BytesDone, BytesRead, BytesWritten: Int64; + Res: boolean; + begin + DebugMsg(['ManualCopyFile: ', SourceFile, ' ---> ', DestFile]); + with SenderThread do begin + Result := False; + Error := 0; + fsrc := SrcEngine.OpenFile(SourceFile, omRead, Error); + if Error <> 0 then begin + CopyFilesWorker_ErrorFunc(SenderThread, 2, Error, SourceFile); // Cannot open source file + Exit; + end; + if Append then fdst := DestEngine.OpenFile(DestFile, omAppend, Error) + else fdst := DestEngine.OpenFile(DestFile, omWrite, Error); + if Error <> 0 then begin + SrcEngine.CloseFile(fsrc); + CopyFilesWorker_ErrorFunc(SenderThread, 3, Error, SourceFile); // Cannot open target file + Exit; + end; + + BytesDone := 0; + Res := True; + + BSize := DestEngine.GetBlockSize; + Buffer := malloc(BSize); + if Buffer = nil then begin + CopyFilesWorker_ErrorFunc(SenderThread, 1, errno, SourceFile); // Memory allocation failed + libc_free(Buffer); + Exit; + end; + memset(Buffer, 0, BSize); + + BytesWritten := 0; + repeat + BytesRead := SrcEngine.ReadFile(fsrc, Buffer, BSize, Error); + if (BytesRead = 0) and (Error <> 0) then + Res := CopyFilesWorker_ErrorFunc(SenderThread, 6, Error, SourceFile); // Cannot read from source file + if BytesRead > 0 then begin + BytesWritten := DestEngine.WriteFile(fdst, Buffer, BytesRead, Error); + if (BytesWritten < BytesRead) then + Res := CopyFilesWorker_ErrorFunc(SenderThread, 7, Error, DestFile); // Cannot write to source file + end; + Inc(BytesDone, BytesRead); + if not CopyFilesWorker_ProgressFunc(SenderThread, BytesDone) then begin + Res := False; + Break; + end; + until (BytesRead = 0) or (BytesWritten < BytesRead); + libc_free(Buffer); + + if DestEngine.CloseFile(fdst) <> 0 then begin + CopyFilesWorker_ErrorFunc(SenderThread, 4, errno, DestFile); // Cannot close target file + Exit; + end; + if SrcEngine.CloseFile(fsrc) <> 0 then begin + CopyFilesWorker_ErrorFunc(SenderThread, 5, errno, SourceFile); // Cannot close source file + Exit; + end; + Result := Res; + end; + end; + + // Returns True if the file was successfully copied and will be deleted on move + function LocalCopyFile(SourceFile, DestFile: string; Append: boolean): boolean; + var DataSrc, DataDest: PDataItem; + begin + Result := False; + try + with SenderThread do begin + AEngine := nil; + FCopyProgressFunc := CopyFilesWorker_ProgressFunc; + + // local -> local + if (SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine) + then Result := DestEngine.CopyFileIn(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ProgressFunc, @CopyFilesWorker_ErrorFunc, Append) + else + + // from local engine to VFS engine + if (SrcEngine is TLocalTreeEngine) and (DestEngine is TVFSEngine) then + begin + AEngine := DestEngine; + Result := (DestEngine as TVFSEngine).CopyFileInEx(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ErrorFunc, Append, + @vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_progress_callback, SenderThread); + end else + + // from VFS engine to local (most common use) + if (SrcEngine is TVFSEngine) and (DestEngine is TLocalTreeEngine) then + begin + AEngine := SrcEngine; + Result := (SrcEngine as TVFSEngine).CopyFileOutEx(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ErrorFunc, Append, + @vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_progress_callback, SenderThread); + end + + // VFS to VFS (not supported yet) + else + begin + AEngine := SrcEngine; + Result := ManualCopyFile(SourceFile, DestFile, Append); + end; + AEngine := nil; + + // Copy OK? (check size, otherwise delete target file) + if (not Append) and (not Result) then begin + DataSrc := SrcEngine.GetFileInfo(SourceFile, False, True); + if DataSrc = nil then Exit; + DataDest := DestEngine.GetFileInfo(DestFile, False, True); + if (DataDest <> nil) and (DataSrc^.Size <> DataDest^.Size) then + DestEngine.Remove(DestFile); + FreeDataItem(DataSrc); + FreeDataItem(DataDest); + end; + end; + except + on E: Exception do DebugMsg(['*** Exception raised in LocalCopyFile(SourceFile=', SourceFile, ', DestFile=', DestFile, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); + end; + end; + + function IsOnSameFS(SrcPath, DestPath: string): boolean; + begin + with SenderThread do begin + if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else + if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and + (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and + ((SrcEngine as TVFSEngine).ArchivePath <> '') and + ((SrcEngine as TVFSEngine).ArchivePath = (DestEngine as TVFSEngine).ArchivePath) + then Result := True else + Result := DestEngine.IsOnSameFS(SrcPath, DestPath, False); + end; + end; + + function TwoSameFiles(Path1, Path2: string; TestCaseInsensitiveFS: boolean): boolean; + begin + with SenderThread do begin + if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else + if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and + ((SrcEngine as TVFSEngine).ArchiveMode <> (DestEngine as TVFSEngine).ArchiveMode) + then Result := False else + if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and + (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and + ((SrcEngine as TVFSEngine).ArchivePath <> '') and + ((SrcEngine as TVFSEngine).ArchivePath <> (DestEngine as TVFSEngine).ArchivePath) + then Result := False else + if WideCompareStr(Path1, Path2) = 0 then Result := True else + // * FIXME: causes stat errors, no need to check every file. + Result := TestCaseInsensitiveFS and DestEngine.TwoSameFiles(Path1, Path2, False); + end; + end; + + function DoOperation(AFileRec: PDataItemSL; const Dst: string; var ErrorKind: integer; const Append: boolean): integer; + begin + ErrorKind := 0; + Result := 0; + try + with SenderThread do + with AFileRec^ do begin + if DataItem^.IsLnk then begin + // Explicit copy the file + if ParamBool3 or (not IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst))) then begin + ErrorKind := DestEngine.MakeSymLink(Dst, String(DataItem^.LnkPointTo)); + if ErrorKind <> 0 then Result := ERRCreateLink; + if not ParamBool3 then begin + ErrorKind := SrcEngine.Remove(String(DataItem^.FName)); + if ErrorKind <> 0 then Result := ERRRemove; + end; + end else begin // Move the file + ErrorKind := DestEngine.RenameFile(String(DataItem^.FName), Dst); + if ErrorKind <> 0 then Result := ERRCopyMove; + end; + end else // is not link + if ParamBool3 then begin // Copy mode + if LocalCopyFile(String(DataItem^.FName), Dst, Append) then begin + if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; + DestEngine.Chmod(Dst, DataItem^.Mode); + DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID); + DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime); + end; + end else // Move mode + if IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst)) then begin + if TwoSameFiles(String(DataItem^.FName), Dst, True) and (not TwoSameFiles(String(DataItem^.FName), Dst, False)) then begin + DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); + ErrorKind := DestEngine.RenameFile(String(DataItem^.FName), Dst + '_tcmd'); + if ErrorKind = 0 then ErrorKind := DestEngine.RenameFile(Dst + '_tcmd', Dst); + end else ErrorKind := DestEngine.RenameFile(String(DataItem^.FName), Dst); + if ErrorKind <> 0 then Result := ERRCopyMove; + end else begin + if LocalCopyFile(String(DataItem^.FName), Dst, Append) then begin + if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; + DestEngine.Chmod(Dst, DataItem^.Mode); + DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID); + DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime); + if not Cancelled then begin + ErrorKind := SrcEngine.Remove(String(DataItem^.FName)); + if ErrorKind <> 0 then Result := ERRRemove; + end; + end; + end; + end; +// DebugMsg(['(II) CopyFilesWorker.DoOperation: finished']); + except + on E: Exception do DebugMsg(['*** Exception raised in DoOperation(AFileRec=', QWord(AFileRec), ', Dst=', Dst, ', ErrorKind=', ErrorKind, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); + end; + end; + + // Return False to break the processing (Cancel) + function HandleCopy(AFileRec: PDataItemSL; NewFilePath: string): boolean; + var Res, Response, ErrorKind, r: integer; + Item: PDataItem; + s, s1, s3, cap: string; + FromInfoLabel, ToInfoLabel, InfoLabelFormat: string; + begin + Result := True; + try + with SenderThread do begin + + // Second stage - change permissions + if (not AFileRec^.Stage1) and (ParamBool3 or ((not ParamBool3) and (not AFileRec^.ForceMove))) then + with AFileRec^ do begin + if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; + DestEngine.Chmod(NewFilePath, DataItem^.Mode); + DestEngine.Chown(NewFilePath, DataItem^.UID, DataItem^.GID); + DestEngine.ChangeTimes(NewFilePath, DataItem^.mtime, DataItem^.atime); + if not ParamBool3 then SrcEngine.Remove(String(DataItem^.FName)); // Remove directory + Exit; + end; + + // First stage - copy data + if AFileRec^.DataItem^.IsDir then begin + Res := 0; + if AFileRec^.ForceMove and (not ParamBool3) + then begin + if TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.DataItem^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), True) and (not + TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.DataItem^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), False)) then + begin + DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); + ErrorKind := DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd'); + if ErrorKind = 0 then ErrorKind := DestEngine.RenameFile(ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination))); + end else ErrorKind := DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), string(AFileRec^.ADestination)); + if ErrorKind <> 0 then Res := ERRCopyMove + else Res := 0; + end else + if not DestEngine.DirectoryExists(NewFilePath, False) then begin + ErrorKind := DestEngine.MakeDir(NewFilePath); + if ErrorKind <> 0 then Res := ERRMkDir + else Res := 0; + end; + end else begin // not a directory + if not DestEngine.DirectoryExists(ExtractFileDir(NewFilePath), False) then DestEngine.MakeDir(ExtractFileDir(NewFilePath)); + SetProgress1Params(AFileRec^.DataItem^.Size + Ord(AFileRec^.DataItem^.Size = 0)); + if AFileRec^.DataItem^.Size <= 1 then ParamFloat2 := 1 else ParamFloat2 := 100 / (AFileRec^.DataItem^.Size - 1); + CopyFilesWorker_ProgressFunc(SenderThread, 0); + Res := 0; + if DestEngine.FileExists(NewFilePath, False) and + (not (not ParamBool3 and (not TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, False)) and TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, True))) + then begin + Response := DefResponse; + Item := DestEngine.GetFileInfo(NewFilePath, False, True); + if Item = nil then begin + DebugMsg(['Something went terribly wrong during copy - Item := DestEngine.GetFileInfoSL(NewFilePath) == NULL!']); + Result := False; + Exit; + end; + if Response = 0 then begin + case ConfSizeFormat of + 5: InfoLabelFormat := '%s, %s'; + else InfoLabelFormat := LANGOvewriteSBytesS; + end; + FromInfoLabel := Format(InfoLabelFormat, [FormatSize(Item^.Size, 0), FormatDate(Item^.mtime, True, True)]); + ToInfoLabel := Format(InfoLabelFormat, [FormatSize(AFileRec^.DataItem^.Size, 0), FormatDate(AFileRec^.DataItem^.mtime, True, True)]); + Response := ShowOverwriteDialog(1 + Ord(ParamBool3), Format(LANGOverwriteS, [StrToUTF8(NewFilePath)]), FromInfoLabel, + Format(LANGWithFileS, [AFileRec^.DataItem^.FDisplayName]), ToInfoLabel, + ExtractFileName(StrToUTF8(NewFilePath)), ExtractFileName(AFileRec^.DataItem^.FDisplayName), ExtractFileName(StrToUTF8(NewFilePath))); + s := FOverwriteRenameStr; + case Response of + // 1: Overwrite + // 3: Skip + 2 {Overwrite All}, 5 {Overwrite All Older}, 6 {Skip All}: DefResponse := Response; + 4 {Cancel}, 124 {Close Window}, 255: begin + Result := False; + Exit; + end; + 7: {Rename} begin + NewFilePath := Copy(NewFilePath, 1, LastDelimiter(PathDelim, NewFilePath)) + s; + Result := HandleCopy(AFileRec, NewFilePath); + Exit; + end; + 8 {Append}: begin + Res := DoOperation(AFileRec, NewFilePath, ErrorKind, True); + end; + end; + end; + + // Remove destination file if exists and should be overwritten + if (Response in [1, 2]) or ((Response = 5) and (Item^.mtime < AFileRec^.DataItem^.mtime)) then begin + r := DestEngine.Remove(NewFilePath); + while r <> 0 do begin + Res := ShowDirDeleteDialog(1, LANGTheFile, StrToUTF8(String(NewFilePath)), + Format(LANGCouldNotBeDeletedS, [GetErrorString(r)]), LANGCopyError); + case Res of + 1: begin + Result := True; + Exit; + end; + 2: r := DestEngine.Remove(NewFilePath); + 0, 124, 255: begin + Result := False; + Exit; + end; + end; + end; + Res := DoOperation(AFileRec, NewFilePath, ErrorKind, False); + end; + end else Res := DoOperation(AFileRec, NewFilePath, ErrorKind, False); + end; + + // Error handling + if (Res <> 0) and (not SkipAll) then begin + if ParamBool3 then cap := LANGCopy + else cap := LANGMove; + case Res of + ERRCreateLink: begin + s1 := LANGTheSymbolicLink; + if ErrorKind = 0 then s3 := LANGCouldNotBeCreated else + s3 := Format(LANGCouldNotBeCreatedS, [GetErrorString(ErrorKind)]); + end; + ERRMkDir: begin + s1 := LANGTheDirectory; + if ErrorKind = 0 then s3 := LANGCouldNotBeCreated else + s3 := Format(LANGCouldNotBeCreatedS, [GetErrorString(ErrorKind)]); + end; + ERRRemove: begin + if AFileRec^.DataItem^.IsDir then s1 := LANGTheDirectory else + if AFileRec^.DataItem^.IsLnk then s1 := LANGTheSymbolicLink else + s1 := LANGTheFile; + if ErrorKind = 0 then s3 := LANGCouldNotBeDeleted else + s3 := Format(LANGCouldNotBeDeletedS, [GetErrorString(ErrorKind)]); + end; + ERRCopyMove: begin + if ParamBool3 then s1 := LANGCannotCopyFile else + s1 := LANGCannotMoveFile; + if ErrorKind = 0 then s3 := '' else + s3 := GetErrorString(ErrorKind); + end; + end; + Response := ShowDirDeleteDialog(1, s1, StrToUTF8(String(NewFilePath)), s3, cap); + case Response of + 1 : Result := True; // Skip + 2 : Result := HandleCopy(AFileRec, NewFilePath); // Retry + 3 : begin // Skip All + SkipAll := True; + Result := True; + end; + 0, 124, 255 : Result := False; // Cancel + end; + end; + end; +// DebugMsg(['(II) CopyFilesWorker.HandleCopy: finished']); + except + on E: Exception do DebugMsg(['*** Exception raised in HandleCopy(AFileRec=', QWord(AFileRec), ', NewFilePath=', NewFilePath, '): (', E.ClassName, '): ', E.Message]); + end; + end; + + procedure HandleProcessPattern(AList: TList; CurrPath, FullPath, ParamFileName: string; ParamDir, Ren: boolean); + var s, s2: string; + b, CaseInsensitiveRename: boolean; + Info: PDataItemSL; + begin + with SenderThread do + if not Ren then begin + if ParamDir then FillDirFiles(SrcEngine, AList, FullPath) + else begin + Info := GetFileInfoSL(SrcEngine, FullPath); + if Info = nil then DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']) + else AList.Add(Info); + end; + end else begin + s := ProcessPattern(DestEngine, ParamString1, CurrPath, ParamFileName, ParamDir); + CaseInsensitiveRename := (WideCompareStr(ParamString1, ParamFileName) <> 0) and (WideCompareText(ParamString1, ParamFileName) = 0) and + ParamDir and DestEngine.TwoSameFiles(IncludeTrailingPathDelimiter(CurrPath) + ParamString1, IncludeTrailingPathDelimiter(CurrPath) + ParamFileName, False); +// DebugMsg(['HandleProcessPattern: s = ', s]); + b := False; + if ParamDir then begin + b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s), False) and (not CaseInsensitiveRename); + if (not b) and (s <> '/') then begin + s2 := ExcludeTrailingPathDelimiter(s); + s2 := ExcludeTrailingPathDelimiter(Copy(s2, 1, LastDelimiter('/', s2))); + b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s2), False); + end; + end; + if (not ParamDir) or (ParamDir and b and IsOnSameFS(ExcludeTrailingPathDelimiter(FullPath), s2)) + then begin + Info := GetFileInfoSL(SrcEngine, FullPath); + if Info = nil then begin + DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']); + ErrorHappened := True; + end else begin + Info^.ADestination := strdup(PChar(s)); + Info^.ForceMove := True; + AList.Add(Info); + end; + end else FillDirFiles(SrcEngine, AList, FullPath); + end; + end; + +var i: longint; + List: TList; + CurrPath, SaveDestPath, SaveSrcPath, s: string; + MaxSize: Int64; +begin + List := TList.Create; + List.Clear; + with SenderThread do begin + ErrorHappened := False; + FCancelled := False; + SaveSrcPath := ''; + CurrPath := IncludeTrailingPathDelimiter(SrcEngine.Path); + SaveDestPath := DestEngine.Path; + ParamString1 := ExcludeTrailingPathDelimiter(ParamString1); + if ParamString1 = '' then ParamString1 := PathDelim; + + if ParamBool5 then begin // HandleVFSFromArchive + if not ExtractFromVFSAll then HandleProcessPattern(List, CurrPath, ParamString2, ExtractFileName(ParamString2), False, False) + else begin + SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); + SrcEngine.SetPath('/'); + CurrPath := '/'; + HandleProcessPattern(List, '/', '/', '', True, False); + end; + end else + if ParamBool4 then begin // Quick-Rename + with ParamDataItem1^ do + HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), True); + end else begin // Not Quick-Rename + if not ExtractFromVFSMode then begin + if DataList.Count > 0 then + for i := 0 to DataList.Count - 1 do + with PDataItem(DataList[i])^ do + if (not UpDir) and Selected + then HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); + if (List.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then + with SelectedItem^ do + HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), not ParamBool3); + end else begin // Extract from VFS mode + DebugMsg(['CopyFilesWorker: Should not be reached']); + if (not ExtractFromVFSAll) and Assigned(SelectedItem) + then HandleProcessPattern(List, CurrPath, CurrPath + String(SelectedItem^.FName), String(SelectedItem^.FName), SelectedItem^.IsDir and (not SelectedItem^.IsLnk), not ParamBool3) + else begin + SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); + SrcEngine.SetPath('/'); + CurrPath := '/'; + HandleProcessPattern(List, '/', '/', '', True, False); + end; + end; + end; + +{ if DestEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); + if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); } +// DebugWriteListSL(List); + + __chdir('/'); + // Compute total size of files to copy + MaxSize := 0; ParamInt64 := 0; + if List.Count > 0 then + for i := 0 to List.Count - 1 do + if PDataItemSL(List[i])^.Stage1 and (PDataItemSL(List[i])^.DataItem^.Size > 0) and (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) + then Inc(MaxSize, PDataItemSL(List[i])^.DataItem^.Size); + SrcEngine.BlockSize := ComputeBlockSize(MaxSize); + DestEngine.BlockSize := ComputeBlockSize(MaxSize); + + // Prepare the Progress window + SetProgress2Params(MaxSize + Ord(MaxSize = 0)); + UpdateProgress1(0, '0%'); + UpdateProgress2(0, '0%'); + CommitGUIUpdate; + + DefResponse := 0; + ParamBool1 := ParamBool3; + SkipAll := False; + ParamBool2 := False; + + if MaxSize < 2 then ParamFloat1 := 1 else ParamFloat1 := 100 / (MaxSize - 1); + if List.Count > 0 then + for i := 0 to List.Count - 1 do begin + if Assigned(PDataItemSL(List[i])^.ADestination) + then s := string(PDataItemSL(List[i])^.ADestination) + else + begin + s := ProcessPattern(DestEngine, ParamString1, CurrPath, Copy(PDataItemSL(List[i])^.DataItem^.FName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.DataItem^.FName) - Length(CurrPath)), + PDataItemSL(List[i])^.DataItem^.IsDir and (not PDataItemSL(List[i])^.DataItem^.IsLnk)); +// DebugMsg(['s2 = ', Copy(PDataItemSL(List[i])^.AName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.AName) - Length(CurrPath)), ', s = ', s]); + end; + + if not (SrcEngine is TVFSEngine) then UpdateCaption1(Format(LANGFromS, [string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])) else + if (SrcEngine as TVFSEngine).ArchiveMode then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])])) + else UpdateCaption1(Format(LANGFromS, [GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.DataItem^.FDisplayName))])); + if not (DestEngine is TVFSEngine) then UpdateCaption2(Format(LANGToS, [StrToUTF8(s)])) else + if (DestEngine as TVFSEngine).ArchiveMode then UpdateCaption2(Format(LANGToS, [Format(ConstFullPathFormatStr, [(DestEngine as TVFSEngine).ArchivePath, StrToUTF8(s)])])) + else UpdateCaption2(Format(LANGToS, [GetURIPrefix((DestEngine as TVFSEngine).GetPathURI) + StrToUTF8(s)])); + CommitGUIUpdate; + if TwoSameFiles(s, string(PDataItemSL(List[i])^.DataItem^.FName), ParamBool3) and (not PDataItemSL(List[i])^.DataItem^.IsDir) then begin + FCancelMessage := LANGCannotCopyFileToItself; + FShowCancelMessage := True; + ErrorHappened := True; + Break; + end; +// * FIXME: why the hell we had something like this here?? +// if s <> string(PDataItemSL(List[i])^.DataItem^.FName) then + if not HandleCopy(List[i], s) then begin + ErrorHappened := True; + Break; + end; + if (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) + then Inc(ParamInt64, PDataItemSL(List[i])^.DataItem^.Size); + if Cancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + ErrorHappened := True; + Break; + end; + end; + + // Free the objects + if List.Count > 0 then + for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); + List.Clear; + List.Free; + if DestEngine.ChangeDir(SaveDestPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if SaveSrcPath <> '' then CurrPath := SaveSrcPath; + if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + end; + SenderThread.FDoneThread := True; + DebugMsg(['(II) CopyFilesWorker: finished']); +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure MergeFilesWorker(SenderThread: TWorkerThread); +// ParamBool1 = HasInitialCRC +// ParamString1 = NewPath +// ParamString2 = FileName +// ParamString3 = TargetName +// ParamLongWord1 = TargetCRC +// ParamInt64 = TargetSize + +var FD: TEngineFileDes; + Error, Count, MergeBlockSize: integer; + Buffer: Pointer; + CurrentCRC: LongWord; + PrivateCancel: boolean; + SizeDone: Int64; + TargetName: string; + + + function PasteFile(FName: string): boolean; + var FDR: TEngineFileDes; + wCount: integer; + Stat: PDataItem; + begin + Result := False; + with SenderThread do begin + if ParamBool1 then UpdateCaption2(Format(LANGToS, [StrToUTF8(FName)])) + else UpdateCaption1(Format(LANGFromS, [StrToUTF8(FName)])); + UpdateProgress1(0, '0 %'); + CommitGUIUpdate; + Stat := Engine.GetFileInfo(FName, True, True); + if not Assigned(Stat) then Exit; + SetProgress1Params(Stat^.Size); + FreeDataItem(Stat); + FDR := Engine.OpenFile(FName, omRead, Error); + if Error <> 0 then Exit; + repeat + Count := Engine.ReadFile(FDR, Buffer, MergeBlockSize, Error); + if Error <> 0 then begin + Engine.CloseFile(FD); + Exit; + end; + wCount := Engine.WriteFile(FD, Buffer, Count, Error); + if (Error <> 0) or (Count <> wCount) then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [ExtractFileName(TargetName), GetErrorString(Error)]); + FShowCancelMessage := True; + PrivateCancel := True; + Result := True; // Fake this to don't show next disc dialog + Exit; + end; + CurrentCRC := CRC32(CurrentCRC, Buffer, Count); + UpdateProgress1(FProgress1Pos + Count, Format('%d %%', [Trunc((FProgress1Pos + Count) / FProgress1Max * 100)])); + Inc(SizeDone, Count); + if ParamBool1 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FProgress2Max * 100)])); + CommitGUIUpdate; + until (Count < MergeBlockSize) or Cancelled; + Engine.CloseFile(FDR); + end; + Result := True; + end; + + +var CurrFile, SourcePath, TargetFinalName: string; + HasFinalCRC, b: boolean; + Stat: PDataItem; +begin + with SenderThread do begin + HasFinalCRC := ParamBool1; + TargetFinalName := ParamString3; + if (Length(ParamString2) > 4) and (WideUpperCase(RightStr(ParamString2, 4)) = '.CRC') + then CurrFile := ChangeFileExt(ExtractFileName(ParamString2), '.001') + else CurrFile := ExtractFileName(ParamString2); + SourcePath := ExtractFilePath(ParamString2); + if ParamString3 = '' then ParamString3 := ChangeFileExt(ExtractFileName(ParamString2), '.out'); + TargetName := ProcessPattern(Engine, ParamString1, Engine.Path, ParamString3, False); + if Engine.FileExists(TargetName, False) then + if ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(TargetName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes then + begin + Error := Engine.Remove(TargetName); + if Error <> 0 then begin + FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), GetErrorString(Error)]); + FShowCancelMessage := True; + Exit; + end; + end else Exit; + + Stat := Engine.GetFileInfo(ParamString2, True, True); + if Assigned(Stat) then MergeBlockSize := ComputeBlockSize(Stat^.Size) + else MergeBlockSize := 65536*4; + FreeDataItem(Stat); + try + Buffer := malloc(MergeBlockSize); + memset(Buffer, 0, MergeBlockSize); + except + FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; + FShowCancelMessage := True; + Exit; + end; + FD := Engine.OpenFile(TargetName, omWrite, Error); + if Error <> 0 then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), GetErrorString(Error)]); + FShowCancelMessage := True; + libc_free(Buffer); + Exit; + end; + + CurrentCRC := 0; + SizeDone := 0; + PrivateCancel := False; + if ParamBool1 then begin + SetProgress2Params(ParamInt64); + UpdateProgress2(0, '0 %'); + UpdateCaption2(Format(LANGFromS, [StrToUTF8(TargetName)])); + CommitGUIUpdate; + end; { else begin + Label2.XAlign := 0; + Label2.XPadding := 20; + end; } + + repeat + b := PasteFile(IncludeTrailingPathDelimiter(SourcePath) + CurrFile); + if not b then begin + PrivateCancel := ShowNewDirDialog(LANGMergeCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(SourcePath)) <> integer(mbOK); + if not PrivateCancel then begin + SourcePath := UTF8ToStr(FNewDirEdit); + if not HasFinalCRC then + HasFinalCRC := CRCGetInfo(IncludeTrailingPathDelimiter(SourcePath) + CurrFile, Engine, TargetFinalName, ParamLongWord1, ParamInt64); + Continue; + end; + end; + try + CurrFile := Copy(CurrFile, 1, LastDelimiter('.', CurrFile)) + Format('%.3d', [StrToInt( + Copy(CurrFile, LastDelimiter('.', CurrFile) + 1, Length(CurrFile) - LastDelimiter('.', CurrFile))) + 1]); + except + CurrFile := ''; + end; + until (SizeDone = ParamInt64) or Cancelled or PrivateCancel {or ((not b) and (not HasInitialCRC))} or (CurrFile = ''); + if (not ParamBool1) and HasFinalCRC then Engine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName); + if Cancelled and (not PrivateCancel) then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + end; + if not (Cancelled or PrivateCancel) then + if HasFinalCRC then begin + if CurrentCRC = ParamLongWord1 + then ShowMessageBox(Format(LANGMergeOfSSucceeded, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK) + else ShowMessageBox(LANGWarningCreatedFileFailsCRCCheck, [mbOK], mbWarning, mbNone, mbOK); + end else ShowMessageBox(Format(LANGMergeOfSSucceeded_NoCRCFileAvailable, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK); + Engine.CloseFile(FD); + end; + libc_free(Buffer); + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure SplitFilesWorker(SenderThread: TWorkerThread); +// ParamInt64 = SplitSize +// ParamString1 = FileName +// ParamString2 = NewPath +// ParamBool1 = DeleteTarget + +const SplitBlockSize = 65536*4; +var FD: TEngineFileDes; + Error: integer; + FileCRC: LongWord; + Buffer: Pointer; + PrivateCancel: boolean; + FilePath: string; + SizeDone, TDF, FileSize, CurrSize: Int64; + + + function WriteSplitPart(TargetFile: string; PartSize: Int64; var Written: Int64): boolean; + var FDW: TEngineFileDes; + Count, wCount, bl: integer; + begin + Result := False; + Written := 0; + with SenderThread do begin + FDW := Engine.OpenFile(TargetFile, omWrite, Error); + DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); + if Error <> 0 then Exit; + if ParamInt64 > 0 then begin + UpdateCaption2(Format(LANGToS, [StrToUTF8(TargetFile)])); + SetProgress1Params(PartSize); + UpdateProgress1(0, '0 %'); + end else UpdateCaption1(Format(LANGToS, [StrToUTF8(TargetFile)])); + CommitGUIUpdate; + repeat + DebugMsg(['Seek to ', Engine.FileSeek(FD, SizeDone + Written, Error), ', Written = ', Written]); + if Written + SplitBlockSize > PartSize then bl := PartSize - Written + else bl := SplitBlockSize; + Count := Engine.ReadFile(FD, Buffer, bl, Error); + if (Error <> 0) or (Count <> bl) then begin + Engine.CloseFile(FDW); + DebugMsg(['Read Error: ', GetErrorString(Error), ', Count = ', Count, ', bl = ', bl]); + if (Count <> bl) and (Error = 0) then Error := EIO; + Exit; + end; + wCount := Engine.WriteFile(FDW, Buffer, Count, Error); + Inc(Written, wCount); + FileCRC := CRC32(FileCRC, Buffer, wCount); + if (Error <> 0) or (Count <> wCount) then begin + Engine.CloseFile(FDW); + DebugMsg(['Write Error: ', GetErrorString(Error), ', Count = ', Count, ', wCount = ', wCount]); + if (wCount <> Count) and (Error = 0) then Error := ENOSPC; + Exit; + end; + UpdateProgress1(FProgress1Pos + wCount, Format('%d %%', [Trunc((FProgress1Pos + wCount) / FProgress1Max * 100)])); + if ParamInt64 > 0 then UpdateProgress2(FProgress2Pos + wCount, Format('%d %%', [Trunc((FProgress2Pos + wCount) / FProgress2Max * 100)])); + CommitGUIUpdate; + until (Written = PartSize) or Cancelled or PrivateCancel; + Engine.CloseFile(FDW); + end; + DebugMsg(['-- Closing file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize, ', Written = ', Written]); + Result := True; + end; + + // Returns True if it should break the process + function NewDiskQuestion: boolean; + var x: Int64; + xx: string; + begin + Result := False; + with SenderThread do begin + Engine.GetFileSystemInfo(FilePath, x, TDF, xx); + // Calculate part size + if ParamInt64 = 0 then begin + if FileSize - SizeDone > TDF then CurrSize := TDF + else CurrSize := FileSize - SizeDone; + end else + if SizeDone + ParamInt64 > FileSize then CurrSize := FileSize - SizeDone + else CurrSize := ParamInt64; + if (TDF < 512) {or (CurrSize < 512)} or (TDF < CurrSize) then begin + DebugMsg(['-- New disk question']); + libc_chdir('/'); + PrivateCancel := ShowNewDirDialog(LANGSplitCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, + StrToUTF8(FilePath)) <> integer(mbOK); + if not PrivateCancel then FilePath := UTF8ToStr(FNewDirEdit); + Result := PrivateCancel; + end; + end; + end; + + +var i: integer; + OriginalFName, st, FileName: string; + ws: Int64; + Stat: PDataItem; + b: boolean; + List: TList; + x: Int64; + xx: string; +begin + with SenderThread do begin + Stat := Engine.GetFileInfo(ParamString1, True, True); + if not Assigned(Stat) then begin + FCancelMessage := Format(LANGCannotOpenFileS, [StrToUTF8(ParamString1)]); + FShowCancelMessage := True; + Exit; + end; + if (ParamInt64 > 0) and (Stat^.Size > ParamInt64 * 999) then begin + FCancelMessage := LANGCannotSplitTheFileToMoreThan999Parts; + FShowCancelMessage := True; + Exit; + end; + FileSize := Stat^.Size; + FreeDataItem(Stat); + SizeDone := 0; + FileCRC := 0; + List := TList.Create; + + try + Buffer := malloc(SplitBlockSize); + memset(Buffer, 0, SplitBlockSize); + except + FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; + FShowCancelMessage := True; + Exit; + end; + FD := Engine.OpenFile(ParamString1, omRead, Error); + if Error <> 0 then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(ParamString1), GetErrorString(Error)]); + libc_free(Buffer); + Exit; + end; + FilePath := IncludeTrailingPathDelimiter(ProcessPattern(Engine, ParamString2, Engine.Path, '', True)); + FileName := ExtractFileName(ParamString1); + OriginalFName := FileName; + if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.001') + else FileName := FileName + '.001'; + PrivateCancel := False; + + if ParamInt64 > 0 then begin + SetProgress2Params(FileSize); + UpdateProgress2(0, '0 %'); + end else begin + SetProgress1Params(FileSize); + UpdateProgress1(0, '0 %'); + end; + UpdateCaption1(Format(LANGFromS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + OriginalFName)])); + CommitGUIUpdate; + + repeat + Engine.GetFileSystemInfo(FilePath, x, TDF, xx); + // Delete target files if necessary + if ParamBool1 and ((TDF < 512) or (TDF < FileSize) or (TDF < ParamInt64)) then try + if List.Count > 0 then + for i := List.Count - 1 downto 0 do + FreeDataItem(PDataItem(List[i])); + List.Clear; + Error := Engine.GetListing(List, FilePath, ConfShowDotFiles, False, False); + if (Error = 0) and (List.Count > 0) then begin + st := ''; + if List.Count < 6 then begin + for i := 0 to List.Count - 1 do + st := st + ' ' + string(PDataItem(List[i])^.FDisplayName) + #10; + b := ShowMessageBox(Format(LANGThereAreSomeFilesInTheTargetDirectorySDoYouWantToDeleteThem, [StrToUTF8(st)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; + end else b := ShowMessageBox(Format(LANGThereAreDFilesInTheTargetDirectoryDoYouWantToDeleteThem, [List.Count]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; + if b then + for i := 0 to List.Count - 1 do begin + Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + string(PDataItem(List[i])^.FName)); + if Error <> 0 then ShowMessageBox(Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath)) + string(PDataItem(List[i])^.FDisplayName), GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); + end; + end; + except end; + // Test for target file existence + if Engine.FileExists(IncludeTrailingPathDelimiter(FilePath) + FileName, False) then begin + b := ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; + if b then begin + Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + FileName); + if Error <> 0 then begin + FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName), GetErrorString(Error)]); + FShowCancelMessage := True; + PrivateCancel := True; + Break; + end; + end else begin + PrivateCancel := True; + Break; + end; + end; + // Free space check + if NewDiskQuestion then Break; + // Writing + ws := 0; + if (CurrSize >= 512) and (TDF >= CurrSize) then begin + b := WriteSplitPart(IncludeTrailingPathDelimiter(FilePath) + FileName, CurrSize, ws); + if (not b) and (ParamInt64 > 0) then begin + FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, [GetErrorString(Error)]); + FShowCancelMessage := True; + PrivateCancel := True; + Break; + end; + Inc(SizeDone, ws); + if ParamInt64 > 0 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])) + else UpdateProgress1(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])); + CommitGUIUpdate; + end; + // Free space check - New disk question after operation + if NewDiskQuestion then Break; + // Change filename + if ws > 0 then + try FileName := Copy(FileName, 1, LastDelimiter('.', FileName)) + + Format('%.3d', [StrToInt(Copy(FileName, LastDelimiter('.', FileName) + 1, + Length(FileName) - LastDelimiter('.', FileName))) + 1]); + except + FileName := ''; + end; + until (SizeDone = FileSize) or Cancelled or PrivateCancel or (FileName = ''); + if Cancelled and (not PrivateCancel) then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + end; + if not (Cancelled or PrivateCancel) then begin + repeat + Engine.GetFileSystemInfo(FilePath, x, TDF, xx); + if (TDF < 512) and (not NewDiskQuestion) then Break; + until (TDF >= 512) or PrivateCancel or Cancelled; + if WriteCRCFile(Engine, IncludeTrailingPathDelimiter(FilePath) + FileName, OriginalFName, SizeDone, FileCRC) + then ShowMessageBox(Format(LANGSplitOfSSucceeded, [StrToUTF8(OriginalFName)]), [mbOK], mbInfo, mbNone, mbOK) + else begin + FCancelMessage := Format(LANGSplitOfSFailed, [StrToUTF8(OriginalFName)]); + FShowCancelMessage := True; + end; + end; + Engine.CloseFile(FD); + end; + if List.Count > 0 then + for i := List.Count - 1 downto 0 do + FreeDataItem(PDataItem(List[i])); + List.Free; + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure ChmodFilesWorker(SenderThread: TWorkerThread); +// ParamBool1 = Recursive +// ParamInt1 = All/Dir/Files +// ParamCardinal1 = Mode + +var SkipAll: boolean; + + function HandleChmod(AFileRec: PDataItemSL): boolean; + var Res, Response: integer; + begin + Result := True; + with SenderThread do begin +// DebugMsg(['Chmod Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); + if AFileRec^.DataItem^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; + if (not AFileRec^.DataItem^.IsDir) and ParamBool1 and (ParamInt1 = 1) then Exit; // Directories only + if AFileRec^.DataItem^.IsDir and ParamBool1 and (ParamInt1 = 2) then Exit; // Files only + Res := Engine.Chmod(String(AFileRec^.DataItem^.FName), ParamCardinal1); +// DebugMsg(['Result : ', Res]); + if Res <> 0 then + if SkipAll then Result := True else + begin + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChmoddedS, + [GetErrorString(Res)]), LANGDialogChangePermissions); + case Response of + 1 : Result := True; + 3 : begin + SkipAll := True; + Result := True; + end; + 2 : Result := HandleChmod(AFileRec); + else Result := False; + end; + end; + end; + end; + +var i: longint; + AList: TList; + Fr: Single; +begin + SkipAll := False; + with SenderThread do begin + AList := TList.Create; + PrepareJobFilesFromPanel(AList, not ParamBool1); + libc_chdir('/'); + SetProgress1Params(AList.Count); + UpdateProgress1(0, '0 %'); + CommitGUIUpdate; + +// DebugWriteListSL(AList); + + if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); + if AList.Count > 0 then + for i := 0 to AList.Count - 1 do begin + if Cancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + Break; + end; + // Process chmod + if not HandleChmod(AList[i]) then Break; + UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); + UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); + CommitGUIUpdate; + end; + + // Free the objects + if AList.Count > 0 then + for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); + AList.Clear; + AList.Free; + end; + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure ChownFilesWorker(SenderThread: TWorkerThread); +// ParamBool1 = Recursive +// ParamCardinal1 = UID +// ParamCardinal2 = GID +var SkipAll: boolean; + + function HandleChown(AFileRec: PDataItemSL): boolean; + var Res, Response: integer; + begin + Result := True; + with SenderThread do begin +// DebugMsg(['Chown Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); + if (AFileRec^.DataItem^.IsDir and ParamBool1 and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk)) or + ((not AFileRec^.DataItem^.IsDir) and ParamBool1) then Exit; + Res := Engine.Chown(String(AFileRec^.DataItem^.FName), ParamCardinal1, ParamCardinal2); +// DebugMsg(['Result : ', Res]); + if Res <> 0 then + if SkipAll then Result := True else + begin + Response := ShowDirDeleteDialog(1, LANGTheFileDirectory, String(AFileRec^.DataItem^.FDisplayName), Format(LANGCouldNotBeChownedS, + [GetErrorString(Res)]), LANGDialogChangeOwner); + case Response of + 1 : Result := True; + 3 : begin + SkipAll := True; + Result := True; + end; + 2 : Result := HandleChown(AFileRec); + else Result := False; + end; + end; + end; + end; + +var i: longint; + AList: TList; + Fr: Single; +begin + SkipAll := False; + with SenderThread do begin + AList := TList.Create; + PrepareJobFilesFromPanel(AList, not ParamBool1); + libc_chdir('/'); + SetProgress1Params(AList.Count); + UpdateProgress1(0, '0 %'); + CommitGUIUpdate; + +// DebugWriteListSL(AList); + + if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); + if AList.Count > 0 then + for i := 0 to AList.Count - 1 do begin + if Cancelled then begin + FCancelMessage := LANGUserCancelled; + FShowCancelMessage := True; + Break; + end; + // Process chmod + if not HandleChown(AList[i]) then Break; + UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); + UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); + CommitGUIUpdate; + end; + + // Free the objects + if AList.Count > 0 then + for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); + AList.Clear; + AList.Free; + end; + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +procedure DummyThreadWorker(SenderThread: TWorkerThread); +var i: integer; +begin + DebugMsg(['(II) DummyThreadWorker: begin']); + with SenderThread do begin + SetProgress1Params(100); + SetProgress2Params(100); + UpdateProgress1(0, '0 %'); + UpdateProgress2(100, '100 %'); + CommitGUIUpdate; + for i := 1 to 100 do begin + Sleep(100); + DebugMsg([' (II) DummyThreadWorker: done ', i, ' / 100']); + UpdateProgress1(i, Format('%d%%', [i])); + UpdateCaption1(Format('Test %d test', [i])); + UpdateProgress2(101-i, Format('%d%%', [101-i])); + UpdateCaption2(Format('Test %d test', [101-i])); + CommitGUIUpdate; + if Cancelled then Break; + end; + end; + DebugMsg(['(II) DummyThreadWorker: finish']); + SenderThread.FDoneThread := True; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +constructor TOpenDirThread.Create; +begin + inherited Create(True); + FreeOnTerminate := False; + Finished := False; + CancelIt := False; + ChDirResult := 0; + ListingResult := 0; + VFSOpenResult := 0; + RunningTime := 0; +end; + +destructor TOpenDirThread.Destroy; +begin + inherited Destroy; +end; + +(********************************************************************************************************************************) +function TOpenDirThread.ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; + + procedure GoUp(var NewPath: string); + var x: integer; + begin + if NewPath = PathDelim then Exit; + NewPath := ExcludeTrailingPathDelimiter(NewPath); + if Length(Trim(NewPath)) < 2 then Exit; + x := PosEnd(PathDelim, NewPath); + SelItem := Copy(NewPath, x + 1, Length(NewPath) - x); + NewPath := Copy(NewPath, 1, x); + NewPath := IncludeTrailingPathDelimiter(NewPath); + end; + +var APath: string; + Error : integer; +begin + try + APath := Engine.Path; + if Path = '..' then GoUp(APath) + else begin + APath := IncludeTrailingPathDelimiter(APath); + Path := IncludeTrailingPathDelimiter(Path); + if (Length(Path) > 0) and (Path[1] <> '/') + then APath := APath + Path + else APath := Path; + APath := IncludeTrailingPathDelimiter(APath); + end; + + // AutoFallback loop + if Engine is TVFSEngine + then Error := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self) + else Error := Engine.ChangeDir(APath); + + while AutoFallback and (Error <> 0) and (APath <> '/') do begin + GoUp(APath); + if Engine is TVFSEngine + then Error := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self) + else Error := Engine.ChangeDir(APath); + end; + // Going on... + if Error <> 0 then begin + Result := Error; + DebugMsg(['*** UCore.ChangeDir: error during Engine.ChangeDir: ', GetErrorString(Error)]); + Exit; + end; + Engine.Path := APath; + Result := 0; + except + on E: Exception do begin + DebugMsg(['*** Exception raised in UCore.ChangeDir (', E.ClassName, '): ', E.Message]); + Result := 1; + end; + end; +end; + +procedure TOpenDirThread.Execute; +var tt: TDateTime; + xEngine: TVFSEngine; +begin + PrepareExecute; + try + tt := Now; + try + if APlugin <> nil then begin + xEngine := TVFSEngine.Create(APlugin); + xEngine.ParentEngine := AEngine; + AEngine.LastHighlightItem := AHighlightItem; + xEngine.SavePath := AEngine.Path; + // AEngine must be set here since VFSOpenEx callbacks will reference it + AEngine := xEngine; + VFSOpenResult := (AEngine as TVFSEngine).VFSOpenEx(AFullPath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self); + end else VFSOpenResult := 0; + + if (VFSOpenResult = 0) and (not CancelIt) then begin + ChDirResult := ChangeDir(AEngine, APath, ASelItem, AAutoFallBack); + if (ChDirResult = 0) and (not CancelIt) then + ListingResult := AEngine.GetListing(ADirList, AEngine.GetPath, ConfShowDotFiles, True, False); + end; + except + on E: Exception do DebugMsg(['*** Exception raised in TOpenDirThread.Execute (', E.ClassName, '): ', E.Message]); + end; + RunningTime := MilliSecondsBetween(tt, Now); + finally + Finished := True; + end; +end; + + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +constructor TOpenConnectionThread.Create; +begin + inherited Create(True); + FreeOnTerminate := False; + Finished := False; + OpenResult := False; +end; + +destructor TOpenConnectionThread.Destroy; +begin + inherited Destroy; +end; + +procedure TOpenConnectionThread.Execute; +begin + PrepareExecute; + try + OpenResult := (AEngine as TVFSEngine).VFSOpenURI(URI, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self); + finally + Finished := True; + end; +end; + + +end. diff --git a/UEngines.pas b/UEngines.pas index dd35d44..5e3909c 100644 --- a/UEngines.pas +++ b/UEngines.pas @@ -45,28 +45,24 @@ type FDisplayName: PChar; // always-valid UTF-8 LnkPointTo: PChar; // ANSI ColumnData: array[0..9] of PChar; - Size: Int64; + Size: cuLongLong; + PackedSize: Int64; UpDir: boolean; - Mode, UID, GID: Cardinal; - IsDir, IsLnk, IsBlk, IsChr, IsFIFO, IsSock, Selected, IsDotFile: boolean; - ModifyTime: time_t; + Mode, UID, GID: cuLong; + IsDir, IsLnk, IsBlk, IsChr, IsFIFO, IsSock: boolean; + Selected, IsDotFile, IsExecutable: boolean; + atime, mtime, ctime: time_t; Icon: Pointer; ItemColor: PGdkColor; end; PDataItemSL = ^TDataItemSL; TDataItemSL = record + DataItem: PDataItem; Stage1: boolean; - FName: PChar; // ANSI - FDisplayName: PChar; // always-valid UTF-8 - LnkPointTo: PChar; // ANSI - ADestination: PChar; - Size, PackedSize: Int64; - Mode, UID, GID: Cardinal; - IsDir, IsLnk, ForceMove, IsOnRO, IsExecutable: boolean; - ModifyTime: time_t; Level: word; - atime, mtime: Int64; + ADestination: PChar; + ForceMove, IsOnRO: boolean; end; TEngineProgressFunc = function (Sender: Pointer; BytesDone: Int64): boolean; cdecl; // Return False to break the copy process @@ -81,45 +77,45 @@ type LastHighlightItem, SavePath: string; constructor Create; destructor Destroy; override; - function GetListing(var List: TList; const AddDotFiles: boolean): integer; overload; virtual; abstract; // Returns errorcode - function GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; overload; virtual; abstract; // Returns errorcode + + function GetListing(List: TList; const APath: string; AddDotFiles, FollowSymlinks, AddFullPath: boolean): integer; virtual; abstract; // Returns errorcode + function GetFileInfo(const APath: string; FollowSymlinks, AddFullPath: boolean): PDataItem; virtual; abstract; + function ChangeDir(const NewPath: string): integer; virtual; abstract; // Returns errorcode - function ExplicitChDir(const NewPath: string): integer; virtual; abstract; // Returns errorcode - function GetFileSystemSize: Int64; overload; virtual; abstract; - function GetFileSystemSize(const APath: string): Int64; overload; virtual; abstract; - function GetFileSystemFree: Int64; overload; virtual; abstract; - function GetFileSystemFree(const APath: string): Int64; overload; virtual; abstract; - function MakeDir(const NewDir: string): integer; virtual; abstract; // Returns errorcode - function GetDirSize(APath: string): Int64; virtual; abstract; // Returns size or 0 if fails - function Remove(APath: string): integer; virtual; abstract; // Returns errorcode - procedure FillDirFiles(APath: string; List: TList; ALevel: word); virtual; abstract; - function GetFileInfoSL(APath: string): PDataItemSL; virtual; abstract; - function FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; virtual; abstract; - function DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; virtual; abstract; - function MakeSymLink(const NewFileName, PointTo: string): integer; virtual; abstract; // Returns errorcode - function Chmod(const FileName: string; const Mode: integer): integer; virtual; abstract; // Returns errorcode - function Chown(const FileName: string; const UID, GID: integer): integer; virtual; abstract; // Returns errorcode + function GetPath: string; virtual; abstract; + procedure SetPath(Value: string); virtual; abstract; + + function GetDirSize(const APath: string): Int64; virtual; abstract; // Returns size or 0 if fails procedure BreakProcessing(ProcessingKind: integer); virtual; abstract; // 1 = GetDirSize, 2 = GetListing - function RenameFile(SourceFile, DestFile: string): integer; virtual; abstract; // Returns errorcode - function ChangeTimes(APath: string; mtime, atime: Int64): integer; virtual; abstract; // Returns errorcode + function FileExists(const FileName: string; FollowSymlinks: boolean): boolean; virtual; abstract; + function DirectoryExists(const FileName: string; FollowSymlinks: boolean): boolean; virtual; abstract; procedure GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); virtual; abstract; - function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; virtual; abstract; // Returns filedescriptor - function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; virtual; abstract; // Returns number of bytes read - function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; virtual; abstract; // Returns number of bytes written - function CloseFile(const FileDescriptor: TEngineFileDes): integer; virtual; abstract; // Returns errorcode - function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; virtual; abstract; // Returns errorcode function IsOnROMedium(const FileName: string): boolean; virtual; abstract; function FileCanRun(const FileName: string): boolean; virtual; abstract; - function GetPath: string; virtual; abstract; - procedure SetPath(Value: string); virtual; abstract; + + // Operations + function MakeDir(const NewDir: string): integer; virtual; abstract; // Returns errorcode + function Remove(const APath: string): integer; virtual; abstract; // Returns errorcode + function MakeSymLink(const NewFileName, PointTo: string): integer; virtual; abstract; // Returns errorcode + function Chmod(const FileName: string; Mode: cuLong): integer; virtual; abstract; // Returns errorcode + function Chown(const FileName: string; UID, GID: cuLong): integer; virtual; abstract; // Returns errorcode + function RenameFile(const SourceFile, DestFile: string): integer; virtual; abstract; // Returns errorcode + function ChangeTimes(const APath: string; mtime, atime: time_t): integer; virtual; abstract; // Returns errorcode // Copy-related routines function GetBlockSize: guint32; virtual; abstract; procedure SetBlockSize(Value: guint32); virtual; abstract; - function CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; virtual; abstract; // returns True if file is successfully copied - function CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; virtual; abstract; // returns True if file is successfully copied - function IsOnSameFS(const Path1, Path2: string): boolean; virtual; abstract; - function TwoSameFiles(const Path1, Path2: string): boolean; virtual; abstract; + function CopyFileIn(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; virtual; abstract; // returns True if file is successfully copied + function CopyFileOut(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; virtual; abstract; // returns True if file is successfully copied + function IsOnSameFS(const Path1, Path2: string; FollowSymlinks: boolean): boolean; virtual; abstract; + function TwoSameFiles(const Path1, Path2: string; FollowSymlinks: boolean): boolean; virtual; abstract; + + // Separate file read/write routines, not supported on most backends + function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; virtual; abstract; // Returns filedescriptor + function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; virtual; abstract; // Returns number of bytes read + function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; virtual; abstract; // Returns number of bytes written + function CloseFile(const FileDescriptor: TEngineFileDes): integer; virtual; abstract; // Returns errorcode + function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; virtual; abstract; // Returns errorcode published property Path: string read GetPath write SetPath; property BlockSize: guint32 read GetBlockSize write SetBlockSize; @@ -132,45 +128,45 @@ type public constructor Create; destructor Destroy; override; - function GetListing(var List: TList; const AddDotFiles: boolean): integer; override; - function GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; override; + + function GetListing(List: TList; const APath: string; AddDotFiles, FollowSymlinks, AddFullPath: boolean): integer; override; + function GetFileInfo(const APath: string; FollowSymlinks, AddFullPath: boolean): PDataItem; override; + function ChangeDir(const NewPath: string): integer; override; - function ExplicitChDir(const NewPath: string): integer; override; - function GetFileSystemSize: Int64; override; - function GetFileSystemSize(const APath: string): Int64; override; - function GetFileSystemFree: Int64; override; - function GetFileSystemFree(const APath: string): Int64; override; - function MakeDir(const NewDir: string): integer; override; - function GetDirSize(APath: string): Int64; override; - function Remove(APath: string): integer; override; - procedure FillDirFiles(APath: string; List: TList; ALevel: word); override; - function GetFileInfoSL(APath: string): PDataItemSL; override; - function FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; override; - function DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; override; - function MakeSymLink(const NewFileName, PointTo: string): integer; override; - function Chmod(const FileName: string; const Mode: integer): integer; override; - function Chown(const FileName: string; const UID, GID: integer): integer; override; + function GetPath: string; override; + procedure SetPath(Value: string); override; + + function GetDirSize(const APath: string): Int64; override; procedure BreakProcessing(ProcessingKind: integer); override; - function RenameFile(SourceFile, DestFile: string): integer; override; - function ChangeTimes(APath: string; mtime, atime: Int64): integer; override; + function FileExists(const FileName: string; FollowSymlinks: boolean): boolean; override; + function DirectoryExists(const FileName: string; FollowSymlinks: boolean): boolean; override; procedure GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); override; - function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; override; - function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; override; - function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; override; - function CloseFile(const FileDescriptor: TEngineFileDes): integer; override; - function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; override; function IsOnROMedium(const FileName: string): boolean; override; function FileCanRun(const FileName: string): boolean; override; - function GetPath: string; override; - procedure SetPath(Value: string); override; + + function MakeDir(const NewDir: string): integer; override; + function Remove(const APath: string): integer; override; + function MakeSymLink(const NewFileName, PointTo: string): integer; override; + function Chmod(const FileName: string; Mode: cuLong): integer; override; + function Chown(const FileName: string; UID, GID: cuLong): integer; override; + function RenameFile(const SourceFile, DestFile: string): integer; override; + function ChangeTimes(const APath: string; mtime, atime: time_t): integer; override; function GetBlockSize: guint32; override; procedure SetBlockSize(Value: guint32); override; - function CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; - function CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; - function CopyFile(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; - function IsOnSameFS(const Path1, Path2: string): boolean; override; - function TwoSameFiles(const Path1, Path2: string): boolean; override; + function CopyFileIn(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; + function CopyFileOut(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; + function IsOnSameFS(const Path1, Path2: string; FollowSymlinks: boolean): boolean; override; + function TwoSameFiles(const Path1, Path2: string; FollowSymlinks: boolean): boolean; override; + + function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; override; + function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; override; + function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; override; + function CloseFile(const FileDescriptor: TEngineFileDes): integer; override; + function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; override; + + // Local extra functions + function CopyFile(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; published property Path; property BlockSize; @@ -179,6 +175,8 @@ type procedure FreeDataItem(DataItem: PDataItemSL); overload; procedure FreeDataItem(DataItem: PDataItem); overload; +function DuplicateDataItem(DataItem: PDataItem): PDataItem; overload; +function DuplicateDataItem(DataItem: PDataItemSL): PDataItemSL; overload; implementation @@ -236,112 +234,40 @@ begin end; end; -function TLocalTreeEngine.GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; -var Item : PDataItem; - Handle : PDIR; - DirEnt : PDirent64; - Buf : PChar; -// StatBuf : TStatBuf64; - StatBuf : Pstat64; - i: integer; - LnkBuf : array[0..1000] of char; +function TLocalTreeEngine.GetListing(List: TList; const APath: string; AddDotFiles, FollowSymlinks, AddFullPath: boolean): integer; +var Item: PDataItem; + Handle: PDIR; + DirEnt: PDirent64; + Buf: PChar; begin Result := 0; try - APath := IncludeTrailingPathDelimiter(APath); - if libc_chdir(PChar(APath)) <> 0 then begin - Result := errno; - DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): chdir error: ', strerror(Result)]); - Exit; - end; - Handle := opendir(PChar(APath)); - if not Assigned(Handle) then begin - DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): opendir() handle == NULL: ', strerror(errno)]); - Result := ERRNoAccess; - Exit; - end; - repeat -// DebugMsg(['x1']); - DirEnt := readdir64(Handle); -// DebugMsg(['x2']); - if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) then begin -// DebugMsg(['x3']); - Buf := Pchar(@DirEnt^.d_name[0]); -// DebugMsg(['x4']); - if (Buf <> '.') and (Buf <> '..') and (DirEnt^.d_name[0] <> #0) and - (AddDotFiles or (Length(Buf) = 1) or ((Length(Buf) > 1) and (not ((Buf[0] = '.') and (Buf[1] <> '.'))))) then - begin -// DebugMsg(['x5']); - Item := malloc(SizeOf(TDataItem)); -// DebugMsg(['x6']); - memset(Item, 0, SizeOf(TDataItem)); -// DebugMsg(['x7']); - with Item^ do begin -// DebugMsg(['x8']); - FName := nil; - FDisplayName := nil; - LnkPointTo := nil; - for i := 0 to Length(ColumnData) - 1 do ColumnData[i] := nil; - FName := strdup(Buf); - FDisplayName := StrToUTF8(Buf); -// FDisplayName := strdup(Buf); -// DebugMsg(['x']); - StatBuf := malloc(sizeof(Tstat64)); - memset(StatBuf, 0, sizeof(Tstat64)); -// DebugMsg(['(II) TLocalTreeEngine.GetListing(APath=', APath, '): lstat(Buf = ', Buf, ')']); - if lstat64(Buf, StatBuf) <> 0 then begin - DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): Error reading file via lstat64: ', strerror(errno)]); - Continue; - end; - Mode := StatBuf^.st_mode; - IsDotFile := (Length(Buf) > 1) and (Buf[0] = '.') and (Buf[1] <> '.'); - IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); - IsLnk := __S_ISTYPE(StatBuf^.st_mode, __S_IFLNK); - IsBlk := __S_ISTYPE(StatBuf^.st_mode, __S_IFBLK); - IsChr := __S_ISTYPE(StatBuf^.st_mode, __S_IFCHR); - IsFIFO := __S_ISTYPE(StatBuf^.st_mode, __S_IFIFO); - IsSock := __S_ISTYPE(StatBuf^.st_mode, __S_IFSOCK); - ModifyTime := StatBuf^.st_mtime; - if StatBuf^.st_uid = 4294967295 then UID := getuid - else UID := StatBuf^.st_uid; - if StatBuf^.st_gid = 4294967295 then GID := getgid - else GID := StatBuf^.st_gid; - UpDir := False; - Selected := False; -// DebugMsg(['(II) TLocalTreeEngine.GetListing(APath=', APath, '): freeing StatBuf...']); - libc_free(StatBuf); -// DebugMsg([' done.']); - if IsLnk then begin -// DebugMsg(['aaaax']); - i := readlink(PChar(APath + String(Buf)), LnkBuf, SizeOf(LnkBuf)); - if i > 0 then begin - LnkBuf[i] := #0; - LnkPointTo := malloc(i + 1); - memset(LnkPointTo, 0, i + 1); - LnkPointTo := strncpy(LnkPointTo, @LnkBuf[0], i); - end; + if libc_chdir(PChar(APath)) <> 0 then begin + Result := errno; + DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): chdir error: ', strerror(Result)]); + Exit; + end; + Handle := opendir(PChar(APath)); + if Handle = nil then begin + DebugMsg(['*** TLocalTreeEngine.GetListing(APath=', APath, '): opendir() handle == NULL: ', strerror(errno)]); + Result := ERRNoAccess; + Exit; + end; - StatBuf := malloc(sizeof(Tstat64)); - memset(StatBuf, 0, sizeof(Tstat64)); - if stat64(Buf, StatBuf) = 0 then begin - IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); - Mode := StatBuf^.st_mode; - end; -// DebugMsg(['(II) TLocalTreeEngine.GetListing(APath=', APath, '): freeing StatBuf...']); - libc_free(StatBuf); -// DebugMsg([' done.']); - end; -// DebugMsg(['xdffffffff']); - if not IsDir then Size := StatBuf^.st_size - else Size := -1; -// DebugMsg(['xxsdfsf']); + repeat + DirEnt := readdir64(Handle); + if (DirEnt <> nil) and (DirEnt^.d_name[0] <> #0) then begin + Buf := PChar(@DirEnt^.d_name[0]); + if (Buf <> '.') and (Buf <> '..') and (strlen(Buf) > 0) and + (AddDotFiles or (Buf[0] <> '.')) then + begin + Item := GetFileInfo(IncludeTrailingPathDelimiter(APath) + string(Buf), FollowSymlinks, AddFullPath); List.Add(Item); -// DebugMsg(['x1123']); end; end; - end; - until DirEnt = nil; - closedir(Handle); + until DirEnt = nil; + // TODO: check errno? + closedir(Handle); except on E: Exception do begin Result := ERRException; @@ -351,9 +277,66 @@ begin end; end; -function TLocalTreeEngine.GetListing(var List: TList; const AddDotFiles: boolean): integer; +function TLocalTreeEngine.GetFileInfo(const APath: string; FollowSymlinks, AddFullPath: boolean): PDataItem; +var Item: PDataItem; + StatBuf: Pstat64; + LnkBuf: array[0..65535] of char; + i: integer; begin - Result := GetListing(List, AddDotFiles, FPath); + StatBuf := malloc(sizeof(Tstat64)); + memset(StatBuf, 0, sizeof(Tstat64)); + if lstat64(PChar(APath), StatBuf) <> 0 then begin + DebugMsg(['*** TLocalTreeEngine.GetFileInfo(APath=', APath, '): Error reading file via lstat64: ', strerror(errno)]); + libc_free(StatBuf); + Result := nil; + Exit; + end; + + Item := malloc(sizeof(TDataItem)); + memset(Item, 0, sizeof(TDataItem)); + Item^.UpDir := False; + Item^.LnkPointTo := nil; + Item^.Selected := False; + + if AddFullPath then Item^.FName := strdup(PChar(APath)) + else Item^.FName := strdup(PChar(ExtractFileName(APath))); + Item^.FDisplayName := StrToUTF8(Item^.FName); + + Item^.Mode := StatBuf^.st_mode; + Item^.IsDotFile := (Length(ExtractFileName(APath)) > 0) and (ExtractFileName(APath)[1] = '.'); + Item^.IsExecutable := (StatBuf^.st_mode and S_IXUSR) = S_IXUSR; + Item^.IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); + Item^.IsLnk := __S_ISTYPE(StatBuf^.st_mode, __S_IFLNK); + Item^.IsBlk := __S_ISTYPE(StatBuf^.st_mode, __S_IFBLK); + Item^.IsChr := __S_ISTYPE(StatBuf^.st_mode, __S_IFCHR); + Item^.IsFIFO := __S_ISTYPE(StatBuf^.st_mode, __S_IFIFO); + Item^.IsSock := __S_ISTYPE(StatBuf^.st_mode, __S_IFSOCK); + Item^.mtime := StatBuf^.st_mtime; + Item^.atime := StatBuf^.st_atime; + Item^.ctime := StatBuf^.st_ctime; + Item^.UID := StatBuf^.st_uid; + Item^.GID := StatBuf^.st_gid; + Item^.Size := StatBuf^.st_size; + Item^.PackedSize := -1; + libc_free(StatBuf); + + if Item^.IsLnk then begin + i := readlink(PChar(APath), LnkBuf, sizeof(LnkBuf)); + if i >= 0 then + Item^.LnkPointTo := g_strdup(@LnkBuf[0]); + if FollowSymlinks then begin + StatBuf := malloc(sizeof(Tstat64)); + memset(StatBuf, 0, sizeof(Tstat64)); + if stat64(PChar(APath), StatBuf) = 0 then begin + Item^.IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); + Item^.Mode := StatBuf^.st_mode; + Item^.Size := StatBuf^.st_size; + end; + libc_free(StatBuf); + end; + end; + + Result := Item; end; function TLocalTreeEngine.ChangeDir(const NewPath: string): integer; @@ -390,55 +373,6 @@ begin end; (********************************************************************************************************************************) -function TLocalTreeEngine.ExplicitChDir(const NewPath: string): integer; -begin - Result := libc_chdir(PChar(NewPath)); - if Result <> 0 then Result := errno; -end; - -(********************************************************************************************************************************) -function TLocalTreeEngine.GetFileSystemSize(const APath: string): Int64; -var Stat: Pstatfs64; -begin - Result := 0; - try - Stat := malloc(sizeof(Tstatfs64)); - memset(Stat, 0, sizeof(Tstatfs64)); - if statfs64(PChar(APath), Stat) <> 0 then Exit; - Result := Stat^.f_bsize * Stat^.f_blocks; - libc_free(Stat); - except - on E: Exception do DebugMsg(['*** TLocalTreeEngine.GetFileSystemSize(APath=', APath, ') -Exception: ', E.Message]); - end; -end; - -function TLocalTreeEngine.GetFileSystemSize: Int64; -begin - Result := GetFileSystemSize(FPath); -end; - -(********************************************************************************************************************************) -function TLocalTreeEngine.GetFileSystemFree(const APath: string): Int64; -var Stat: Pstatfs64; -begin - Result := 0; - try - Stat := malloc(sizeof(Tstatfs64)); - memset(Stat, 0, sizeof(Tstatfs64)); - if statfs64(PChar(APath), Stat) <> 0 then Exit; - Result := Stat^.f_bsize * Stat^.f_bavail; - libc_free(Stat); - except - on E: Exception do DebugMsg(['*** TLocalTreeEngine.GetFileSystemFree(APath=', APath, ') -Exception: ', E.Message]); - end; -end; - -function TLocalTreeEngine.GetFileSystemFree: Int64; -begin - Result := GetFileSystemFree(FPath); -end; - -(********************************************************************************************************************************) function TLocalTreeEngine.MakeDir(const NewDir: string): integer; begin // DebugMsg(['(II) TLocalTreeEngine.MakeDir: begin']); @@ -447,7 +381,7 @@ begin // if Result <> 0 then Result := errno; if Result <> 0 then try - if Self.DirectoryExists(NewDir) or (g_mkdir_with_parents(PChar(NewDir), OctalToAttr(ConfDefaultDirCreationMask)) <> 0) {ForceDirectories(NewDir))} + if Self.DirectoryExists(NewDir, False) or (g_mkdir_with_parents(PChar(NewDir), OctalToAttr(ConfDefaultDirCreationMask)) <> 0) {ForceDirectories(NewDir))} then Result := errno else Result := 0; except @@ -459,40 +393,36 @@ begin end; (********************************************************************************************************************************) - -function TLocalTreeEngine.GetDirSize(APath: string): Int64; +function TLocalTreeEngine.GetDirSize(const APath: string): Int64; function InternalGetDirSize(APath: string): Int64; - var Handle : PDIR; - DirEnt : PDirent64; - StatBuf : Pstat64; + var Handle: PDIR; + DirEnt: PDirent64; + StatBuf: Pstat64; + Buf: PChar; begin Result := 0; try if BreakProcessingType = 1 then Exit; APath := IncludeTrailingPathDelimiter(APath); - if libc_chdir(PChar(APath)) <> 0 then begin - Result := 0; - Exit; - end; - Handle := OpenDir(PChar(APath)); - if not Assigned(Handle) then begin - Result := 0; - Exit; - end; + if libc_chdir(PChar(APath)) <> 0 then Exit; + Handle := opendir(PChar(APath)); + if not Assigned(Handle) then Exit; repeat DirEnt := readdir64(Handle); - if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) and (PChar(@DirEnt^.d_name[0]) <> '.') and - (PChar(@DirEnt^.d_name[0]) <> '..') and (DirEnt^.d_name[0] <> #0) then - begin - StatBuf := malloc(sizeof(Tstat64)); - memset(StatBuf, 0, sizeof(Tstat64)); - if lstat64(PChar(@DirEnt^.d_name[0]), StatBuf) <> 0 then Continue; - if __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR) then begin - Inc(Result, InternalGetDirSize(APath + String(PChar(@DirEnt^.d_name[0])))); - libc_chdir(PChar(APath)); - end else Inc(Result, StatBuf^.st_size); - libc_free(StatBuf); + if DirEnt <> nil then begin + Buf := PChar(@DirEnt^.d_name[0]); + if (strlen(Buf) > 0) and (Buf <> '.') and (Buf <> '..') then begin + StatBuf := malloc(sizeof(Tstat64)); + memset(StatBuf, 0, sizeof(Tstat64)); + if lstat64(Buf, StatBuf) = 0 then begin + if __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR) then begin + Inc(Result, InternalGetDirSize(APath + string(Buf))); + libc_chdir(PChar(APath)); + end else Inc(Result, StatBuf^.st_size); + end; + libc_free(StatBuf); + end; end; until DirEnt = nil; closedir(Handle); @@ -514,206 +444,25 @@ begin end; (********************************************************************************************************************************) -function TLocalTreeEngine.Remove(APath: string): integer; +function TLocalTreeEngine.Remove(const APath: string): integer; begin - APath := ExcludeTrailingPathDelimiter(APath); - Result := libc_remove(PChar(APath)); + Result := libc_remove(PChar(ExcludeTrailingPathDelimiter(APath))); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) -procedure TLocalTreeEngine.FillDirFiles(APath: string; List: TList; ALevel: word); -var Handle : PDIR; - DirEnt : PDirent64; - StatBuf_global : Pstat64; - Item: PDataItemSL; - i: integer; - LnkBuf : array[0..1000] of char; - FilesList: TList; - - - procedure AddEntry(FPath: string; AddCurrDirStage, AStage1: boolean); - var StatBuf_local : Pstat64; - begin -// DebugMsg(['TLocalTreeEngine.FillDirFiles: addding "', FPath, '"']); - FPath := ExcludeTrailingPathDelimiter(FPath); - StatBuf_local := malloc(sizeof(Tstat64)); - memset(StatBuf_local, 0, sizeof(Tstat64)); - if lstat64(PChar(FPath), StatBuf_local) <> 0 then begin - DebugMsg(['*** TLocalTreeEngine.FillDirFiles: Error reading file stat AddEntry("', FPath, '"): ', strerror(errno)]); - Exit; - end; - Item := malloc(SizeOf(TDataItemSL)); - memset(Item, 0, SizeOf(TDataItemSL)); - with Item^ do begin - FName := nil; - FDisplayName := nil; - LnkPointTo := nil; - ADestination := nil; - Stage1 := AStage1; - FName := strdup(PChar(FPath)); - FDisplayName := StrToUTF8(PChar(FPath)); - Size := StatBuf_local^.st_size; - PackedSize := -1; - Mode := StatBuf_local^.st_mode; - IsDir := __S_ISTYPE(StatBuf_local^.st_mode, __S_IFDIR); - IsLnk := __S_ISTYPE(StatBuf_local^.st_mode, __S_IFLNK); - IsExecutable := AddCurrDirStage or (StatBuf_local^.st_mode and S_IXUSR = S_IXUSR); - IsOnRO := IsOnROMedium(FPath); - ForceMove := False; - if StatBuf_local^.st_uid = 4294967295 then UID := getuid - else UID := StatBuf_local^.st_uid; - if StatBuf_local^.st_gid = 4294967295 then GID := getgid - else GID := StatBuf_local^.st_gid; - atime := StatBuf_local^.st_atime; - mtime := StatBuf_local^.st_mtime; - if IsLnk and AddCurrDirStage then DebugMsg(['*** Assertion failed AddEntry: Item^.IsLnk = True']); - if IsLnk and (not AddCurrDirStage) then begin - i := readlink(PChar(APath + String(PChar(@DirEnt^.d_name[0]))), LnkBuf, SizeOf(LnkBuf)); - if i > 0 then begin - LnkBuf[i] := #0; - LnkPointTo := malloc(i + 1); - memset(LnkPointTo, 0, i + 1); - LnkPointTo := strncpy(LnkPointTo, @LnkBuf[0], i); -// StrLCopy(LnkPointTo, @LnkBuf[0], i); - end; - end; - ModifyTime := StatBuf_local^.st_mtime; -// DebugMsg([FormatDateTime('c', ModifyTime)]); - Level := ALevel + Ord(not AddCurrDirStage); - libc_free(StatBuf_local); - end; - if AddCurrDirStage then List.Add(Item) - else FilesList.Add(Item); - end; - -begin - if not Assigned(List) then Exit; - try - AddEntry(APath, True, True); - FilesList := TList.Create; - APath := IncludeTrailingPathDelimiter(APath); - if libc_chdir(PChar(APath)) <> 0 then begin - DebugMsg(['*** TLocalTreeEngine.FillDirFiles: chdir to "', APath, '" failed: ', strerror(errno)]); - Exit; - end; - Handle := OpenDir(PChar(APath)); - if Assigned(Handle) then - repeat - DirEnt := readdir64(Handle); - if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) and (PChar(@DirEnt^.d_name[0]) <> '.') and (PChar(@DirEnt^.d_name[0]) <> '..') then begin - StatBuf_global := malloc(sizeof(Tstat64)); - memset(StatBuf_global, 0, sizeof(Tstat64)); - if lstat64(PChar(@DirEnt^.d_name[0]), StatBuf_global) <> 0 then begin - DebugMsg(['*** TLocalTreeEngine.FillDirFiles: Error lstat-ing ("', PChar(@DirEnt^.d_name[0]), '"): ', strerror(errno)]); - Continue; - end; - if __S_ISTYPE(StatBuf_global^.st_mode, __S_IFDIR) then begin - FillDirFiles(APath + String(PChar(@DirEnt^.d_name[0])), List, ALevel + 1); - libc_chdir(PChar(APath)); - end else AddEntry(APath + String(PChar(@DirEnt^.d_name[0])), False, True); - libc_free(StatBuf_global); - end; - until DirEnt = nil; - CloseDir(Handle); - if FilesList.Count > 0 then - for i := 0 to FilesList.Count - 1 do - List.Add(FilesList[i]); - FilesList.Free; - AddEntry(APath, True, False); - except - on E: Exception do DebugMsg(['*** TLocalTreeEngine.FillDirFiles(APath=', APath, ', Level=', ALevel, ') -Exception: ', E.Message]); - end; -end; - -(********************************************************************************************************************************) -function TLocalTreeEngine.GetFileInfoSL(APath: string): PDataItemSL; -var StatBuf : Pstat64; - i : integer; - LnkBuf : array[0..1000] of char; -begin - Result := nil; - try - StatBuf := malloc(sizeof(Tstat64)); - memset(StatBuf, 0, sizeof(Tstat64)); - if lstat64(PChar(APath), StatBuf) <> 0 then begin - DebugMsg(['*** Error reading file stat GetFileInfoSL(lstat): ', strerror(errno)]); - Exit; - end; -// DebugMsg(['x1']); - Result := malloc(SizeOf(TDataItemSL)); - memset(Result, 0, SizeOf(TDataItemSL)); -// DebugMsg(['x1']); - with Result^ do begin - FName := nil; - FDisplayName := nil; - LnkPointTo := nil; - ADestination := nil; - Stage1 := True; -// DebugMsg(['x1']); - FName := strdup(PChar(APath)); - FDisplayName := StrToUTF8(PChar(APath)); - Size := StatBuf^.st_size; - PackedSize := -1; - Mode := StatBuf^.st_mode; - IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); - IsLnk := __S_ISTYPE(StatBuf^.st_mode, __S_IFLNK); -// DebugMsg(['x1']); - IsExecutable := StatBuf^.st_mode and S_IXUSR = S_IXUSR; -// DebugMsg(['x2']); - IsOnRO := IsOnROMedium(APath); -// DebugMsg(['x2']); - ForceMove := False; -// DebugMsg(['x2']); - ModifyTime := StatBuf^.st_mtime; -// DebugMsg(['x2']); - if StatBuf^.st_uid = 4294967295 then UID := getuid - else UID := StatBuf^.st_uid; - if StatBuf^.st_gid = 4294967295 then GID := getgid - else GID := StatBuf^.st_gid; - atime := StatBuf^.st_atime; - mtime := StatBuf^.st_mtime; -// DebugMsg(['x1']); - libc_free(StatBuf); -// DebugMsg(['x1']); - Level := 1; -// DebugMsg(['x1']); - if IsLnk then begin - i := readlink(PChar(APath), LnkBuf, SizeOf(LnkBuf)); - if i > 0 then begin - LnkBuf[i] := #0; - LnkPointTo := malloc(i + 1); - memset(LnkPointTo, 0, i + 1); -// StrLCopy(LnkPointTo, @LnkBuf[0], i); - LnkPointTo := strncpy(LnkPointTo, @LnkBuf[0], i); - end; - StatBuf := malloc(sizeof(Tstat64)); - memset(StatBuf, 0, sizeof(Tstat64)); - if stat64(PChar(APath), StatBuf) = 0 then begin - IsDir := __S_ISTYPE(StatBuf^.st_mode, __S_IFDIR); - Mode := StatBuf^.st_mode; - end; - libc_free(StatBuf); - end; - end; -// DebugMsg(['x1']); - except - on E: Exception do DebugMsg(['*** TLocalTreeEngine.GetFileInfoSL(APath=', APath, ') -Exception: ', E.Message]); - end; -end; -(********************************************************************************************************************************) -function TLocalTreeEngine.CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; +function TLocalTreeEngine.CopyFileIn(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; begin Result := CopyFile(Sender, SourceFile, DestFile, ProgressFunc, ErrorFunc, Append); end; -function TLocalTreeEngine.CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; +function TLocalTreeEngine.CopyFileOut(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; begin Result := CopyFile(Sender, SourceFile, DestFile, ProgressFunc, ErrorFunc, Append); end; -function TLocalTreeEngine.CopyFile(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; +function TLocalTreeEngine.CopyFile(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; var fsrc, fdest: PFILE; BytesDone, BytesRead: Int64; // offset: __off_t; @@ -849,26 +598,25 @@ begin end; (********************************************************************************************************************************) -function TLocalTreeEngine.FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; +function TLocalTreeEngine.FileExists(const FileName: string; FollowSymlinks: boolean): boolean; var st: Pstat64; begin st := malloc(sizeof(Tstat64)); memset(st, 0, sizeof(Tstat64)); - if Use_lstat then Result := lstat64(PChar(FileName), st) = 0 - else Result := stat64(PChar(FileName), st) = 0; + if not FollowSymlinks then Result := lstat64(PChar(FileName), st) = 0 + else Result := stat64(PChar(FileName), st) = 0; libc_free(st); end; (********************************************************************************************************************************) -function TLocalTreeEngine.DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; +function TLocalTreeEngine.DirectoryExists(const FileName: string; FollowSymlinks: boolean): boolean; var st: Pstat64; begin st := malloc(sizeof(Tstat64)); memset(st, 0, sizeof(Tstat64)); - if Use_lstat then Result := lstat64(PChar(FileName), st) = 0 else - if stat64(PChar(FileName), st) = 0 - then Result := S_ISDIR(st^.st_mode) - else Result := False; + if not FollowSymlinks then Result := lstat64(PChar(FileName), st) = 0 + else Result := stat64(PChar(FileName), st) = 0; + Result := Result and S_ISDIR(st^.st_mode); libc_free(st); end; @@ -881,14 +629,14 @@ begin end; (********************************************************************************************************************************) -function TLocalTreeEngine.Chmod(const FileName: string; const Mode: integer): integer; +function TLocalTreeEngine.Chmod(const FileName: string; Mode: cuLong): integer; begin Result := libc_chmod(PChar(FileName), Mode); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) -function TLocalTreeEngine.Chown(const FileName: string; const UID, GID: integer): integer; +function TLocalTreeEngine.Chown(const FileName: string; UID, GID: cuLong): integer; begin Result := libc_chown(PChar(FileName), UID, GID); if Result <> 0 then Result := errno; @@ -901,8 +649,9 @@ begin end; (********************************************************************************************************************************) -function TLocalTreeEngine.IsOnSameFS(const Path1, Path2: string): boolean; +function TLocalTreeEngine.IsOnSameFS(const Path1, Path2: string; FollowSymlinks: boolean): boolean; var FStat1, FStat2: Pstat64; + Res1, Res2: integer; begin // DebugMsg(['** TLocalTreeEngine.IsOnSameFS("', Path1, '", "', Path2, '")']); Result := False; // Default fallback result (forces copy + delete) @@ -910,29 +659,50 @@ begin FStat2 := malloc(sizeof(Tstat64)); memset(FStat1, 0, sizeof(Tstat64)); memset(FStat2, 0, sizeof(Tstat64)); - if lstat64(PChar(Path1), FStat1) <> 0 then begin - DebugMsg(['** TLocalTreeEngine.IsOnSameFS: stat(', Path1, ') error: ', strerror(errno)]); - Exit; - end; - if lstat64(PChar(Path2), FStat2) <> 0 then begin - DebugMsg(['** TLocalTreeEngine.IsOnSameFS: stat(', Path2, ') error: ', strerror(errno)]); - Exit; - end; - Result := FStat1^.st_dev = FStat2^.st_dev; + if FollowSymlinks then Res1 := stat64(PChar(Path1), FStat1) + else Res1 := lstat64(PChar(Path1), FStat1); + if Res1 <> 0 then DebugMsg(['** TLocalTreeEngine.IsOnSameFS: stat(', Path1, ') error: ', strerror(errno)]); + if FollowSymlinks then Res2 := stat64(PChar(Path2), FStat2) + else Res2 := lstat64(PChar(Path2), FStat2); + if Res2 <> 0 then DebugMsg(['** TLocalTreeEngine.IsOnSameFS: stat(', Path2, ') error: ', strerror(errno)]); + if (Res1 = 0) and (Res2 = 0) then + Result := FStat1^.st_dev = FStat2^.st_dev; libc_free(FStat1); libc_free(FStat2); // DebugMsg(['** TLocalTreeEngine.IsOnSameFS("', Path1, '", "', Path2, '") Result = ', Result]); end; (********************************************************************************************************************************) -function TLocalTreeEngine.RenameFile(SourceFile, DestFile: string): integer; +function TLocalTreeEngine.TwoSameFiles(const Path1, Path2: string; FollowSymlinks: boolean): boolean; +var FStat1, FStat2: Pstat64; + Res1, Res2: integer; +begin + Result := False; + FStat1 := malloc(sizeof(Tstat64)); + FStat2 := malloc(sizeof(Tstat64)); + memset(FStat1, 0, sizeof(Tstat64)); + memset(FStat2, 0, sizeof(Tstat64)); + if FollowSymlinks then Res1 := stat64(PChar(Path1), FStat1) + else Res1 := lstat64(PChar(Path1), FStat1); + if Res1 <> 0 then DebugMsg(['** TLocalTreeEngine.TwoSameFiles: stat(', Path1, ') error: ', strerror(errno)]); + if FollowSymlinks then Res2 := stat64(PChar(Path2), FStat2) + else Res2 := lstat64(PChar(Path2), FStat2); + if Res2 <> 0 then DebugMsg(['** TLocalTreeEngine.TwoSameFiles: stat(', Path2, ') error: ', strerror(errno)]); + if (Res1 = 0) and (Res2 = 0) then + Result := FStat1^.st_ino = FStat2^.st_ino; + libc_free(FStat1); + libc_free(FStat2); +end; + +(********************************************************************************************************************************) +function TLocalTreeEngine.RenameFile(const SourceFile, DestFile: string): integer; begin Result := libc_rename(PChar(SourceFile), PChar(DestFile)); if Result <> 0 then Result := errno; end; (********************************************************************************************************************************) -function TLocalTreeEngine.ChangeTimes(APath: string; mtime, atime: Int64): integer; +function TLocalTreeEngine.ChangeTimes(const APath: string; mtime, atime: time_t): integer; var timebuf: Putimbuf; begin Result := errno; @@ -966,7 +736,7 @@ begin memset(Stat, 0, sizeof(Tstatfs64)); if statfs64(PChar(APath), Stat) <> 0 then Exit; FSSize := Stat^.f_bsize * Stat^.f_blocks; - FSFree := Stat^.f_bsize * Stat^.f_bavail; + FSFree := Stat^.f_bsize * Stat^.f_bfree; fd := setmntent(_PATH_MOUNTED, 'r'); if fd = nil then Exit; // Get mount name @@ -986,10 +756,12 @@ begin if Stat^.f_type = $9660 then begin { ISOFS_SUPER_MAGIC } if Assigned(mntdev) and (mntdev <> '') then begin fd := fopen(mntdev, 'r'); - if fd = nil then Exit; - if fseek(fd, 32808, SEEK_SET) <> 0 then Exit; - if fread(@Buffer[0], 1, 32, fd) <> 0 then FSName := Trim(String(Buffer)); - fclose(fd); + if fd <> nil then begin + if fseek(fd, 32808, SEEK_SET) = 0 then + if fread(@Buffer[0], 1, 32, fd) <> 0 then + FSName := Trim(String(Buffer)); + fclose(fd); + end; end; end; libc_free(Stat); @@ -1054,8 +826,8 @@ begin try Stat := malloc(sizeof(Tstatfs64)); memset(Stat, 0, sizeof(Tstatfs64)); - if statfs64(PChar(FileName), Stat) <> 0 then Exit; - Result := (Stat^.f_type = $9660); { ISOFS_SUPER_MAGIC } + if statfs64(PChar(FileName), Stat) = 0 then + Result := (Stat^.f_type = $9660); { ISOFS_SUPER_MAGIC } libc_free(Stat); except on E: Exception do DebugMsg(['*** TLocalTreeEngine.IsOnROMedium(FileName=', FileName, ') -Exception: ', E.Message]); @@ -1068,59 +840,66 @@ begin Result := access(PChar(FileName), R_OK or X_OK) = 0; end; -(********************************************************************************************************************************) -function TLocalTreeEngine.TwoSameFiles(const Path1, Path2: string): boolean; -var st1, st2: Pstat64; -begin - Result := False; - st1 := malloc(sizeof(Tstat64)); - st2 := malloc(sizeof(Tstat64)); - memset(st1, 0, sizeof(Tstat64)); - memset(st2, 0, sizeof(Tstat64)); - if lstat64(PChar(Path1), st1) <> 0 then Exit; - if lstat64(PChar(Path2), st2) <> 0 then Exit; -// DebugMsg(['*** TLocalTreeEngine.TwoSameFiles: ', st1^.st_ino, ' ', st2^.st_ino]); - Result := st1^.st_ino = st2^.st_ino; - libc_free(st1); - libc_free(st2); -end; - (********************************************************************************************************************************) (********************************************************************************************************************************) -procedure FreeDataItem(DataItem: PDataItemSL); +procedure FreeDataItem(DataItem: PDataItem); +var i : integer; begin try - if Assigned(DataItem) then begin + if DataItem <> nil then begin with DataItem^ do begin if FName <> nil then libc_free(FName); if FDisplayName <> nil then libc_free(FDisplayName); -// if Assigned(ADestination) then Dispose(ADestination); if LnkPointTo <> nil then libc_free(LnkPointTo); + for i := 0 to Length(ColumnData) - 1 do + if ColumnData[i] <> nil then libc_free(ColumnData[i]); end; libc_free(DataItem); end; except + on E: Exception do DebugMsg(['*** FreeDataItem: Exception: ', E.Message]); end; end; -procedure FreeDataItem(DataItem: PDataItem); -var i : integer; +procedure FreeDataItem(DataItem: PDataItemSL); begin try - if Assigned(DataItem) then begin + if DataItem <> nil then begin with DataItem^ do begin - if FName <> nil then libc_free(FName); - if FDisplayName <> nil then libc_free(FDisplayName); - if LnkPointTo <> nil then libc_free(LnkPointTo); - for i := 0 to Length(ColumnData) - 1 do - if ColumnData[i] <> nil then libc_free(ColumnData[i]); + if ADestination <> nil then libc_free(ADestination); + FreeDataItem(DataItem); end; libc_free(DataItem); end; except + on E: Exception do DebugMsg(['*** FreeDataItem: Exception: ', E.Message]); end; end; +function DuplicateDataItem(DataItem: PDataItem): PDataItem; +var NewDataItem: PDataItem; + i: integer; +begin + NewDataItem := malloc(sizeof(TDataItem)); + memcpy(NewDataItem, DataItem, sizeof(TDataItem)); + NewDataItem^.FName := g_strdup(DataItem^.FName); + NewDataItem^.FDisplayName := g_strdup(DataItem^.FDisplayName); + NewDataItem^.LnkPointTo := g_strdup(DataItem^.LnkPointTo); + for i := 0 to Length(DataItem^.ColumnData) - 1 do + NewDataItem^.ColumnData[i] := g_strdup(DataItem^.ColumnData[i]); + Result := NewDataItem; +end; + +function DuplicateDataItem(DataItem: PDataItemSL): PDataItemSL; +var NewDataItem: PDataItemSL; +begin + NewDataItem := malloc(sizeof(TDataItemSL)); + memcpy(NewDataItem, DataItem, sizeof(TDataItemSL)); + NewDataItem^.ADestination := g_strdup(DataItem^.ADestination); + NewDataItem^.DataItem := DuplicateDataItem(DataItem^.DataItem); + Result := NewDataItem; +end; + end. @@ -161,9 +161,9 @@ function HandleVFSAskPasswordCallback(DialogParent: PGtkWidget; flags: TVFSAskPasswordFlags; username: PPChar; password: PPChar; - anonymous: PInteger; + anonymous: Pgboolean; domain: PPChar; - password_save: PVFSPasswordSave): LongBool; + password_save: PVFSPasswordSave): gboolean; @@ -1351,9 +1351,9 @@ function HandleVFSAskPasswordCallback(DialogParent: PGtkWidget; flags: TVFSAskPasswordFlags; username: PPChar; password: PPChar; - anonymous: PInteger; + anonymous: Pgboolean; domain: PPChar; - password_save: PVFSPasswordSave): LongBool; + password_save: PVFSPasswordSave): gboolean; function table_add_entry(table: PGtkWidget; row: integer; const label_text: PChar; const value: PChar; user_data: PVFSAskPasswordCallbackPriv): PGtkEntry; var entry: PGtkEntry; @@ -1537,7 +1537,7 @@ begin if (priv.username_entry <> nil) and (username <> nil) then username^ := g_strdup(gtk_entry_get_text(priv.username_entry)); if (priv.domain_entry <> nil) and (domain <> nil) then domain^ := g_strdup(gtk_entry_get_text(priv.domain_entry)); if (priv.password_entry <> nil) and (password <> nil) then password^ := g_strdup(gtk_entry_get_text(priv.password_entry)); - if (priv.choice_anon <> nil) and (anonymous <> nil) then anonymous^ := Ord(gtk_toggle_button_get_active(PGtkToggleButton(priv.choice_anon))); + if (priv.choice_anon <> nil) and (anonymous <> nil) then anonymous^ := gtk_toggle_button_get_active(PGtkToggleButton(priv.choice_anon)); if (password_save <> nil) and (radio_forget <> nil) and (radio_remember <> nil) then begin if gtk_toggle_button_get_active(PGtkToggleButton(radio_forget)) then password_save^ := VFS_PASSWORD_SAVE_NEVER else if (radio_session <> nil) and gtk_toggle_button_get_active(PGtkToggleButton(radio_session)) then password_save^ := VFS_PASSWORD_SAVE_FOR_SESSION else @@ -259,7 +259,7 @@ var implementation uses ULibc, - UCore, USelect, UNewDir, UDirDelete, UProgress, UCopyMove, + UCore, UCoreWorkers, USelect, UNewDir, UDirDelete, UProgress, UCopyMove, UCoreUtils, ULocale, UChecksum, UChecksumDruid, USplitFile, UFileTypeSettings, UFileAssoc, UChmod, UChown, USymlink, UPreferences, UViewer, UToolTips, UMounterPrefs, UColumns, @@ -1930,7 +1930,7 @@ begin SetTabLabel(ANotebook, ANotebook.PageIndex, StrToUTF8(s), StrToUTF8(Engine.Path)); end; end; // of Chdir, Listing, ... - Engine.ExplicitChDir('/'); + libc_chdir('/'); Application.ProcessMessages; InternalUnLock; FileListTipsEnable; @@ -3267,7 +3267,6 @@ begin try FChecksumDruid := TFChecksumDruid.Create(Self); - Engine.ExplicitChDir(Engine.Path); FChecksumDruid.Engine := Engine; if Engine.Path = '/' then FChecksumDruid.DirName := 'root' else FChecksumDruid.DirName := ExtractFileName(ExcludeTrailingPathDelimiter(Engine.Path)); @@ -3284,7 +3283,6 @@ begin else ChangingDir(AListView = LeftListView, Engine.Path, FChecksumDruid.FileNameEntry.Text, PDataItem(AListView.Selected.Data)^.FName); DoRefresh(AListView <> LeftListView, True, True); FChecksumDruid.Free; - Engine.ExplicitChDir('/'); end; finally Application.ProcessMessages; @@ -3604,12 +3602,12 @@ end; procedure TFMain.EditViewFileInternal(ParentWindow: TGTKControl; Filename: string; Engine: TPanelEngine; View, NewFile: boolean); var s: string; - Stat: PDataItemSL; + Stat: PDataItem; Error, x: integer; // AViewer: TViewerThread; AViewer: TFViewer; begin - Stat := Engine.GetFileInfoSL(Filename); + Stat := Engine.GetFileInfo(Filename, True, True); if Assigned(Stat) and (Stat^.Size > ConfEditViewFileSizeLimit) and (Application.MessageBox(LANGTheFileYouAreTryingToOpenIsQuiteBig, [mbYes, mbNo], mbWarning, mbNone, mbNo) = mbNo) then begin @@ -3680,7 +3678,7 @@ procedure TFMain.RunFile(Path: string; Engine: TPanelEngine; CustomAction: integ var Command, FileTypeDesc: string; i, ac: integer; b, AutodetectGUI, RunInTerminal: boolean; - Stat: PDataItemSL; + Stat: PDataItem; s: string; Assoc: TFileAssoc; begin @@ -3712,7 +3710,7 @@ begin DebugMsg(['Some strange error occured...']); Exit; end; - Stat := Engine.GetFileInfoSL(Path); + Stat := Engine.GetFileInfo(Path, True, True); if Assigned(Stat) and Stat^.IsExecutable then begin b := True; if Engine is TVFSEngine then b := HandleRunFromArchive(Path, Engine, Command, FileTypeDesc, False); // not a local engine, extract to local first @@ -4043,7 +4041,7 @@ var LeftPanel: boolean; i: longint; SelCount: longint; AFile, NextItem1, NextItem2: string; - Stat: PDataItemSL; + Stat: PDataItem; UsrManager: TUserManager; AWorkingThread: TWorkerThread; AFProgress: TFProgress; @@ -4086,7 +4084,7 @@ begin if AFile <> '' then try FChmod := TFChmod.Create(Self); - Stat := Engine.GetFileInfoSL(IncludeTrailingPathDelimiter(Engine.Path) + AFile); + Stat := Engine.GetFileInfo(IncludeTrailingPathDelimiter(Engine.Path) + AFile, True, True); if not Assigned(Stat) then Exit; UsrManager := TUserManager.Create; try @@ -4142,7 +4140,7 @@ var LeftPanel: boolean; i: integer; SelCount: longint; AFile, NextItem1, NextItem2: string; - Stat: PDataItemSL; + Stat: PDataItem; AWorkingThread: TWorkerThread; AFProgress: TFProgress; begin @@ -4184,7 +4182,7 @@ begin if AFile <> '' then try FChown := TFChown.Create(Self); - Stat := Engine.GetFileInfoSL(IncludeTrailingPathDelimiter(Engine.Path) + AFile); + Stat := Engine.GetFileInfo(IncludeTrailingPathDelimiter(Engine.Path) + AFile, True, True); if not Assigned(Stat) then Exit; FChown.AssignMode(Stat^.Mode, AFile, Stat^.UID, Stat^.GID); if FChown.Run = mbOK then begin @@ -4315,7 +4313,7 @@ procedure TFMain.FilePopupMenuPopup(Sender: TObject); end; var Item: TGTKMenuItem; - DataItem: PDataItemSL; + DataItem: PDataItem; Engine: TPanelEngine; AListView: TGTKListView; FileName, ShortFName: string; @@ -4335,7 +4333,7 @@ begin if Assigned(AListView.Selected) and Assigned(AListView.Selected.Data) and (not PDataItem(AListView.Selected.Data)^.UpDir) then FileName := FileName + PDataItem(AListView.Selected.Data)^.FName; ShortFName := ExtractFileName(ExcludeTrailingPathDelimiter(FileName)); - DataItem := Engine.GetFileInfoSL(FileName); + DataItem := Engine.GetFileInfo(FileName, True, True); if not Assigned(DataItem) then begin DebugMsg(['Error: File data not assigned. Bug ???! FileName = ', FileName]); Exit; @@ -4479,7 +4477,7 @@ end; procedure TFMain.FilePopupMenuItemClick(Sender: TObject); var Engine: TPanelEngine; - DataItem: PDataItemSL; + DataItem: PDataItem; AListView: TGTKListView; FileName, ShortFName, s: string; Error: integer; @@ -4503,7 +4501,7 @@ begin if Assigned(AListView.Selected) and Assigned(AListView.Selected.Data) and (not PDataItem(AListView.Selected.Data)^.UpDir) then FileName := FileName + PDataItem(AListView.Selected.Data)^.FName; ShortFName := ExtractFileName(ExcludeTrailingPathDelimiter(FileName)); - DataItem := Engine.GetFileInfoSL(FileName); + DataItem := Engine.GetFileInfo(FileName, True, True); if not Assigned(DataItem) then begin DebugMsg(['Error: File data not assigned. Bug ???! FileName = ', FileName]); Exit; @@ -6328,7 +6326,7 @@ var LeftPanel: boolean; i: integer; SelCount: longint; AFile, NextItem1, NextItem2: string; - Stat: PDataItemSL; + Stat: PDataItem; { AWorkingThread: TWorkerThread; AFProgress: TFProgress; } begin @@ -6370,7 +6368,7 @@ begin if AFile <> '' then try FProperties := TFProperties.Create(Self); - Stat := Engine.GetFileInfoSL(IncludeTrailingPathDelimiter(Engine.Path) + AFile); + Stat := Engine.GetFileInfo(IncludeTrailingPathDelimiter(Engine.Path) + AFile, True, True); if not Assigned(Stat) then Exit; // FProperties.AssignMode(Stat^.Mode, AFile, Stat^.UID, Stat^.GID); FProperties.DisplayFileName := AFile; @@ -6488,14 +6486,14 @@ end; (********************************************************************************************************************************) function TFMain.HandleRunFromArchive(var APath: string; Engine: TPanelEngine; Command, FileTypeDesc: string; BypassDialog: boolean): boolean; var Res: TMessageButton; - Stat: PDataItemSl; + Stat: PDataItem; s: string; AListView: TGTKListView; begin Result := False; try if not BypassDialog then begin - Stat := Engine.GetFileInfoSL(APath); + Stat := Engine.GetFileInfo(APath, True, True); FRunFromVFS := TFRunFromVFS.Create(Self); FRunFromVFS.FileNameLabel2.Caption := Format('%s<span weight="ultrabold"> </span>', [StrToUTF8(APath)]); if FileTypeDesc = '' then FileTypeDesc := LANGHandleRunFromArchive_FileTypeDesc_Unknown; @@ -6510,7 +6508,7 @@ begin FRunFromVFS.PackedSizeLabel2.Visible := False; FRunFromVFS.PackedSizeLabel.Visible := False; end; - FRunFromVFS.DateLabel2.Caption := Format('%s<span weight="ultrabold"> </span>', [FormatDate(Stat^.ModifyTime, True, True)]); + FRunFromVFS.DateLabel2.Caption := Format('%s<span weight="ultrabold"> </span>', [FormatDate(Stat^.mtime, True, True)]); if (Command = '') and (not Stat^.IsExecutable) then begin FRunFromVFS.OpensWithLabel2.Caption := Format('%s<span weight="ultrabold"> </span>', [LANGHandleRunFromArchive_NotAssociated]); FRunFromVFS.ExecuteButton.Enabled := False; diff --git a/USearch.pas b/USearch.pas index ce9416c..9794e4c 100644 --- a/USearch.pas +++ b/USearch.pas @@ -84,7 +84,7 @@ type FRootEngine: TPanelEngine; Wilds: array of string; GUIMutex: TCriticalSection; - procedure Rekurze(StartDir: string); + procedure DoRecurse(StartDir: string); function FindText(FileName: string): boolean; protected FStartPath, FFileMask, FStringFind: string; @@ -889,14 +889,14 @@ begin Wilds[i] := Format('*%s*', [Wilds[i]]); end; - Rekurze(ExcludeTrailingPathDelimiter(FStartPath)); + DoRecurse(ExcludeTrailingPathDelimiter(FStartPath)); SetLength(Wilds, 0); finally Finished := True; end; end; -procedure TSearchThread.Rekurze(StartDir: string); +procedure TSearchThread.DoRecurse(StartDir: string); var LocalList: TList; i, j: integer; Matches, b: boolean; @@ -917,7 +917,7 @@ begin if FEngine.ChangeDir(StartDir) <> 0 then Exit; LocalList := TList.Create; - if FEngine.GetListing(LocalList, True, StartDir) = 0 then begin + if FEngine.GetListing(LocalList, StartDir, True, True, False) = 0 then begin // Processing... StartDir := IncludeTrailingPathDelimiter(StartDir); @@ -932,7 +932,7 @@ begin Matches := True; // Test if the file is on the same FS if Matches and FDontLeaveFS then - Matches := Matches and FEngine.IsOnSameFS(FStartPath, StartDir + FileName); + Matches := Matches and FEngine.IsOnSameFS(FStartPath, StartDir + FileName, True); // File mask test if Matches and (Length(Wilds) > 0) then begin b := False; @@ -946,13 +946,13 @@ begin if Matches and (FBiggerThan > 0) then Matches := Matches and (Data^.Size >= FBiggerThan); // Date limiting if Matches and (FModifiedLast > 0) then - Matches := Matches and (Data^.ModifyTime <= Now) and (Data^.ModifyTime >= Now - FModifiedLast); + Matches := Matches and (Data^.mtime <= Now) and (Data^.mtime >= Now - FModifiedLast); if Matches and (FModifiedNotLast > 0) then - Matches := Matches and ((Data^.ModifyTime > Now) or (Data^.ModifyTime <= Now - FModifiedNotLast)); + Matches := Matches and ((Data^.mtime > Now) or (Data^.mtime <= Now - FModifiedNotLast)); if Matches and (FNotModifiedAfter > 0) then - Matches := Matches and (Data^.ModifyTime <= FNotModifiedAfter); + Matches := Matches and (Data^.mtime <= FNotModifiedAfter); if Matches and (FModifiedBetween1 > 0) and (FModifiedBetween2 > 0) then - Matches := Matches and (Data^.ModifyTime >= FModifiedBetween1) and (Data^.ModifyTime <= FModifiedBetween2); + Matches := Matches and (Data^.mtime >= FModifiedBetween1) and (Data^.mtime <= FModifiedBetween2); // Find text in file if Matches and (Length(FStringFind) > 0) and (not (FEngine is TVFSEngine)) then begin GUIMutex.Acquire; @@ -979,8 +979,8 @@ begin GUIMutex.Release; end; - if Data^.IsDir and ((not FDontLeaveFS) or (FDontLeaveFS and FEngine.IsOnSameFS(FStartPath, StartDir + FileName))) - then Rekurze(IncludeTrailingPathDelimiter(StartDir) + FileName); + if Data^.IsDir and ((not FDontLeaveFS) or (FDontLeaveFS and FEngine.IsOnSameFS(FStartPath, StartDir + FileName, True))) + then DoRecurse(IncludeTrailingPathDelimiter(StartDir) + FileName); // Handle archives if (not Data^.IsDir) and FSearchArchives and (not (FEngine is TVFSEngine)) then begin @@ -992,7 +992,7 @@ begin xEngine.SavePath := StartDir + FileName; FEngine := xEngine; VFSOpenResult := (FEngine as TVFSEngine).VFSOpenEx(IncludeTrailingPathDelimiter(StartDir) + FileName, nil, nil, nil, nil); - if (VFSOpenResult = 0) and (not CancelIt) then Rekurze('/'); + if (VFSOpenResult = 0) and (not CancelIt) then DoRecurse('/'); FEngine := FEngine.ParentEngine; if not (xEngine as TVFSEngine).VFSClose then DebugMsg(['Error closing the engine...']); xEngine.Free; diff --git a/vfs/UVFSCore.pas b/vfs/UVFSCore.pas index a4bedf0..90b31b5 100644 --- a/vfs/UVFSCore.pas +++ b/vfs/UVFSCore.pas @@ -21,7 +21,7 @@ unit UVFSCore; interface -uses GTKForms, ULibc, Classes, uVFSprototypes, UEngines, UCoreUtils; +uses GTKForms, ULibc, glib2, Classes, uVFSprototypes, UEngines, UCoreUtils; type @@ -40,9 +40,7 @@ type FVFSChangeDir: TVFSChangeDir; FVFSGetPath: TVFSGetPath; FVFSGetPathURI: TVFSGetPathURI; - FVFSGetFileSystemSize: TVFSGetFileSystemSize; - FVFSGetFileSystemFree: TVFSGetFileSystemFree; - FVFSFileExists: TVFSFileExists; + FVFSGetFileSystemInfo: TVFSGetFileSystemInfo; FVFSFileInfo: TVFSFileInfo; FVFSMkDir: TVFSMkDir; FVFSRemove: TVFSRemove; @@ -90,13 +88,14 @@ type TVFSEngine = class(TPanelEngine) private + BreakProcessingType: integer; FGlobs: Pointer; FSourcePlugin: TVFSPlugin; FBlockSize: Cardinal; - BreakProcessingKind: integer; FArchiveMode: boolean; FArchivePath: string; function GetPluginID: string; + function GetDataItemFromVFSItem(P: PVFSItem): PDataItem; public Password: string; PasswordUsed: boolean; @@ -104,58 +103,60 @@ type OpenedFromQuickConnect: boolean; CustomPluginIDSave: string; constructor Create(SourcePlugin: TVFSPlugin); - function VFSOpenURI(URI: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; - function VFSOpenEx(OpenFile: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): TVFSResult; - function VFSClose: boolean; - destructor Destroy; override; - function GetListing(var List: TList; const AddDotFiles: boolean): integer; override; - function GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; override; + + function GetListing(List: TList; const APath: string; AddDotFiles, FollowSymlinks, AddFullPath: boolean): integer; override; + function GetFileInfo(const APath: string; FollowSymlinks, AddFullPath: boolean): PDataItem; override; + function ChangeDir(const NewPath: string): integer; override; - function ChangeDirEx(const NewPath: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): integer; - function ExplicitChDir(const NewPath: string): integer; override; - function GetFileSystemSize: Int64; override; - function GetFileSystemSize(const APath: string): Int64; override; - function GetFileSystemFree: Int64; override; - function GetFileSystemFree(const APath: string): Int64; override; - function MakeDir(const NewDir: string): integer; override; - function GetDirSize(APath: string): Int64; override; - function Remove(APath: string): integer; override; - procedure FillDirFiles(APath: string; List: TList; ALevel: word); override; - function GetFileInfoSL(APath: string): PDataItemSL; override; - function FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; override; - function DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; override; - function MakeSymLink(const NewFileName, PointTo: string): integer; override; - function Chmod(const FileName: string; const Mode: integer): integer; override; - function Chown(const FileName: string; const UID, GID: integer): integer; override; + function GetPath: string; override; + procedure SetPath(Value: string); override; + + function GetDirSize(const APath: string): Int64; override; procedure BreakProcessing(ProcessingKind: integer); override; - function RenameFile(SourceFile, DestFile: string): integer; override; - function ChangeTimes(APath: string; mtime, atime: Int64): integer; override; + function FileExists(const FileName: string; FollowSymlinks: boolean): boolean; override; + function DirectoryExists(const FileName: string; FollowSymlinks: boolean): boolean; override; procedure GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); override; - function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; override; + function IsOnROMedium(const FileName: string): boolean; override; + function FileCanRun(const FileName: string): boolean; override; + + function MakeDir(const NewDir: string): integer; override; + function Remove(const APath: string): integer; override; + function MakeSymLink(const NewFileName, PointTo: string): integer; override; + function Chmod(const FileName: string; Mode: cuLong): integer; override; + function Chown(const FileName: string; UID, GID: cuLong): integer; override; + function RenameFile(const SourceFile, DestFile: string): integer; override; + function ChangeTimes(const APath: string; mtime, atime: time_t): integer; override; + + function GetBlockSize: guint32; override; + procedure SetBlockSize(Value: guint32); override; + function CopyFileIn(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; + function CopyFileOut(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; + function IsOnSameFS(const Path1, Path2: string; FollowSymlinks: boolean): boolean; override; + function TwoSameFiles(const Path1, Path2: string; FollowSymlinks: boolean): boolean; override; + + function OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; override; function ReadFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; ABlockSize: integer; var Error: integer): integer; override; function WriteFile(const FileDescriptor: TEngineFileDes; Buffer: Pointer; BytesCount: integer; var Error: integer): integer; override; function CloseFile(const FileDescriptor: TEngineFileDes): integer; override; function FileSeek(const FileDescriptor: TEngineFileDes; const AbsoluteOffset: Int64; var Error: integer): Int64; override; - function IsOnROMedium(const FileName: string): boolean; override; - function FileCanRun(const FileName: string): boolean; override; - function GetPath: string; override; - procedure SetPath(Value: string); override; - function GetPathURI: string; - function GetBlockSize: Cardinal; override; - procedure SetBlockSize(Value: Cardinal); override; - function CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; - function CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; override; - function CopyFileInEx(Sender: Pointer; SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; - AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; - function CopyFileOutEx(Sender: Pointer; SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; - AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; - function IsOnSameFS(const Path1, Path2: string): boolean; override; - function TwoSameFiles(const Path1, Path2: string): boolean; override; + // VFS additions + function VFSOpenURI(const URI: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; + function VFSOpenEx(const OpenFile: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): TVFSResult; + function VFSClose: boolean; + function ChangeDirEx(const NewPath: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): integer; + + function GetPathURI: string; function GetPasswordRequired: boolean; procedure ResetPassword; + + // the callbacks here are used for next volume prompts, password prompts (encrypted archives) - as long as this is specific to each file + function CopyFileInEx(Sender: Pointer; const SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; + AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; + function CopyFileOutEx(Sender: Pointer; const SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; + AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; published property Path: string read GetPath write SetPath; property BlockSize: Cardinal read GetBlockSize write SetBlockSize; @@ -215,9 +216,7 @@ begin @FVFSGetPath := dlsym(ModuleHandle, 'VFSGetPath'); @FVFSGetPathURI := dlsym(ModuleHandle, 'VFSGetPathURI'); @FVFSChangeDir := dlsym(ModuleHandle, 'VFSChangeDir'); - @FVFSGetFileSystemSize := dlsym(ModuleHandle, 'VFSGetFileSystemSize'); - @FVFSGetFileSystemFree := dlsym(ModuleHandle, 'VFSGetFileSystemFree'); - @FVFSFileExists := dlsym(ModuleHandle, 'VFSFileExists'); + @FVFSGetFileSystemInfo := dlsym(ModuleHandle, 'VFSGetFileSystemInfo'); @FVFSFileInfo := dlsym(ModuleHandle, 'VFSFileInfo'); @FVFSMkDir := dlsym(ModuleHandle, 'VFSMkDir'); @FVFSRemove := dlsym(ModuleHandle, 'VFSRemove'); @@ -343,11 +342,11 @@ end; constructor TVFSEngine.Create(SourcePlugin: TVFSPlugin); begin inherited Create; + BreakProcessingType := 0; FSourcePlugin := SourcePlugin; FBlockSize := 65536; FArchiveMode := False; FArchivePath := ''; - BreakProcessingKind := 0; FGlobs := nil; Password := ''; PasswordUsed := False; @@ -370,7 +369,7 @@ begin end; end; -function TVFSEngine.VFSOpenURI(URI: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; +function TVFSEngine.VFSOpenURI(const URI: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; begin Result := False; if (FGlobs <> nil) and (@FSourcePlugin.FVFSOpenURI <> nil) then begin @@ -384,7 +383,7 @@ begin end; end; -function TVFSEngine.VFSOpenEx(OpenFile: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): TVFSResult; +function TVFSEngine.VFSOpenEx(const OpenFile: string; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): TVFSResult; begin Result := cVFS_OK; if (FGlobs <> nil) and (@FSourcePlugin.FVFSOpenArchive <> nil) then begin @@ -399,6 +398,7 @@ begin end; end; +(********************************************************************************************************************************) function TVFSEngine.VFSClose: boolean; begin Result := False; @@ -406,20 +406,52 @@ begin then Result := FSourcePlugin.FVFSClose(FGlobs) = cVFS_OK; end; -function TVFSEngine.GetListing(var List: TList; const AddDotFiles: boolean; APath: string): integer; +function TVFSEngine.GetDataItemFromVFSItem(P: PVFSItem): PDataItem; +var Item: PDataItem; +begin + Item := malloc(sizeof(TDataItem)); + memset(Item, 0, sizeof(TDataItem)); + Item^.UpDir := False; + Item^.Selected := False; + + Item^.FName := g_strdup(P^.FName); + Item^.FDisplayName := g_strdup(P^.FDisplayName); + Item^.LnkPointTo := g_strdup(P^.sLinkTo); + Item^.Mode := P^.iMode; + Item^.IsDotFile := (Length(P^.FName) > 1) and (P^.FName[0] = '.'); + Item^.IsExecutable := (P^.iMode and S_IXUSR) = S_IXUSR; + Item^.IsDir := TVFSItemType(P^.ItemType) = vDirectory; + Item^.IsLnk := P^.IsLink; + Item^.IsBlk := TVFSItemType(P^.ItemType) = vBlockdev; + Item^.IsChr := TVFSItemType(P^.ItemType) = vChardev; + Item^.IsFIFO := TVFSItemType(P^.ItemType) = vFifo; + Item^.IsSock := TVFSItemType(P^.ItemType) = vSock; + Item^.mtime := P^.m_time; + Item^.atime := P^.a_time; + Item^.ctime := P^.c_time; + Item^.UID := P^.iUID; + Item^.GID := P^.iGID; + Item^.Size := P^.iSize; + Item^.PackedSize := P^.iPackedSize; + + Result := Item; +end; + +function TVFSEngine.GetListing(List: TList; const APath: string; AddDotFiles, FollowSymlinks, AddFullPath: boolean): integer; var P: PVFSItem; Item: PDataItem; - i, Res: integer; + Res: integer; begin DebugMsg(['^^VFS (II): GetListing begin']); Result := 0; try - if @FSourcePlugin.FVFSListFirst = nil then Exit; - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); -// DebugMsg(['Item = ', Int64(P)]); -// DebugMsg(['FVFSListFirst']); - Res := FSourcePlugin.FVFSListFirst(FGlobs, PChar(APath), P); + if @FSourcePlugin.FVFSListFirst = nil then begin + Result := ERRNoAccess; + Exit; + end; + P := real_libc_malloc(sizeof(TVFSItem)); + memset(P, 0, sizeof(TVFSItem)); + Res := FSourcePlugin.FVFSListFirst(FGlobs, PChar(APath), P, FollowSymlinks, AddFullPath); if Res <> cVFS_OK then begin FSourcePlugin.FVFSListClose(FGlobs); if Res = cVFS_Not_More_Files then Result := 0 @@ -429,68 +461,17 @@ begin end; repeat -// DebugMsg(['begin--']); - if AddDotFiles or (not ((Length(P^.FName) > 1) and (P^.FName[0] = '.') and (P^.FName[1] <> '.'))) then begin -// DebugMsg(['Checkpoint 1']); - Item := malloc(SizeOf(TDataItem)); - memset(Item, 0, SizeOf(TDataItem)); -// DebugMsg(['Checkpoint 2']); - for i := 0 to Length(Item^.ColumnData) - 1 do Item^.ColumnData[i] := nil; -// DebugMsg(['Checkpoint 3']); - with Item^ do - try - FName := strdup(P^.FName); - FDisplayName := strdup(P^.FDisplayName); - if P^.sLinkTo <> nil - then begin - LnkPointTo := strdup(P^.sLinkTo); - DebugMsg(['LnkPointTo = ', P^.sLinkTo]); - end else LnkPointTo := nil; - Mode := P^.iMode; -// DebugMsg(['Checkpoint 4']); - IsDotFile := (Length(FName) > 1) and (FName[0] = '.') and (FName[1] <> '.'); - IsDir := TVFSItemType(P^.ItemType) = vDirectory; - IsLnk := TVFSItemType(P^.ItemType) = vSymlink; - IsBlk := TVFSItemType(P^.ItemType) = vBlockdev; - IsChr := TVFSItemType(P^.ItemType) = vChardev; - IsFIFO := TVFSItemType(P^.ItemType) = vFifo; - IsSock := TVFSItemType(P^.ItemType) = vSock; -// DebugMsg(['Checkpoint 5']); - ModifyTime := P^.m_time; -// DebugMsg(['Returned datetime: ', Longword(P^.m_time)]); -// DebugMsg(['Checkpoint 6']); - UID := P^.iUID; -// DebugMsg(['Checkpoint 7']); - GID := P^.iGID; -// DebugMsg(['Checkpoint 8']); - UpDir := False; -// DebugMsg(['Checkpoint 9']); - Selected := False; -// DebugMsg(['Checkpoint 10']); - Size := P^.iSize; -// DebugMsg(['Checkpoint 11']); - List.Add(Item); -// DebugMsg(['Checkpoint 12']); - except - on E: Exception do - DebugMsg(['^^VFS (EE): GetListing: Item-Exception: ', E.Message]); - end; - end; // of if AddDotFiles + if (strlen(P^.FName) > 0) and (AddDotFiles or (P^.FName[0] <> '.')) then begin + Item := GetDataItemFromVFSItem(P); + List.Add(Item); + end; if P^.FName <> nil then real_libc_free(P^.FName); if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); // Not needed - just zero-erase the memory -// DebugMsg(['Checkpoint 13']); - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); -// DebugMsg(['Item = ', Int64(P)]); -// DebugMsg(['Checkpoint 14']); -// DebugMsg(['FVFSListNext --begin']); - Res := FSourcePlugin.FVFSListNext(FGlobs, PChar(APath), P); -// DebugMsg(['FVFSListNext --end']); -// Sleep(500); - until (Res <> cVFS_OK) or (BreakProcessingKind = 2); - if BreakProcessingKind <> 0 then DebugMsg(['^^VFS (WW): GetListing: stopped by BreakProcessing']); + memset(P, 0, sizeof(TVFSItem)); + Res := FSourcePlugin.FVFSListNext(FGlobs, P); + until (Res <> cVFS_OK) or (BreakProcessingType = 2); + if BreakProcessingType <> 0 then DebugMsg(['^^VFS (WW): GetListing: stopped by BreakProcessing']); real_libc_free(P); FSourcePlugin.FVFSListClose(FGlobs); @@ -499,62 +480,67 @@ begin on E: Exception do DebugMsg(['^^VFS (EE): GetListing: Exception: ', E.Message]); end; - BreakProcessingKind := 0; + BreakProcessingType := 0; DebugMsg(['^^VFS (II): GetListing end.']); end; -function TVFSEngine.GetListing(var List: TList; const AddDotFiles: boolean): integer; -begin - Result := GetListing(List, AddDotFiles, GetPath); -end; - -function TVFSEngine.ExplicitChDir(const NewPath: string): integer; -begin - Result := libc_chdir(PChar(NewPath)); - if Result <> 0 then Result := errno; -end; - -function TVFSEngine.GetFileSystemSize: Int64; -begin - Result := GetFileSystemSize(GetPath); -end; - -function TVFSEngine.GetFileSystemSize(const APath: string): Int64; -begin - if (FGlobs <> nil) and (@FSourcePlugin.FVFSGetFileSystemSize <> nil) - then Result := FSourcePlugin.FVFSGetFileSystemSize(FGlobs, PChar(APath)) - else Result := 0; -end; - -function TVFSEngine.GetFileSystemFree: Int64; -begin - Result := GetFileSystemFree(GetPath); -end; - -function TVFSEngine.GetFileSystemFree(const APath: string): Int64; +function TVFSEngine.GetFileInfo(const APath: string; FollowSymlinks, AddFullPath: boolean): PDataItem; +var P: PVFSItem; + Res: integer; begin - if (FGlobs <> nil) and (@FSourcePlugin.FVFSGetFileSystemFree <> nil) - then Result := FSourcePlugin.FVFSGetFileSystemFree(FGlobs, PChar(APath)) - else Result := 0; + DebugMsg(['^^VFS (II): GetFileInfo begin']); + Result := nil; + if @FSourcePlugin.FVFSFileInfo = nil then Exit; + try + P := real_libc_malloc(sizeof(TVFSItem)); + memset(P, 0, sizeof(TVFSItem)); + Res := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(APath), P, FollowSymlinks, AddFullPath); + if Res = cVFS_OK then + Result := GetDataItemFromVFSItem(P); + if P^.FName <> nil then real_libc_free(P^.FName); + if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); + if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); + real_libc_free(P); + except + on E: Exception do + DebugMsg(['^^VFS (EE): GetFileInfo: Exception: ', E.Message]); + end; + DebugMsg(['^^VFS (II): GetFileInfo end.']); end; +(********************************************************************************************************************************) procedure TVFSEngine.GetFileSystemInfo(const APath: string; var FSSize, FSFree: Int64; var FSName: string); +var AFSSize, AFSFree: Int64; + AFSName: PChar; begin - FSSize := GetFileSystemSize(APath); - FSFree := GetFileSystemFree(APath); + FSSize := -1; + FSFree := -1; FSName := 'plugin'; + if @FSourcePlugin.FVFSGetFileSystemInfo <> nil then begin + AFSSize := -1; + AFSFree := -1; + AFSName := nil; + if FSourcePlugin.FVFSGetFileSystemInfo(FGlobs, PChar(APath), @AFSSize, @AFSFree, @AFSName) = cVFS_OK then begin + FSSize := AFSSize; + FSFree := AFSFree; + if AFSName <> nil then begin + FSName := string(AFSName); + real_libc_free(AFSName); + end; + end; + end; end; function TVFSEngine.IsOnROMedium(const FileName: string): boolean; begin - Result := True; + Result := FArchiveMode; end; function TVFSEngine.FileCanRun(const FileName: string): boolean; -var Item: PDataItemSL; +var Item: PDataItem; begin - Item := GetFileInfoSL(FileName); - Result := Assigned(Item) and Item^.IsExecutable; + Item := GetFileInfo(FileName, True, True); + Result := (Item <> nil) and Item^.IsExecutable; FreeDataItem(Item); end; @@ -614,81 +600,39 @@ begin ChangeDir(Value); end; -function TVFSEngine.FileExists(const FileName: string; const Use_lstat: boolean = False): Boolean; -begin - if (FGlobs <> nil) and (@FSourcePlugin.FVFSFileExists <> nil) - then Result := FSourcePlugin.FVFSFileExists(FGlobs, PChar(FileName), Use_lstat) - else Result := False; -end; - -function TVFSEngine.DirectoryExists(const FileName: string; const Use_lstat: boolean = False): Boolean; +function TVFSEngine.FileExists(const FileName: string; FollowSymlinks: boolean): boolean; var P: PVFSItem; - Res: integer; begin - if @FSourcePlugin.FVFSFileExists <> nil then begin - Result := FSourcePlugin.FVFSFileExists(FGlobs, PChar(FileName), Use_lstat); - if Result and (@FSourcePlugin.FVFSFileInfo <> nil) then begin - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); - Res := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(FileName), P); - if (Res <> cVFS_OK) or (P = nil) or (TVFSItemType(P^.ItemType) <> vDirectory) then Result := False; - real_libc_free(P); - end; - end else Result := False; + Result := False; + if (FGlobs = nil) or (@FSourcePlugin.FVFSFileInfo = nil) then + Exit; + try + P := real_libc_malloc(sizeof(TVFSItem)); + memset(P, 0, sizeof(TVFSItem)); + Result := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(FileName), P, FollowSymlinks, False) = cVFS_OK; + real_libc_free(P); + except + on E: Exception do + DebugMsg(['^^VFS (EE): FileExists: Exception: ', E.Message]); + end; end; -function TVFSEngine.GetFileInfoSL(APath: string): PDataItemSL; +function TVFSEngine.DirectoryExists(const FileName: string; FollowSymlinks: boolean): boolean; var P: PVFSItem; - Item: PDataItemSL; Res: integer; begin - Result := nil; - if @FSourcePlugin.FVFSFileInfo = nil then Exit; - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); - - Res := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(APath), P); - if Res <> cVFS_OK then begin - DebugMsg(['*** VFSFileInfo(', APath, ') failed. Code = ', Res]); + Result := False; + if (FGlobs = nil) or (@FSourcePlugin.FVFSFileInfo = nil) then Exit; - end; - try - Item := malloc(SizeOf(TDataItemSL)); - memset(Item, 0, SizeOf(TDataItemSL)); - with Item^ do begin -{ FName := strdup(P^.FName); - FDisplayName := StrToUTF8(P^.FName); } - FName := strdup(PChar(APath)); - - //* TODO - FDisplayName := StrToUTF8(PChar(APath)); - if P^.sLinkTo <> nil then LnkPointTo := strdup(P^.sLinkTo) - else LnkPointTo := nil; - ADestination := nil; - Stage1 := True; - Level := 0; - IsDir := TVFSItemType(P^.ItemType) = vDirectory; - IsLnk := TVFSItemType(P^.ItemType) = vSymlink; - ForceMove := False; -{***} IsOnRO := True; - IsExecutable := P^.iMode and S_IXUSR = S_IXUSR; - Mode := P^.iMode; - ModifyTime := P^.m_time; - mtime := P^.m_time; - atime := P^.a_time; - UID := P^.iUID; - GID := P^.iGID; - Size := P^.iSize; - PackedSize := P^.iPackedSize; - if P^.FName <> nil then real_libc_free(P^.FName); - if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); - if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); - end; - Result := Item; + P := real_libc_malloc(sizeof(TVFSItem)); + memset(P, 0, sizeof(TVFSItem)); + Res := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(FileName), P, FollowSymlinks, False); + Result := (Res = cVFS_OK) and (TVFSItemType(P^.ItemType) = vDirectory); + real_libc_free(P); except - on E: Exception do DebugMsg(['*** TVFSEngine.GetFileInfoSL(APath=', APath, ') -Exception: ', E.Message]); + on E: Exception do + DebugMsg(['^^VFS (EE): FileExists: Exception: ', E.Message]); end; end; @@ -698,165 +642,43 @@ begin else Result := cVFS_Failed; end; -function TVFSEngine.Remove(APath: string): integer; +function TVFSEngine.Remove(const APath: string): integer; begin if @FSourcePlugin.FVFSRemove <> nil then Result := FSourcePlugin.FVFSRemove(FGlobs, PChar(APath)) else Result := cVFS_Failed; end; -function TVFSEngine.RenameFile(SourceFile, DestFile: string): integer; +function TVFSEngine.RenameFile(const SourceFile, DestFile: string): integer; begin if @FSourcePlugin.FVFSRename <> nil then Result := FSourcePlugin.FVFSRename(FGlobs, PChar(SourceFile), PChar(DestFile)) else Result := cVFS_Failed; end; -procedure TVFSEngine.FillDirFiles(APath: string; List: TList; ALevel: word); -var Item: PDataItemSL; - i, Res: integer; - FilesList: TList; - LocalList: TStringList; - P: PVFSItem; - - - procedure AddEntry(FPath: string; AddCurrDirStage, AStage1: boolean); - begin - Item := malloc(SizeOf(TDataItemSL)); - memset(Item, 0, SizeOf(TDataItemSL)); - with Item^ do begin -// AName := malloc(Length(FPath) + 1); -// memset(AName, 0, Length(FPath) + 1); - FName := strdup(PChar(FPath)); - - //* TODO - FDisplayName := StrToUTF8(PChar(FPath)); - if P^.sLinkTo <> nil then LnkPointTo := strdup(P^.sLinkTo) - else LnkPointTo := nil; - ADestination := nil; - Stage1 := AStage1; - IsDir := TVFSItemType(P^.ItemType) = vDirectory; - IsLnk := TVFSItemType(P^.ItemType) = vSymlink; - if IsLnk and AddCurrDirStage then DebugMsg(['*** Assertion failed AddEntry: Item^.IsLnk = True']); - ForceMove := False; -{***} IsOnRO := True; - IsExecutable := AddCurrDirStage or (P^.iMode and S_IXUSR = S_IXUSR); - Mode := P^.iMode; - ModifyTime := P^.m_time; - mtime := P^.m_time; - atime := P^.a_time; - UID := P^.iUID; - GID := P^.iGID; - Size := P^.iSize; - PackedSize := P^.iPackedSize; - Level := ALevel + Ord(not AddCurrDirStage); - end; - if AddCurrDirStage then List.Add(Item) - else FilesList.Add(Item); - end; - -begin - if not Assigned(List) then Exit; - FilesList := TList.Create; - LocalList := TStringList.Create; - try - try - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); - Res := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(APath), P); - if Res <> cVFS_OK then DebugMsg(['*** FillDirFiles - VFSFileInfo(', APath, ') failed. Code = ', Res]); - AddEntry(APath, True, True); - if P^.FName <> nil then real_libc_free(P^.FName); - if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); - if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); - - APath := IncludeTrailingPathDelimiter(APath); - if @FSourcePlugin.FVFSChangeDir <> nil then Res := FSourcePlugin.FVFSChangeDir(FGlobs, PChar(APath)) - else Exit; - if Res <> 0 then Exit; - - if @FSourcePlugin.FVFSListFirst = nil then Exit; - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); - Res := FSourcePlugin.FVFSListFirst(FGlobs, PChar(APath), P); - if Res <> cVFS_OK then begin - FSourcePlugin.FVFSListClose(FGlobs); - if P^.FName <> nil then real_libc_free(P^.FName); - if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); - if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); - Exit; - end; - - repeat - if TVFSItemType(P^.ItemType) = vDirectory - then LocalList.Add(APath + String(P^.FName)) - else AddEntry(APath + String(P^.FName), False, True); - if P^.FName <> nil then real_libc_free(P^.FName); - if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); - if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); - Res := FSourcePlugin.FVFSListNext(FGlobs, PChar(GetPath), P); - until (Res <> cVFS_OK); - - if P^.FName <> nil then real_libc_free(P^.FName); - if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); - if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); - FSourcePlugin.FVFSListClose(FGlobs); - - if LocalList.Count > 0 then - for i := 0 to LocalList.Count - 1 do - FillDirFiles(LocalList[i], List, ALevel + 1); - - if FilesList.Count > 0 then - for i := 0 to FilesList.Count - 1 do - List.Add(FilesList[i]); - except - on E: Exception do DebugMsg(['*** TVFSEngine.FillDirFiles(APath=', APath, ', Level=', ALevel, ') -Exception: ', E.Message]); - end; - finally - P := real_libc_malloc(SizeOf(TVFSItem)); - memset(P, 0, SizeOf(TVFSItem)); - Res := FSourcePlugin.FVFSFileInfo(FGlobs, PChar(APath), P); - if Res <> cVFS_OK then DebugMsg(['*** FillDirFiles - VFSFileInfo(', APath, ') failed. Code = ', Res]); - AddEntry(APath, True, False); - if P^.FName <> nil then real_libc_free(P^.FName); - if P^.FDisplayName <> nil then real_libc_free(P^.FDisplayName); - if P^.sLinkTo <> nil then real_libc_free(P^.sLinkTo); - real_libc_free(P); - - LocalList.Free; - FilesList.Free; - end; -end; - function TVFSEngine.MakeSymLink(const NewFileName, PointTo: string): integer; begin if @FSourcePlugin.FVFSMakeSymLink <> nil then Result := FSourcePlugin.FVFSMakeSymLink(FGlobs, PChar(NewFileName), PChar(PointTo)) else Result := cVFS_Failed; end; -function TVFSEngine.Chmod(const FileName: string; const Mode: integer): integer; +function TVFSEngine.Chmod(const FileName: string; Mode: cuLong): integer; begin if @FSourcePlugin.FVFSChmod <> nil then Result := FSourcePlugin.FVFSChmod(FGlobs, PChar(FileName), Mode) else Result := cVFS_Failed; end; -function TVFSEngine.Chown(const FileName: string; const UID, GID: integer): integer; +function TVFSEngine.Chown(const FileName: string; UID, GID: cuLong): integer; begin if @FSourcePlugin.FVFSChown <> nil then Result := FSourcePlugin.FVFSChown(FGlobs, PChar(FileName), UID, GID) else Result := cVFS_Failed; end; -function TVFSEngine.ChangeTimes(APath: string; mtime, atime: Int64): integer; +function TVFSEngine.ChangeTimes(const APath: string; mtime, atime: time_t): integer; begin if @FSourcePlugin.FVFSChangeTimes <> nil then Result := FSourcePlugin.FVFSChangeTimes(FGlobs, PChar(APath), mtime, atime) else Result := cVFS_Failed; end; -function TVFSEngine.GetDirSize(APath: string): Int64; +function TVFSEngine.GetDirSize(const APath: string): Int64; begin if @FSourcePlugin.FVFSGetDirSize <> nil then Result := FSourcePlugin.FVFSGetDirSize(FGlobs, PChar(APath)) else Result := 0; @@ -883,10 +705,11 @@ end; (********************************************************************************************************************************) -function TVFSEngine.IsOnSameFS(const Path1, Path2: string): boolean; +function TVFSEngine.IsOnSameFS(const Path1, Path2: string; FollowSymlinks: boolean): boolean; begin - if @FSourcePlugin.FVFSIsOnSameFS <> nil then Result := FSourcePlugin.FVFSIsOnSameFS(FGlobs, PChar(Path1), PChar(Path2)) - else Result := True; + if @FSourcePlugin.FVFSIsOnSameFS <> nil + then Result := FSourcePlugin.FVFSIsOnSameFS(FGlobs, PChar(Path1), PChar(Path2), FollowSymlinks) + else Result := True; end; function TVFSEngine.OpenFile(const APath: string; Mode: integer; var Error: integer): TEngineFileDes; @@ -931,26 +754,26 @@ begin end else Result := -1; end; -function TVFSEngine.TwoSameFiles(const Path1, Path2: string): boolean; +function TVFSEngine.TwoSameFiles(const Path1, Path2: string; FollowSymlinks: boolean): boolean; begin - if @FSourcePlugin.FVFSTwoSameFiles <> nil then Result := FSourcePlugin.FVFSTwoSameFiles(FGlobs, PChar(Path1), PChar(Path2)) + if @FSourcePlugin.FVFSTwoSameFiles <> nil then Result := FSourcePlugin.FVFSTwoSameFiles(FGlobs, PChar(Path1), PChar(Path2), FollowSymlinks) else Result := False; end; (********************************************************************************************************************************) -function TVFSEngine.CopyFileIn(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; +function TVFSEngine.CopyFileIn(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; begin Result := CopyFileInEx(Sender, SourceFile, DestFile, ErrorFunc, Append, nil, nil, nil, nil); end; -function TVFSEngine.CopyFileOut(Sender: Pointer; SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; +function TVFSEngine.CopyFileOut(Sender: Pointer; const SourceFile, DestFile: string; ProgressFunc: TEngineProgressFunc; ErrorFunc: TEngineErrorFunc; Append: boolean): boolean; begin Result := CopyFileInEx(Sender, SourceFile, DestFile, ErrorFunc, Append, nil, nil, nil, nil); end; -function TVFSEngine.CopyFileOutEx(Sender: Pointer; SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; +function TVFSEngine.CopyFileOutEx(Sender: Pointer; const SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; var Res: TVFSResult; begin @@ -986,7 +809,7 @@ begin end; end; -function TVFSEngine.CopyFileInEx(Sender: Pointer; SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; +function TVFSEngine.CopyFileInEx(Sender: Pointer; const SourceFile, DestFile: string; ErrorFunc: TEngineErrorFunc; Append: boolean; AskQuestionCallback: PVFSAskQuestionCallback; AskPasswordCallback: PVFSAskPasswordCallback; ProgressCallback: PVFSProgressCallback; CallbackData: Pointer): boolean; var Res: TVFSResult; begin diff --git a/vfs/uVFSprototypes.pas b/vfs/uVFSprototypes.pas index 5da4bc9..75c7349 100644 --- a/vfs/uVFSprototypes.pas +++ b/vfs/uVFSprototypes.pas @@ -27,6 +27,8 @@ unit uVFSprototypes; interface +uses glib2; + {$IFDEF FPC} {$PACKRECORDS C} {$ENDIF} @@ -34,18 +36,6 @@ interface const cVFSVersion = 5; // current version of the VFS API - // Capabilities - capVFS_nil = 0; - capVFS_List = 1; - capVFS_CopyOut = 2; - capVFS_CopyIn = 4; - capVFS_NeedsTemp = 8; // if not set, the seek operation is available - capVFS_Multiple = 16; // support multiple files - ? - capVFS_Execute = 32; - capVFS_Writable = 64; - capVFS_NeedsLogin = 128; // Anonymous is login operation too - - // Error codes (TVFSResult) cVFS_OK = 0; cVFS_Failed = 1; // also No such file @@ -79,70 +69,43 @@ const type TVFSResult = longint; - TVFSGlobs = Pointer; + // Plugin private data for each connection/instance + TVFSGlobs = Pointer; // File descriptor for Open, Read, Write, Close, Seek operations TVFSFileDes = Pointer; TVFSAskPasswordFlags = Longint; + // Let the plugin save password, usually to gnome-keyring PVFSPasswordSave = ^TVFSPasswordSave; - // Let plugin save the password, usually to gnome-keyring TVFSPasswordSave = (VFS_PASSWORD_SAVE_NEVER, VFS_PASSWORD_SAVE_FOR_SESSION, VFS_PASSWORD_SAVE_PERMANENTLY); - TVFSItemType = (vRegular=0, vSymlink=1, vChardev=2, vBlockdev=3, vDirectory=4, vFifo=5, vSock=6, vOther=7); - -{$IFDEF KYLIX} - DWORD = Cardinal; -// ShortBool = boolean; -{$ENDIF} -{$IFNDEF CPU64} - ShortBool = boolean; -{$ENDIF} - - - //* TODO: FName/FDisplayName: napsat presne pravidla pro absolutni/relativni cesty a opravit v modulech i v UVFSCore + TVFSItemType = (vRegular=0, vChardev=1, vBlockdev=2, vDirectory=3, vFifo=4, vSock=5, vOther=6); PVFSItem = ^TVFSItem; TVFSItem = record -{$IFNDEF CPU64} // 32-bit platform FName: PChar; - // FDisplayName - plugins must ensure correct UTF-8 string - FDisplayName: PChar; - iSize: Int64; - // iPackedSize - set to -1 if plugin doesn't support this feature - iPackedSize: Int64; - m_time: DWORD; - a_time: DWORD; - c_time: DWORD; - iMode: Integer; + FDisplayName: PChar; // FDisplayName - plugins must return valid UTF-8 string + iSize: guint64; + iPackedSize: gint64; // iPackedSize - set to -1 if plugin doesn't support this feature + m_time: guint32; + a_time: guint32; + c_time: guint32; + iMode: guint32; + IsLink: gboolean; sLinkTo: PChar; - iUID: Integer; - iGID: Integer; - ItemType: Integer; -{$ELSE} // 64-bit platform - FName: PChar; - FDisplayName: PChar; - iSize: Int64; - iPackedSize: Int64; - m_time: QWORD; - a_time: QWORD; - c_time: QWORD; - iMode: Longint; - __padding1: array[1..4] of byte; - sLinkTo: PChar; - iUID: Longint; - iGID: Longint; - ItemType: Longint; - __padding: array[1..4] of byte; -{$ENDIF} + iUID: guint32; + iGID: guint32; + ItemType: TVFSItemType; end; - // This structure contains basic informations about the plugin + + // Basic information about the plugin PVFSInfo = ^TVFSInfo; TVFSInfo = record ID: PChar; // unique identifier, not shown in GUI @@ -161,10 +124,10 @@ type cancel_choice: Integer; user_data: Pointer); cdecl; - PVFSAskPasswordCallback = ^TVFSAskPasswordCallback; // Remember to allocate passed strings separately (use strdup() when setting reply) // Modules are eligible for keeping passwords during one session; calling callback again means the last password was wrong and user should enter new one // Returns True (1) if succeeded or False (0) if cancelled + PVFSAskPasswordCallback = ^TVFSAskPasswordCallback; TVFSAskPasswordCallback = function (const AMessage: PChar; const default_user: PChar; const default_domain: PChar; @@ -172,104 +135,116 @@ type flags: TVFSAskPasswordFlags; username: PPChar; password: PPChar; - anonymous: PInteger; + anonymous: Pgboolean; domain: PPChar; password_save: PVFSPasswordSave; - user_data: Pointer): LongBool; cdecl; + user_data: Pointer): gboolean; cdecl; // Return False to break the operation PVFSProgressCallback = ^TVFSProgressCallback; - TVFSProgressCallback = function (position: Int64; - max: Int64; - user_data: Pointer): LongBool; cdecl; + TVFSProgressCallback = function (position: guint64; + max: guint64; + user_data: Pointer): gboolean; cdecl; type // Log function for plugin debugging output - host application will print or save these messages + // TODO: add log_level? PVFSLogFunc = ^TVFSLogFunc; TVFSLogFunc = procedure(const S: PChar); cdecl; + // Set callbacks, the user_data value will be passed into them + TVFSSetCallbacks = procedure (g: TVFSGlobs; ask_question_callback: PVFSAskQuestionCallback; + ask_password_callback: PVFSAskPasswordCallback; + progress_func: PVFSProgressCallback; + user_data: Pointer); cdecl; - TVFSNew = function (LogFunc: PVFSLogFunc): TVFSGlobs; cdecl; // Allocates memory for the globs structure and performs intialization of the plugin + TVFSNew = function (LogFunc: PVFSLogFunc): TVFSGlobs; cdecl; + // Performs cleanup and destroys all objects TVFSFree = procedure (g: TVFSGlobs); cdecl; - // Performs cleanup and destroy all objects - TVFSVersion = function: integer; cdecl; - // Returns VFS API Version; must match version hardcoded in the host program, otherwise the module is not loaded + // Returns VFS API Version; must match version hardcoded in the host program, otherwise module is not loaded // Please use the cVFSVersion constant as a return value - TVFSGetInfo = function: PVFSInfo; cdecl; + TVFSVersion = function: integer; cdecl; // Returns module info struct, tuxcmd will take care of memory deallocation - TVFSGetArchiveExts = function: PChar; cdecl; + TVFSGetInfo = function: PVFSInfo; cdecl; // Returns the list of filename extensions which the module can handle separated by ';' (without a leading dots) // Returning NULL or not defining the symbol at all means plugin can't handle archives // tuxcmd will take care of memory deallocation - TVFSGetNetworkServices = function: PChar; cdecl; + TVFSGetArchiveExts = function: PChar; cdecl; // Returns the list of supported remote protocols separated by ';' (without the '://') // Returning NULL or not defining the symbol at all means plugin can't access network services // tuxcmd will take care of memory deallocation - TVFSSetProtocolLogFunc = procedure (g:TVFSGlobs; ProtocolLogFunc: TVFSLogFunc); cdecl; + TVFSGetNetworkServices = function: PChar; cdecl; // TODO: Sets the protocol log function (unlike module debug log func this is intended only for server messages (FTP mainly)) - TVFSSetBlockSize = procedure (g:TVFSGlobs; Value: Cardinal); cdecl; - // Sets the block size for I/O operations (not all modules supports this) + TVFSSetProtocolLogFunc = procedure (g:TVFSGlobs; ProtocolLogFunc: TVFSLogFunc); cdecl; + // Sets block size for I/O operations (not supported by all modules) + TVFSSetBlockSize = procedure (g:TVFSGlobs; Value: guint32); cdecl; + // Opens specified archive. This will also switch engine into an archiving mode TVFSOpenArchive = function (g:TVFSGlobs; const sName: PChar): TVFSResult; cdecl; - // Opens specified archive. This will also switch plugin (an instance) into archiving mode - TVFSOpenURI = function (g:TVFSGlobs; const sURI: PChar): TVFSResult; cdecl; - // Opens specified network location. This will also switch plugin (an instance) into networking mode + // Opens specified network location. This will also switch engine into a networking mode // In case of URI, do not supply password encoded in the string; plugin will automatically spawn the TVFSAskPasswordCallback callback when needed - TVFSClose = function (g:TVFSGlobs): TVFSResult; cdecl; + TVFSOpenURI = function (g:TVFSGlobs; const sURI: PChar): TVFSResult; cdecl; // Closes the file or connection to the server - TVFSMkDir = function (g:TVFSGlobs; const sDirName: PChar): TVFSResult; cdecl; - TVFSRename = function (g:TVFSGlobs; const sSrcName, sDstName: PChar): TVFSResult; cdecl; - // Only rename/move in this function, the two files/directories have to be on the same filesystem - otherway it needs to be copied and deleted manually - TVFSRemove = function (g:TVFSGlobs; const APath: PChar): TVFSResult; cdecl; - // Removes the file/directory (empty only!) - TVFSFileExists = function (g:TVFSGlobs; const FileName: PChar; const Use_lstat: LongBool): LongBool; cdecl; - // This function checks for existing location; the Use_lstat parameter specifies to not follow the symlinks (default false = follow symlinks) - TVFSMakeSymLink = function (g:TVFSGlobs; const NewFileName, PointTo: PChar): TVFSResult; cdecl; - TVFSChmod = function (g:TVFSGlobs; const FileName: PChar; const Mode: integer): TVFSResult; cdecl; - // The parameter for this function is in classic unix format (glibc) - a bit mask - TVFSChown = function (g:TVFSGlobs; const FileName: PChar; const UID, GID: integer): TVFSResult; cdecl; - TVFSChangeTimes = function (g:TVFSGlobs; APath: PChar; mtime, atime: Longint): TVFSResult; cdecl; - // Changes times for the file/directory - mtime and atime are __time_t parameters (glibc) + TVFSClose = function (g:TVFSGlobs): TVFSResult; cdecl; + + + // These functions serves for listing contents of a directory + // Before calling VFSListFirst, it is recommended to change target directory (VFSChangeDir) to check it really exists + // First call the VFSListFirst function and then repeat call of VFSListNext until it returns NULL. + // Then call VFSListClose to make cleanup + TVFSListFirst = function (g:TVFSGlobs; const sDir: PChar; VFSItem: PVFSItem; FollowSymlinks, AddFullPath: gboolean): TVFSResult; cdecl; + TVFSListNext = function (g:TVFSGlobs; VFSItem: PVFSItem): TVFSResult; cdecl; + TVFSListClose = function (g:TVFSGlobs): TVFSResult; cdecl; + // Gets a single info item without need to list a whole directory + TVFSFileInfo = function (g:TVFSGlobs; const AFileName: PChar; VFSItem: PVFSItem; FollowSymlinks, AddFullPath: gboolean): TVFSResult; cdecl; + + + // Try to change directory, checks real access TVFSChangeDir = function (g:TVFSGlobs; const NewPath: PChar): TVFSResult; cdecl; - // Try to change the directory when correct permissions + // Returns current working path, tuxcmd will take care of memory deallocation TVFSGetPath = function (g:TVFSGlobs): PChar; cdecl; - // Returns the current working path (not all plugins can support this; just return '/' in this case) - // tuxcmd will take care of memory deallocation + // Returns the current working path in the URI form, tuxcmd will take care of memory deallocation TVFSGetPathURI = function (g:TVFSGlobs): PChar; cdecl; - // Returns the current working path in the URI form - // tuxcmd will take care of memory deallocation - TVFSGetFileSystemSize = function (g:TVFSGlobs; const APath: PChar): Int64; cdecl; - // Gets the size of filesystem; the path is optional, specified to recognize various mounted filesystems in the tree - TVFSGetFileSystemFree = function (g:TVFSGlobs; const APath: PChar): Int64; cdecl; - TVFSGetFSLabel = function (g:TVFSGlobs; const APath: PChar): PChar; cdecl; - // Gets the filesystem label, tuxcmd will take care of memory deallocation - TVFSIsOnSameFS = function (g:TVFSGlobs; const Path1, Path2: PChar): boolean; cdecl; - TVFSTwoSameFiles = function (g:TVFSGlobs; const Path1, Path2: PChar): boolean; cdecl; + // Gets filesystem info; tuxcmd will take care of memory deallocation + TVFSGetFileSystemInfo = function (g:TVFSGlobs; const APath: PChar; FSSize, FSFree: PInt64; FSLabel: PPChar): TVFSResult; cdecl; + TVFSIsOnSameFS = function (g:TVFSGlobs; const Path1, Path2: PChar; FollowSymlinks: gboolean): gboolean; cdecl; // Checks if the two files are simmilar (used to test the case-insensitive filesystem - or hardlinks) - TVFSGetDirSize = function (g:TVFSGlobs; APath: PChar): Int64; cdecl; - // Calculates recursively the size of the tree specified under the path APath - TVFSBreakGetDirSize = procedure (g:TVFSGlobs); cdecl; + TVFSTwoSameFiles = function (g:TVFSGlobs; const Path1, Path2: PChar; FollowSymlinks: gboolean): gboolean; cdecl; + // Calculates recursively the size of a tree specified + TVFSGetDirSize = function (g:TVFSGlobs; const APath: PChar): guint64; cdecl; // Call this function to break the calculation performed by VFSGetDirSize - TVFSRun = function (g:TVFSGlobs; const sName: PChar): TVFSResult; cdecl; - // TODO: Runs the command read from inside the archive (typically installing the rpm package) + TVFSBreakGetDirSize = procedure (g:TVFSGlobs); cdecl; + + // Operations + TVFSMkDir = function (g:TVFSGlobs; const sDirName: PChar): TVFSResult; cdecl; + // Rename/Move, the two files/directories have to be on the same filesystem (do manual copy and delete otherway) + TVFSRename = function (g:TVFSGlobs; const sSrcName, sDstName: PChar): TVFSResult; cdecl; + // Removes file/directory (empty only!) + TVFSRemove = function (g:TVFSGlobs; const APath: PChar): TVFSResult; cdecl; + TVFSMakeSymLink = function (g:TVFSGlobs; const NewFileName, PointTo: PChar): TVFSResult; cdecl; + // Mode is classic unix format (glibc) - a bit mask + TVFSChmod = function (g:TVFSGlobs; const FileName: PChar; Mode: guint32): TVFSResult; cdecl; + TVFSChown = function (g:TVFSGlobs; const FileName: PChar; UID, GID: guint32): TVFSResult; cdecl; + // Changes times for the file/directory - mtime and atime are __time_t parameters (glibc) + TVFSChangeTimes = function (g:TVFSGlobs; const APath: PChar; mtime, atime: guint32): TVFSResult; cdecl; - TVFSCopyToLocal = function (g:TVFSGlobs; const sSrcName, sDstName: PChar; Append: LongBool): TVFSResult; cdecl; - // Performs the copy process from inside of module to the file in the local system + // Performs the copy process from inside of module to local filesystem // (thus sSrcName is a path from inside of module and sDstName is path in the local filesystem where the file should be copied) - // The data pointer is then used to call the callback function in - // Note: if you need to transfer a file between two VFS modules, you need to do it manually - either first copy to local FS or use the Open, Read, Write functions of the module (NOTE: both VFS modules have to support these functions) + // Note: if you need to transfer a file between two VFS modules, you need to do it manually - + // - either first copy to local FS or use the Open, Read, Write functions of the module (NOTE: both VFS modules have to support these functions) + TVFSCopyToLocal = function (g:TVFSGlobs; const sSrcName, sDstName: PChar; Append: gboolean): TVFSResult; cdecl; + // Performs the copy process from local filesystem into the module + TVFSCopyFromLocal = function (g:TVFSGlobs; const sSrcName, sDstName: PChar; Append: gboolean): TVFSResult; cdecl; - TVFSCopyFromLocal = function (g:TVFSGlobs; const sSrcName, sDstName: PChar; Append: LongBool): TVFSResult; cdecl; - // Performs the copy process from the local filesystem into the module - - // Prototype function for packing new files into archive + // TODO: Prototype function for packing new files into archive TVFSPack = function (g:TVFSGlobs; const sSrcName, sDstName: PChar; CompressionLevel: integer; const Password: PChar): TVFSResult; cdecl; - // This is the set of basic functions which can manipulate with the data + // TODO: not implemented at all + // This is the set of basic functions which can manipulate with data // There is a TVFSFileDes object which identifies the processed file (filedescriptor) // All these functions needs a pointer to an int variable to store the error code // NOTE: not all modules could support this set of functions due to its design (unable to set a solid block size) @@ -284,41 +259,14 @@ type // Sets the position in the file from the start and returns real current position - // These are the functions used to list the contents of the directory - // First call the VFSListFirst function and then repeat call of VFSListNext until it returns NULL. - // Then call VFSListClose to make cleanup - TVFSListFirst = function (g:TVFSGlobs; const sDir: PChar; VFSItem: PVFSItem): TVFSResult; cdecl; - TVFSListNext = function (g:TVFSGlobs; const sDir: PChar; VFSItem: PVFSItem): TVFSResult; cdecl; - TVFSListClose = function (g:TVFSGlobs): TVFSResult; cdecl; - - //* TODO: napsat presne pravidla pro absolutni/relativni cesty a opravit v modulech i v UVFSCore - TVFSFileInfo = function (g:TVFSGlobs; AFileName: PChar; VFSItem: PVFSItem): TVFSResult; cdecl; - // Gets a single info item without need to list a whole directory - - TVFSGetPasswordRequired = function (g:TVFSGlobs): LongBool; cdecl; - - - // Reset stored session password in the plugin + // Returns flag indicating whether password is required for some files in the archive + TVFSGetPasswordRequired = function (g:TVFSGlobs): gboolean; cdecl; + // Reset stored password in the plugin session TVFSResetPassword = procedure (g: TVFSGlobs); cdecl; - - - /// pridat neco jako set_loglevel ?? - -//// pridat typ pluginu - jestli archive nebo protocol - prip. jeste pridat ktery protokoly je to schopno handlovat - - - - TVFSSetCallbacks = procedure (g: TVFSGlobs; ask_question_callback: PVFSAskQuestionCallback; - ask_password_callback: PVFSAskPasswordCallback; - progress_func: PVFSProgressCallback; - user_data: Pointer); cdecl; - - - // TODO: some function to check the CRC of the archive - it should need also some progress feedback - the processed file and percentage progress -// Prekopat error logging - asi neco na zpusob GError, stringy se budou vracet i z pluginu +// TODO: port error logging subsystem to glib's GError implementation |