(* Tux Commander - UCore - Some engine-related core functions Copyright (C) 2008 Tomas Bzatek Check for updates on tuxcmd.sourceforge.net This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) unit UCore; interface uses glib2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore; function FillPanel(List: TList; ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean): boolean; function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; 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); type TWorkerThread = class(TThread) private FCancelled: boolean; GUIMutex: TCriticalSection; protected procedure Execute; override; procedure CommitGUIUpdate; public // Data to updating 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, FSigDialogDirDelete, FSigDialogOverwrite, FSigDialogNewDir, FSigDialogMsgBox: 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; // 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 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; TGetDirSizeThread = class(TThread) private FCancelled: boolean; protected procedure Execute; override; public Finished: boolean; Engine: TPanelEngine; Path: string; Result: Int64; constructor Create; procedure CancelIt; end; TOpenDirThread = class(TThread) private procedure Execute; override; public AEngine: TPanelEngine; xEngine: TVFSEngine; APath: string; ASelItem: string; AAutoFallBack: boolean; ADirList: TList; ChDirResult, ListingResult, VFSOpenResult: integer; Finished, CancelIt: boolean; RunningTime: Int64; APlugin: TVFSPlugin; AFullPath, AHighlightItem: string; Password: string; 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; function HandleLogin(Parent: TComponent; Engine: TPanelEngine; UserName, Password: string): boolean; procedure GetDirSize(AListView: TGTKListView; Engine: TPanelEngine; DataList: TList; AllItems: boolean); type TMounterItem = class public // Strings are in locale encoding (ANSI) DisplayText, MountPath, Device, IconPath, MountCommand, UmountCommand: string; DeviceType: integer; function Mounted: boolean; function IsInFSTab: boolean; function Mount: boolean; function Umount: boolean; function Eject: boolean; end; TConnMgrItem = class public ConnectionName: string; URI: string; // generated at runtime ServiceType, Server, Username, Password, TargetDir: string; PluginID: string; // leave blank for default 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); var LeftLocalEngine, RightLocalEngine: TPanelEngine; LeftPanelData, RightPanelData, AssocList, MounterList, ConnectionMgrList: TList; CommandLineHistory, Bookmarks: TStringList; LeftPanelTabs, RightPanelTabs: TStringList; LeftTabSortIDs, RightTabSortIDs: TList; LeftTabSortTypes, RightTabSortTypes: TList; FMainEscPressed: boolean; UsedTempPaths: TStringList; SelectHistory, SearchHistory: TStringList; (********************************************************************************************************************************) implementation (********************************************************************************************************************************) uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, UNewDir, UFileAssoc, USymlink, UCoreClasses, ULogin, uVFSprototypes, URemoteWait, UMain; (********************************************************************************************************************************) procedure ClearListData(List: TList); var i: integer; begin try if not Assigned(List) then Exit; if List.Count > 0 then for i := 0 to List.Count - 1 do FreeDataItem(PDataItem(List[i])); List.Clear; except on E: Exception do DebugMsg(['*** Exception raised in UCore.ClearListData (', E.ClassName, '): ', E.Message]); end; end; (********************************************************************************************************************************) procedure AddUpDirItem(ListView: TGTKListView; DataList: TList); var ListItem: TGTKListItem; Data: PDataItem; j: integer; s: string; begin if ListView.Items.Count = 0 then ListItem := ListView.Items.Add else ListItem := ListView.Items[0]; Data := malloc(SizeOf(TDataItem)); memset(Data, 0, SizeOf(TDataItem)); with Data^ do begin UpDir := True; IsDotFile := False; FName := nil; FDisplayName := nil; LnkPointTo := nil; Selected := False; IsLnk := False; for j := 0 to Length(ColumnData) - 1 do ColumnData[j] := nil; for j := 1 to ConstNumPanelColumns do if ConfColumnVisible[j] then case ConfColumnIDs[j] of 1, 2: begin if ConfDisableDirectoryBrackets then s := '..' else s := '[..]'; ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s)); end; 4: ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(LANGDIR)); end; Icon := UpDirIcon.FPixbuf; ItemColor := NormalItemGDKColor; if not Application.GTKVersion_2_0_5_Up then ListItem.SetValue(0, Data); end; ListItem.Data := Data; DataList.Add(Data); end; (********************************************************************************************************************************) function FillPanel(List: TList; ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean): boolean; var DataList: TList; i, j, SortColumnID, ItemCount : integer; ListItem : TGTKListItem; Ext, s, s2 : string; SortOrder: TGTKTreeViewSortOrder; Time1, Time2: TDateTime; IsRoot: boolean; UsrManager: TUserManager; begin Result := False; try UsrManager := nil; if LeftPanel then DataList := LeftPanelData else DataList := RightPanelData; IsRoot := (Engine.Path = '/') and (not ((Engine is TVFSEngine) and (Engine as TVFSEngine).ArchiveMode)); { Time1 := Now; Time2 := Now; DebugMsg(['Get Listing: ', SecondOf(Time2 - Time1), ':', MillisecondOf(Time2 - Time1)]); } Time1 := Now; SortColumnID := ListView.SortColumnID; SortOrder := ListView.SortOrder; ListView.SetSortInfo(-1, soAscending); ClearListData(DataList); if List.Count + Ord(not IsRoot) < ListView.Items.Count then for i := ListView.Items.Count - 1 downto List.Count + Ord(not IsRoot) do ListView.Items.Delete(i); ItemCount := ListView.Items.Count; Time2 := Now; DebugMsg(['Items clear: ', SecondOf(Time2 - Time1), ':', MillisecondOf(Time2 - Time1)]); Time1 := Now; if ((Engine is TVFSEngine) and (Engine as TVFSEngine).ArchiveMode) or (Engine.Path <> '/') then AddUpDirItem(ListView, DataList); if List.Count > 0 then for i := 0 to List.Count - 1 do with PDataItem(List[i])^ do begin if i + Ord(not IsRoot) > ItemCount - 1 then ListItem := ListView.Items.Add else ListItem := ListView.Items[i + Ord(not IsRoot)]; s := String(FDisplayName); Ext := ''; if not IsDir then SeparateExt(s, s, Ext); // Ext := ANSIToUTF8(Ext); // Fill the column data for j := 1 to ConstNumPanelColumns do if ConfColumnVisible[j] then case ConfColumnIDs[j] of 1: begin if IsDir and (not ConfDisableDirectoryBrackets) then s2 := Format('[%s]', [s]) else s2 := s; ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 2: begin if IsDir and (not ConfDisableDirectoryBrackets) then s2 := Format('[%s]', [FDisplayName]) else s2 := FDisplayName; ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 3: ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(Ext)); 4: begin if IsDir then s2 := LANGDIR else s2 := FormatSize(Size, 0); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 5: begin s2 := FormatDate(ModifyTime, True, True); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 6: begin s2 := FormatDate(ModifyTime, False, True); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 7: begin s2 := FormatDate(ModifyTime, True, False); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 8: begin if ConfShowTextUIDs then begin if not Assigned(UsrManager) then UsrManager := TUserManager.Create; s2 := UsrManager.GetUserName(UID, False); end else s2 := IntToStr(UID); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 9: begin if ConfShowTextUIDs then begin if not Assigned(UsrManager) then UsrManager := TUserManager.Create; s2 := UsrManager.GetGroupName(GID, False); end else s2 := IntToStr(GID); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 10: begin if ConfOctalPerm then s2 := Format('%.4d', [AttrToOctal(Mode mod $1000)]) else s2 := AttrToStr(Mode); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; end; ItemColor := nil; AddFileTypeIcon(List[i]); DataList.Add(List[i]); ListItem.Data := DataList[DataList.Count - 1]; if not Application.GTKVersion_2_0_5_Up then ListItem.SetValue(0, List[i]); end; Time2 := Now; DebugMsg(['Fill panel: ', SecondOf(Time2 - Time1), ':', MillisecondOf(Time2 - Time1)]); // DebugWriteList(DataList); if Assigned(UsrManager) then UsrManager.Free; Time1 := Now; ListView.SetSortInfo(SortColumnID, SortOrder); Time2 := Now; DebugMsg(['Sorting: ', SecondOf(Time2 - Time1), ':', MillisecondOf(Time2 - Time1)]); DebugMsg(['------------------------------']); Result := True; except on E: Exception do begin Application.MessageBox(Format(LANGErrorGettingListingForSPanelNoPath, [LANGPanelStrings[LeftPanel], E.Message]), [mbOK], mbError, mbNone, mbOK); Exit; end; end; end; (********************************************************************************************************************************) function 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 Result := 1; 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 Error := Engine.ChangeDir(APath); while AutoFallback and (Error <> 0) and (APath <> '/') do begin GoUp(APath); 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; (********************************************************************************************************************************) 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; 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 AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); 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 AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); if Engine.ChangeDir(CurrPath, False) <> 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; 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 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; 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, False) <> 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 // 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 with TWorkerThread(Sender) do begin if ParamBool2 then begin Result := True; Exit; end; case ErrorType of 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 : begin // Cancel button 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: PDataItemSL; begin try with SenderThread do begin if ((SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine)) or ((SrcEngine is TLocalTreeEngine) and (not (DestEngine is TLocalTreeEngine))) then Result := DestEngine.CopyFileIn(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ProgressFunc, @CopyFilesWorker_ErrorFunc, Append) else // DebugMsg(['2 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$']); if (not (SrcEngine is TLocalTreeEngine)) and (DestEngine is TLocalTreeEngine) then Result := SrcEngine.CopyFileOut(SenderThread, SourceFile, DestFile, @CopyFilesWorker_ProgressFunc, @CopyFilesWorker_ErrorFunc, Append) // both files are on different engines, we will have to handle the copy process ourselves else Result := ManualCopyFile(SourceFile, DestFile, Append); // DebugMsg(['3 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$']); // If size differs, then delete target file if (not Append) and (not Result) then begin // DebugMsg(['4 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$']); 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; // DebugMsg(['(II) CopyFilesWorker.LocalCopyFile: finished']); 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 // DebugMsg(['### IsOnSameFS: "', SrcPath, '" vs. "', DestPath, '"'#10'## Prefix = "', SenderThread.SrcEngine.GetPrefix, '" vs. "', SenderThread.DestEngine.GetPrefix, '"']); with SenderThread do if SrcEngine.GetPrefix <> DestEngine.GetPrefix then Result := False else Result := DestEngine.IsOnSameFS(SrcPath, DestPath); end; function TwoSameFiles(Path1, Path2: string; TestCaseInsensitiveFS: boolean): boolean; begin with SenderThread do begin if SrcEngine.GetPrefix <> DestEngine.GetPrefix 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 try ErrorKind := 0; Result := 0; 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; 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; 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 Response = 0 then begin Response := ShowOverwriteDialog(1 + Ord(ParamBool3), Format(LANGOverwriteS, [StrToUTF8(NewFilePath)]), Format(LANGOvewriteSBytesS, [FormatSize(Item^.Size, 0), FormatDateTime('ddddd t', Item^.ModifyTime)]), Format(LANGWithFileS, [AFileRec^.FDisplayName]), Format(LANGOvewriteSBytesS, [FormatSize(AFileRec^.Size, 0), FormatDateTime('ddddd t', AFileRec^.ModifyTime)]), 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; 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 DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']) else begin Info^.ADestination := strdup(PChar(s)); Info^.ForceMove := True; AList.Add(Info); end; end else SrcEngine.FillDirFiles(FullPath, AList, 1); 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, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); if SrcEngine.ChangeDir(CurrPath, False) <> 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])^.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 SrcEngine is TVFSEngine then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [SrcEngine.GetPrefix, string(PDataItemSL(List[i])^.FDisplayName)])])) else UpdateCaption1(Format(LANGFromS, [string(PDataItemSL(List[i])^.FDisplayName)])); if DestEngine is TVFSEngine then UpdateCaption2(Format(LANGToS, [Format(ConstFullPathFormatStr, [DestEngine.GetPrefix, StrToUTF8(s)])])) else UpdateCaption2(Format(LANGToS, [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; 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, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); if SaveSrcPath <> '' then CurrPath := SaveSrcPath; if SrcEngine.ChangeDir(CurrPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; SenderThread.FDoneThread := True; DebugMsg(['(II) CopyFilesWorker: finished']); end; (********************************************************************************************************************************) function ComputeBlockSize(TotalSize: Int64): longint; 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; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure DebugWriteListSL(List: TList); var i: integer; Item: PDataItemSL; begin if not ParamDebug then Exit; if not Assigned(List) then begin WriteLn('List not assigned'); Exit; end; WriteLn('********************************************************'); WriteLn('** List.Count = ', List.Count, ' base @ ', integer(pointer(List))); if List.Count > 0 then for i := 0 to List.Count - 1 do if not Assigned(List[i]) then WriteLn('**** List Item idx ', i, '; base @ nil') else 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(' ADestination: ', Item^.ADestination); except on E: Exception do WriteLn('(EE): Exception ', E.ClassName, ' raised: ', E.Message); end; WriteLn('** End of listing'); WriteLn('********************************************************'); end; procedure DebugWriteList(List: TList); var i: integer; Item: PDataItem; begin if not ParamDebug then Exit; if not Assigned(List) then begin WriteLn('List not assigned'); Exit; end; WriteLn('********************************************************'); WriteLn('** List.Count = ', List.Count, ' base @ ', integer(pointer(List))); if List.Count > 0 then for i := 0 to List.Count - 1 do if not Assigned(List[i]) then WriteLn('**** List Item idx ', i, '; base @ nil') else try WriteLn('**** List Item idx ', i, '; base @ ', integer(List[i]), '; sizeof = ', SizeOf(List[i])); Item := List[i]; WriteLn(' IsDir: ', Item^.IsDir, ', IsLnk: ', Item^.IsLnk, ', Size: ', Item^.Size); WriteLn(' FName: ', Item^.FName); WriteLn(' LnkPointTo: ', Item^.LnkPointTo); except on E: Exception do WriteLn('(EE): Exception ', E.ClassName, ' raised: ', E.Message); end; WriteLn('** End of listing'); 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)^.FDisplayName); 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)])^.FDisplayName); 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)])^.FDisplayName); 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; 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); 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); 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 := $FFFFFFFF; 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 not 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 := $FFFFFFFF; 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 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, not 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; 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 AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); 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 AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); 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; 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 AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); 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 AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); 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; (********************************************************************************************************************************) function CreateSymlink(const FileName, PossibleNewName: string; Engine: TPanelEngine) : boolean; var AFSymLink: TFSymlink; function HandleCreateSymlink(const OldName, NewName: string): boolean; var Res, Response: integer; begin Res := Engine.MakeSymLink(NewName, OldName); Result := Res = 0; if not Result then begin try FDirDelete := TFDirDelete.Create(AFSymlink); FDirDelete.Caption := LANGDialogMakeSymlink; FDirDelete.AddButtons(2); FDirDelete.Label1.Caption := LANGTheSymbolicLink; FDirDelete.Label2.Caption := NewName; FDirDelete.Label3.Caption := Format(LANGCouldNotBeCreatedS, [GetErrorString(Res)]); FDirDelete.Label3.Visible := True; Response := Integer(FDirDelete.Run); finally FDirDelete.Free; end; case Response of 1 : Result := HandleCreateSymlink(OldName, NewName); else Result := False; end; end; end; begin Result := False; try AFSymlink := TFSymlink.Create(Application.MainForm); AFSymlink.FromEntry.Text := StrToUTF8(FileName); AFSymlink.ToEntry.Text := StrToUTF8(PossibleNewName); AFSymlink.ToEntry.SetFocus; AFSymlink.ToEntry.SelectAll; if AFSymlink.Run = mbOK then Result := HandleCreateSymlink(UTF8ToStr(AFSymlink.FromEntry.Text), ProcessPattern(Engine, UTF8ToStr(AFSymlink.ToEntry.Text), Engine.Path, '', False)); finally AFSymlink.Free; end; end; (********************************************************************************************************************************) function EditSymlink(const FileName: string; Engine: TPanelEngine) : boolean; var Data: PDataItemSL; AFSymLink: TFSymlink; function HandleEditSymlink(const ExistingName, PointTo: string): boolean; var Res, Response: integer; begin Res := Engine.Remove(ExistingName); Result := Res = 0; if not Result then begin try FDirDelete := TFDirDelete.Create(AFSymlink); FDirDelete.Caption := LANGDialogEditSymlink; FDirDelete.AddButtons(2); FDirDelete.Label1.Caption := LANGTheSymbolicLink; FDirDelete.Label2.Caption := StrToUTF8(ExistingName); FDirDelete.Label3.Caption := Format(LANGCouldNotBeDeletedS, [GetErrorString(Res)]); FDirDelete.Label3.Visible := True; Response := Integer(FDirDelete.Run); finally FDirDelete.Free; end; case Response of 1 : HandleEditSymlink(ExistingName, PointTo); end; Exit; end; Res := Engine.MakeSymLink(ExistingName, PointTo); Result := Res = 0; if not Result then begin try FDirDelete := TFDirDelete.Create(AFSymlink); FDirDelete.Caption := LANGDialogMakeSymlink; FDirDelete.AddButtons(2); FDirDelete.Label1.Caption := LANGTheSymbolicLink; FDirDelete.Label2.Caption := StrToUTF8(ExistingName); FDirDelete.Label3.Caption := Format(LANGCouldNotBeCreatedS, [GetErrorString(Res)]); FDirDelete.Label3.Visible := True; Response := Integer(FDirDelete.Run); finally FDirDelete.Free; end; case Response of 1 : Result := HandleEditSymlink(ExistingName, PointTo); else Result := False; end; end; end; begin Result := False; Data := Engine.GetFileInfoSL(FileName); try AFSymlink := TFSymlink.Create(Application); AFSymlink.Caption := LANGFEditSymlink_Caption; AFSymlink.FromEntry.Text := StrToUTF8(FileName); AFSymlink.Label1.Caption := LANGFEditSymlink_SymbolicLinkFilename; AFSymlink.Label1.UseUnderline := True; AFSymlink.Label2.Caption := LANGFEditSymlink_SymbolicLinkPointsTo; AFSymlink.Label2.UseUnderline := True; AFSymlink.FromEntry.Enabled := False; AFSymlink.ToEntry.Text := StrToUTF8(Data^.LnkPointTo); AFSymlink.ToEntry.SelectAll; if AFSymlink.Run = mbOK then Result := HandleEditSymlink(UTF8ToStr(AFSymlink.FromEntry.Text), UTF8ToStr(AFSymlink.ToEntry.Text)); finally AFSymlink.Free; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ProcessProgressThread(SenderThread: TWorkerThread; ProgressForm: TFProgress); var AFDirDelete: TFDirDelete; AFOverwrite: TFOverwrite; AFNewDir: TFNewDir; begin DebugMsg([' ** ProcessProgressThread --begin']); 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']); 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; SenderThread.FSigDialogDirDelete := 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; SenderThread.FSigDialogOverwrite := 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; SenderThread.FSigDialogNewDir := True; end; if SenderThread.FDialogShowMsgBox then begin SenderThread.FDialogResultMsgBox := Application.MessageBox(SenderThread.FMsgBoxText, SenderThread.FMsgBoxButtons, SenderThread.FMsgBoxStyle, SenderThread.FMsgBoxDefault, SenderThread.FMsgBoxEscape); SenderThread.FDialogShowMsgBox := False; SenderThread.FSigDialogMsgBox := True; end; finally 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 TWorkerThread.Execute; begin if Assigned(WorkerProcedure) then WorkerProcedure(Self); end; constructor TWorkerThread.Create; begin inherited Create(True); FreeOnTerminate := False; GUIMutex := TCriticalSection.Create; FCancelled := False; ProgressForm := nil; Engine := nil; DataList := nil; ParamPointer1 := nil; WorkerProcedure := nil; SelectedItem := nil; FDoneThread := False; FShowCancelMessage := False; FDialogShowDirDelete := False; FDialogShowOverwrite := False; FSigDialogDirDelete := False; FSigDialogOverwrite := False; FDialogShowNewDir := False; FSigDialogNewDir := False; FDialogShowMsgBox := False; FSigDialogMsgBox := False; ExtractFromVFSMode := False; ErrorHappened := False; ParamBool1 := False; ParamBool2 := False; ParamBool3 := False; ParamBool4 := False; ParamBool5 := False; FGUIChanged := False; end; destructor TWorkerThread.Destroy; begin GUIMutex.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; repeat Sleep(ConstInternalProgressTimer); until FSigDialogDirDelete; FSigDialogDirDelete := False; 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; repeat Sleep(ConstInternalProgressTimer); until FSigDialogOverwrite; FSigDialogOverwrite := False; Result := FDialogResultOverwrite; end; function TWorkerThread.ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; begin FNewDirCaption := Caption; FNewDirLabel := LabelCaption; FNewDirEdit := Edit; FDialogShowNewDir := True; repeat Sleep(ConstInternalProgressTimer); until FSigDialogNewDir; FSigDialogNewDir := False; 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; repeat Sleep(ConstInternalProgressTimer); until FSigDialogMsgBox; FSigDialogMsgBox := False; Result := FDialogResultMsgBox; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure FillDefaultFstabMounterItems; var fd: PFILE; mntent: Pmntent; MounterItem: TMounterItem; begin while MounterList.Count > 0 do begin TMounterItem(MounterList[MounterList.Count - 1]).Free; MounterList.Delete(MounterList.Count - 1); end; MounterList.Clear; fd := setmntent(_PATH_MNTTAB, 'r'); if fd = nil then Exit; // Get mount name mntent := getmntent(fd); while mntent <> nil do begin DebugMsg(['FillDefaultFstabMounterItems: found "', mntent^.mnt_dir, '" --> "', mntent^.mnt_fsname, '", fstype ', mntent^.mnt_type]); if (mntent^.mnt_dir <> '/') and (mntent^.mnt_dir <> '/boot') and (Pos('/proc', mntent^.mnt_dir) <> 1) and (Pos('/dev', mntent^.mnt_dir) <> 1) and (Pos('/sys', mntent^.mnt_dir) <> 1) and (mntent^.mnt_dir <> 'swap') and (mntent^.mnt_type <> 'swap') and (mntent^.mnt_type <> 'rpc_pipefs') and (mntent^.mnt_type <> 'none') and (mntent^.mnt_dir <> 'none') and (mntent^.mnt_dir <> '') then begin MounterItem := TMounterItem.Create; MounterItem.DisplayText := ''; MounterItem.MountPath := mntent^.mnt_dir; MounterItem.Device := mntent^.mnt_fsname; if (Pos('ISO9660', UpperCase(mntent^.mnt_type)) > 0) or (Pos('CDROM', UpperCase(mntent^.mnt_dir)) > 0) or (Pos('CDRW', UpperCase(mntent^.mnt_dir)) > 0) or (Pos('DVD', UpperCase(mntent^.mnt_dir)) > 0) then MounterItem.DeviceType := 2 else if (Pos('FLOPPY', UpperCase(mntent^.mnt_dir)) > 0) then MounterItem.DeviceType := 3 else if (Pos('ZIP', UpperCase(mntent^.mnt_type)) > 0) or (Pos('USB', UpperCase(mntent^.mnt_dir)) > 0) or (Pos('CAMERA', UpperCase(mntent^.mnt_dir)) > 0) then MounterItem.DeviceType := 1 else if (Pos('NFS', UpperCase(mntent^.mnt_type)) > 0) or (Pos('SMB', UpperCase(mntent^.mnt_type)) > 0) or (Pos('NETW', UpperCase(mntent^.mnt_dir)) > 0) then MounterItem.DeviceType := 4 else MounterItem.DeviceType := 0; MounterList.Add(MounterItem); end; mntent := getmntent(fd); end; endmntent(fd); end; function TMounterItem.Mounted: boolean; var fd: PFILE; mntent: Pmntent; begin Result := False; fd := setmntent(_PATH_MOUNTED, 'r'); if fd = nil then Exit; // Get mount name mntent := getmntent(fd); while mntent <> nil do begin // DebugMsg(['mntent^.mnt_dir = ', Int64(mntent^.mnt_dir)]); // DebugMsg(['mntent^.mnt_dir = ', mntent^.mnt_dir]); // DebugMsg(['sizeof(mntent^.mnt_dir) = ', sizeof(mntent^.mnt_dir)]); // DebugMsg(['sizeof(Tmntent) = ', sizeof(Tmntent)]); // DebugMsg(['string(mntent^.mnt_dir) = ', string(mntent^.mnt_dir)]); // DebugMsg(['MountPath = ', MountPath]); if mntent^.mnt_dir = MountPath then begin Result := True; Break; end; mntent := getmntent(fd); end; endmntent(fd); end; function TMounterItem.IsInFSTab: boolean; var fd: PFILE; mntent: Pmntent; begin Result := False; fd := setmntent(_PATH_MNTTAB, 'r'); if fd = nil then Exit; // Get mount name mntent := getmntent(fd); while mntent <> nil do begin if (mntent^.mnt_dir = MountPath) and (mntent^.mnt_fsname = Device) then begin Result := True; Break; end; mntent := getmntent(fd); end; endmntent(fd); end; function TMounterItem.Mount: boolean; var s: string; begin if Length(MountCommand) = 0 then begin if IsInFSTab then s := Format('mount "%s"', [MountPath]) else s := Format('mount "%s" "%s"', [Device, MountPath]); end else begin s := ReplaceStr(MountCommand, '%dev', Device); s := ReplaceStr(s, '%dir', MountPath); end; Result := HandleSystemCommand(s, Format(LANGErrorMount, [StrToUTF8(MountPath)])); end; function TMounterItem.Umount: boolean; var s: string; begin if Length(UmountCommand) = 0 then begin if IsInFSTab then s := Format('umount "%s"', [MountPath]) else s := Format('umount "%s" "%s"', [Device, MountPath]); end else begin s := ReplaceStr(UmountCommand, '%dev', Device); s := ReplaceStr(s, '%dir', MountPath); end; Result := HandleSystemCommand(s, Format(LANGErrorUmount, [StrToUTF8(MountPath)])); end; function TMounterItem.Eject: boolean; var s: string; begin if Length(UmountCommand) = 0 then begin if IsInFSTab then s := Format('eject "%s"', [MountPath]) else s := Format('eject "%s" "%s"', [Device, MountPath]); end else begin s := ReplaceStr(UmountCommand, '%dev', Device); s := ReplaceStr(s, '%dir', MountPath); end; Result := HandleSystemCommand(s, Format(LANGErrorEject, [StrToUTF8(MountPath)])); end; (********************************************************************************************************************************) (********************************************************************************************************************************) function HandleLogin(Parent: TComponent; Engine: TPanelEngine; UserName, Password: string): boolean; var b: boolean; begin Result := False; b := Engine.Login(UserName, Password) = cVFS_OK; if not b then repeat try FLogin := TFLogin.Create(Parent); b := FLogin.Run = mbOK; UserName := FLogin.UserEntry.Text; Password := FLogin.PasswordEntry.Text; finally FLogin.Free; end; if not b then Exit; if b then b := Engine.Login(UserName, Password) = cVFS_OK; until b; Result := True; 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; APlugin := nil; xEngine := nil; Password := ''; end; procedure TOpenDirThread.Execute; var tt: TDateTime; begin try // Writeln('execute.'); tt := Now; try // WriteLn('x1'); if APlugin <> nil then begin xEngine := TVFSEngine.Create(APlugin); xEngine.ParentEngine := AEngine; xEngine.ArchiveMode := True; AEngine.LastHighlightItem := AHighlightItem; xEngine.SavePath := AEngine.Path; AEngine := xEngine; if Length(Password) > 0 then (xEngine as TVFSEngine).Password := Password; VFSOpenResult := (xEngine as TVFSEngine).VFSOpenEx(AFullPath); end else VFSOpenResult := 0; // WriteLn('x2'); if (VFSOpenResult = 0) and (not CancelIt) then begin // WriteLn('x3'); ChDirResult := ChangeDir(AEngine, APath, ASelItem, AAutoFallBack); // WriteLn('x4'); if (ChDirResult = 0) and (not CancelIt) then begin // WriteLn('x5'); ListingResult := AEngine.GetListing(ADirList, ConfShowDotFiles); // WriteLn('x6'); end; // WriteLn('x7'); end; except on E: Exception do DebugMsg(['*** TOpenDirThread.Execute -Exception: ', E.Message]); end; RunningTime := MilliSecondsBetween(tt, Now); // WriteLn('x8'); finally Finished := True; end; { except on E: Exception do DebugMsg(['*** Exception raised in TOpenDirThread.Execute (', E.ClassName, '): ', E.Message]); end; } end; { destructor TOpenDirThread.Destroy; begin if (APlugin <> nil) and (xEngine <> nil) then try xEngine.Free; except on E: Exception do DebugMsg(['*** TOpenDirThread.Destroy -Exception: ', E.Message]); end; inherited Destroy; end; } (********************************************************************************************************************************) (********************************************************************************************************************************) function PurgeDirectory(APath: string): boolean; var Handle : PDIR; DirEnt : PDirent64; StatBuf : Pstat64; Buf : PChar; begin try Result := True; APath := IncludeTrailingPathDelimiter(APath); Handle := opendir(PChar(APath)); if not Assigned(Handle) then begin Result := False; Exit; end; repeat DirEnt := readdir64(Handle); if Assigned(DirEnt) and Assigned(PChar(@DirEnt^.d_name[0])) then begin Buf := Pchar(@DirEnt^.d_name[0]); if (Buf <> '.') and (Buf <> '..') and (DirEnt^.d_name[0] <> #0) then begin StatBuf := malloc(sizeof(Tstat64)); memset(StatBuf, 0, sizeof(Tstat64)); if lstat64(PChar(APath + string(Buf)), StatBuf) = 0 then if __S_ISTYPE(StatBuf.st_mode, __S_IFDIR) then PurgeDirectory(APath + string(Buf)) else begin // DebugMsg(['Removing ', APath + string(Buf)]); Result := Result and (libc_remove(PChar(APath + string(Buf))) = 0); end; libc_free(StatBuf); end; end; until DirEnt = nil; closedir(Handle); // DebugMsg(['Removing ', ExcludeTrailingPathDelimiter(APath)]); Result := Result and (libc_remove(PChar(ExcludeTrailingPathDelimiter(APath))) = 0); except on E: Exception do DebugMsg(['*** Exception raised in UCore.PurgeDirectory(APath = ', APath, '): ', E.ClassName, ': ', E.Message]); end; end; procedure CleanTempDirs; var i: integer; begin try if Assigned(UsedTempPaths) and (UsedTempPaths.Count > 0) then for i := 0 to UsedTempPaths.Count - 1 do DebugMsg(['(II) PurgeDirectory: Cleaning directory "', UsedTempPaths[i], '", Successfull = ', PurgeDirectory(UsedTempPaths[i])]); UsedTempPaths.Clear; except on E: Exception do DebugMsg(['*** Exception raised in UCore.CleanTempDirs (', E.ClassName, '): ', E.Message]); end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) initialization LeftPanelData := TList.Create; RightPanelData := TList.Create; LeftLocalEngine := TLocalTreeEngine.Create; RightLocalEngine := TLocalTreeEngine.Create; FMainEscPressed := False; LeftPanelTabs := TStringList.Create; RightPanelTabs := TStringList.Create; LeftTabSortIDs := TList.Create; RightTabSortIDs := TList.Create; LeftTabSortTypes := TList.Create; RightTabSortTypes := TList.Create; AssocList := TList.Create; MounterList := TList.Create; ConnectionMgrList := TList.Create; UsedTempPaths := TStringList.Create; SelectHistory := TStringList.Create; SearchHistory := TStringList.Create; finalization ClearListData(LeftPanelData); ClearListData(RightPanelData); LeftPanelTabs.Free; RightPanelTabs.Free; LeftTabSortIDs.Free; RightTabSortIDs.Free; LeftTabSortTypes.Free; RightTabSortTypes.Free; MounterList.Free; LeftPanelData.Free; RightPanelData.Free; AssocList.Free; ConnectionMgrList.Free; CleanTempDirs; UsedTempPaths.Free; SelectHistory.Free; SearchHistory.Free; end.