(* 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, gtk2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore, uVFSprototypes; // Panel utilities function FillPanel(List: TList; ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean): boolean; procedure FindNextSelected(ListView: TGTKListView; DataList: TList; var Item1, Item2: string); procedure UnselectAll(ListView: TGTKListView; DataList: TList); procedure FillDirFiles(Engine: TPanelEngine; DestList: TList; InputFiles: TStringList; DoNotRecurse, SortForStream: boolean; InaccessiblePaths: TStringList); function GetFileInfoSL(Engine: TPanelEngine; const APath: string): PDataItemSL; procedure DebugWriteListSL(List: TList); procedure DebugWriteList(List: TList); // Classic functions - don't need progress window function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; function CreateSymlink(const FileName, PossibleNewName: string; Engine: TPanelEngine) : boolean; function EditSymlink(const FileName: string; Engine: TPanelEngine) : boolean; procedure GetDirSize(AListView: TGTKListView; Engine: TPanelEngine; DataList: TList; AllItems: boolean); // Other classes procedure FillDefaultFstabMounterItems; function CRCGetInfo(FileName: string; Engine: TPanelEngine; var TargetName: string; var TargetCRC: Cardinal; var Size: Int64): boolean; function WriteCRCFile(Sender: TObject; Engine: TPanelEngine; TargetFile, SplitFileName: string; const FileSize: Int64; const FileCRC: Longword): boolean; function ComputeBlockSize(TotalSize: Int64): longint; function PurgeDirectory(APath: string): boolean; procedure CleanTempDirs; type TGetDirSizeThread = class(TThread) private FCancelled: boolean; protected procedure Execute; override; public Finished: boolean; Engine: TPanelEngine; Path: string; Result: Int64; constructor Create; procedure CancelIt; end; 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; ServiceType, Server, Username, Password, TargetDir: string; PluginID: string; // leave blank for default function GetURI(IncludePassword: boolean): string; end; {$IFDEF KYLIX} const INFINITE = Cardinal(-1); {$ENDIF} 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, SearchTextHistory: TStringList; QuickConnectHistory: TStringList; (********************************************************************************************************************************) implementation (********************************************************************************************************************************) uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, UNewDir, UFileAssoc, USymlink, UCoreClasses, URemoteWait, UMain, UGnome, UError; (********************************************************************************************************************************) 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(mtime, True, True); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 6: begin s2 := FormatDate(mtime, False, True); ColumnData[ConfColumnIDs[j] - 1] := strdup(PChar(s2)); end; 7: begin s2 := FormatDate(mtime, 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; AssignFileType(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; (********************************************************************************************************************************) procedure FindNextSelected(ListView: TGTKListView; DataList: TList; var Item1, Item2: string); var i: integer; SelCount: longint; begin SelCount := 0; Item1 := ''; Item2 := ''; if (not Assigned(ListView.Selected)) or PDataItem(ListView.Selected.Data)^.UpDir then Exit; if DataList.Count > 0 then for i := 0 to DataList.Count - 1 do with PDataItem(DataList[i])^ do if Selected and (not UpDir) then Inc(SelCount); Item1 := string(PDataItem(ListView.Selected.Data)^.FName); if (PDataItem(ListView.Selected.Data)^.Selected and (SelCount > 0)) or (SelCount = 0) then begin if ListView.ConvertToSorted(ListView.Selected.Index) < ListView.Items.Count then for i := ListView.ConvertToSorted(ListView.Selected.Index) + 1 to DataList.Count - 1 do if not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.Selected then begin Item2 := string(PDataItem(DataList[ListView.ConvertFromSorted(i)])^.FName); Break; end; if (Item2 = '') and (ListView.ConvertToSorted(ListView.Selected.Index) > 0) then for i := ListView.ConvertToSorted(ListView.Selected.Index) - 1 downto 0 do if (not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.Selected) and (not PDataItem(DataList[ListView.ConvertFromSorted(i)])^.UpDir) then begin Item2 := string(PDataItem(DataList[ListView.ConvertFromSorted(i)])^.FName); Break; end; end; end; (********************************************************************************************************************************) procedure UnselectAll(ListView: TGTKListView; DataList: TList); var i: integer; begin if DataList.Count > 0 then for i := 0 to DataList.Count - 1 do with PDataItem(DataList[i])^ do if Selected then begin Selected := False; ListView.Items[i].RedrawRow; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure FillDirFiles(Engine: TPanelEngine; DestList: TList; InputFiles: TStringList; DoNotRecurse, SortForStream: boolean; InaccessiblePaths: TStringList); var DirStage1List, FilesList, DirStage2List: TList; function FillDirFiles_compare_func(Item1, Item2: Pointer): integer; var DataItem1, DataItem2: PDataItem; begin if not SortForStream then begin DataItem1 := Item1; DataItem2 := Item2; end else begin DataItem1 := PDataItemSL(Item1)^.DataItem; DataItem2 := PDataItemSL(Item2)^.DataItem; end; // sort by inode number // also, we want to have directories at the bottom of the list if DataItem1^.IsDir and (not DataItem2^.IsDir) then Result := 1 else if (not DataItem1^.IsDir) and DataItem2^.IsDir then Result := -1 else if DataItem1^.inode_no > DataItem2^.inode_no then Result := 1 else if DataItem1^.inode_no < DataItem2^.inode_no then Result := -1 else Result := 0; end; procedure QuickSort(FList: TList; L, R : Longint); var I, J : Longint; P, Q : Pointer; begin repeat I := L; J := R; P := FList[(L + R) div 2]; repeat while FillDirFiles_compare_func(P, FList[I]) > 0 do I := I + 1; while FillDirFiles_compare_func(P, FList[J]) < 0 do J := J - 1; if I <= J then begin Q := FList[I]; Flist[I] := FList[J]; FList[J] := Q; I := I + 1; J := J - 1; end; until I > J; if L < J then QuickSort(FList, L, J); L := I; until I >= R; end; procedure FillDirFiles_sort(FList: TList); var i: integer; begin if FList.Count < 2 then Exit; writeln('before sorting:'); for i := 0 to FList.Count - 1 do writeln(' ', i, ' [', PDataItemSL(FList[i])^.DataItem^.inode_no, '] ', PDataItemSL(FList[i])^.DataItem^.FName); QuickSort(Flist, 0, FList.Count - 1); writeln('after sorting:'); for i := 0 to FList.Count - 1 do writeln(' ', i, ' [', PDataItemSL(FList[i])^.DataItem^.inode_no, '] ', PDataItemSL(FList[i])^.DataItem^.FName); end; procedure FillDirFiles_Recurse(const LocalPath: string; ALevel: integer); var LocalList: TList; i: integer; Item: PDataItem; ItemSL: PDataItemSL; ParentDir: string; Error: PGError; begin LocalList := TList.Create; Error := nil; if Engine.GetListing(LocalList, LocalPath, True, False, True, @Error) then begin if not SortForStream then FillDirFiles_sort(LocalList); for i := 0 to LocalList.Count - 1 do begin Item := LocalList[i]; ItemSL := malloc(sizeof(TDataItemSL)); memset(ItemSL, 0, sizeof(TDataItemSL)); ItemSL^.DataItem := Item; ItemSL^.Stage1 := True; ItemSL^.IsOnRO := Engine.IsOnROMedium(string(Item^.FName)); ItemSL^.Level := ALevel; if not SortForStream then DestList.Add(ItemSL) else begin if Item^.IsDir then DirStage1List.Add(ItemSL) else FilesList.Add(ItemSL); end; if Item^.IsDir then begin // Recurse to parent ParentDir := IncludeTrailingPathDelimiter(string(Item^.FName)); Error := nil; if Engine.ChangeDir(ParentDir, @Error) then FillDirFiles_Recurse(ParentDir, ALevel + 1) else begin InaccessiblePaths.Add(ParentDir); DebugMsg(['*** FillDirFiles_Recurse: error changing dir to ''', LocalPath, ''': ', Error^.message]); g_error_free(Error); end; // Add end stage ItemSL := DuplicateDataItem(ItemSL); ItemSL^.Stage1 := False; if SortForStream then DirStage2List.Add(ItemSL) else DestList.Add(ItemSL); end; end; end else begin InaccessiblePaths.Add(LocalPath); DebugMsg(['*** FillDirFiles_Recurse: error getting listing of ''', LocalPath, ''': ', Error^.message]); g_error_free(Error); // Clear remaining items (in case of error) for i := 0 to LocalList.Count - 1 do FreeDataItem(PDataItem(LocalList[i])); end; LocalList.Free; end; var root: PDataItemSL; i: integer; begin if InputFiles.Count = 0 then Exit; if SortForStream then begin DirStage1List := TList.Create; FilesList := TList.Create; DirStage2List := TList.Create; end; for i := 0 to InputFiles.Count - 1 do begin root := GetFileInfoSL(Engine, InputFiles[i]); if (root = nil) then begin InaccessiblePaths.Add(InputFiles[i]); DebugMsg(['FillDirFiles: cannot stat ', InputFiles[i]]); Exit; end; root^.Stage1 := True; root^.Level := 1; if not SortForStream then DestList.Add(root) else if not root^.DataItem^.IsDir then FilesList.Add(root); if root^.DataItem^.IsDir then begin // It's a directory, mark as starting item if SortForStream then DirStage1List.Add(root); // Recurse to child FillDirFiles_Recurse(InputFiles[i], 2); // Add ending item root := GetFileInfoSL(Engine, InputFiles[i]); root^.Stage1 := False; root^.Level := 1; if SortForStream then DirStage2List.Add(root) else DestList.Add(root); end; end; // Merge lists if SortForStream then begin FillDirFiles_sort(FilesList); if DirStage1List.Count > 0 then for i := 0 to DirStage1List.Count - 1 do DestList.Add(DirStage1List[i]); if FilesList.Count > 0 then for i := 0 to FilesList.Count - 1 do DestList.Add(FilesList[i]); if DirStage2List.Count > 0 then for i := 0 to DirStage2List.Count - 1 do DestList.Add(DirStage2List[i]); DirStage1List.Free; FilesList.Free; DirStage2List.Free; end; end; function GetFileInfoSL(Engine: TPanelEngine; const APath: string): PDataItemSL; var ItemSL: PDataItemSL; begin ItemSL := malloc(sizeof(TDataItemSL)); memset(ItemSL, 0, sizeof(TDataItemSL)); // * TODO: report errors? same way as for FillDirFiles ItemSL^.DataItem := Engine.GetFileInfo(APath, False, True, nil); ItemSL^.Stage1 := True; ItemSL^.Level := 1; Result := ItemSL; 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^.DataItem^.IsDir, ', IsLnk: ', Item^.DataItem^.IsLnk, ', ForceMove: ', Item^.ForceMove{, ', Size: ', Item^.DataItem^.Size}, ', inode: ', Item^.DataItem^.inode_no); WriteLn(' FName: ', Item^.DataItem^.FName); WriteLn(' LnkPointTo: ', Item^.DataItem^.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; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; var Error: PGError; begin Error := nil; Result := Engine.MakeDir(IncludeTrailingPathDelimiter(Engine.Path) + NewDir, @Error); if not Result then begin ShowError(FMain, Format('Error creating new directory ''%s'' in %s panel', [StrToUTF8(NewDir), LANGPanelStrings[LeftPanel]]), Error); g_error_free(Error); end; end; (********************************************************************************************************************************) function CreateSymlink(const FileName, PossibleNewName: string; Engine: TPanelEngine) : boolean; var AFSymLink: TFSymlink; function HandleCreateSymlink(const OldName, NewName: string): boolean; var Response: integer; Error: PGError; begin Error := nil; Result := Engine.MakeSymLink(NewName, OldName, @Error); if not Result then begin try FDirDelete := TFDirDelete.Create(AFSymlink); FDirDelete.Caption := LANGDialogMakeSymlink; FDirDelete.AddButtons(DIR_DELETE_SET_SYMLINK_ERROR); FDirDelete.Label1.Caption := LANGTheSymbolicLink; FDirDelete.Label2.Caption := NewName; FDirDelete.Label3.Caption := Format(LANGCouldNotBeCreatedS, [Error^.message]); FDirDelete.Label3.Visible := True; Response := Integer(FDirDelete.Run); g_error_free(Error); finally FDirDelete.Free; end; case Response of DIR_DELETE_RETRY : Result := HandleCreateSymlink(OldName, NewName); else Result := False; end; end; end; begin Result := False; try AFSymlink := TFSymlink.Create(Application.MainForm); AFSymLink.FileName := FileName; AFSymLink.PossibleNewName := PossibleNewName; AFSymlink.FromEntry.Text := StrToUTF8(FileName); AFSymlink.ToEntry.Text := StrToUTF8(PossibleNewName); AFSymlink.ToEntry.SetFocus; AFSymlink.ToEntry.SelectAll; AFSymLink.RelativeCheckButton.Checked := ConfMakeSymlinkRelative; if AFSymlink.Run = mbOK then Result := HandleCreateSymlink(UTF8ToStr(AFSymlink.FromEntry.Text), ProcessPattern(Engine, UTF8ToStr(AFSymlink.ToEntry.Text), Engine.Path, '', False)); if Result then ConfMakeSymlinkRelative := AFSymLink.RelativeCheckButton.Checked; finally AFSymlink.Free; end; end; (********************************************************************************************************************************) function EditSymlink(const FileName: string; Engine: TPanelEngine) : boolean; var Data: PDataItem; AFSymLink: TFSymlink; function HandleEditSymlink(const ExistingName, PointTo: string): boolean; var Response: integer; Error: PGError; begin Error := nil; Result := Engine.Remove(ExistingName, @Error); if not Result then begin try FDirDelete := TFDirDelete.Create(AFSymlink); FDirDelete.Caption := LANGDialogEditSymlink; FDirDelete.AddButtons(DIR_DELETE_SET_SYMLINK_ERROR); FDirDelete.Label1.Caption := LANGTheSymbolicLink; FDirDelete.Label2.Caption := StrToUTF8(ExistingName); FDirDelete.Label3.Caption := Format(LANGCouldNotBeDeletedS, [Error^.message]); FDirDelete.Label3.Visible := True; Response := Integer(FDirDelete.Run); g_error_free(Error); finally FDirDelete.Free; end; case Response of DIR_DELETE_RETRY : HandleEditSymlink(ExistingName, PointTo); end; Exit; end; Error := nil; Result := Engine.MakeSymLink(ExistingName, PointTo, @Error); if not Result then begin try FDirDelete := TFDirDelete.Create(AFSymlink); FDirDelete.Caption := LANGDialogMakeSymlink; FDirDelete.AddButtons(DIR_DELETE_SET_SYMLINK_ERROR); FDirDelete.Label1.Caption := LANGTheSymbolicLink; FDirDelete.Label2.Caption := StrToUTF8(ExistingName); FDirDelete.Label3.Caption := Format(LANGCouldNotBeCreatedS, [Error^.message]); FDirDelete.Label3.Visible := True; Response := Integer(FDirDelete.Run); g_error_free(Error); finally FDirDelete.Free; end; case Response of DIR_DELETE_RETRY : Result := HandleEditSymlink(ExistingName, PointTo); else Result := False; end; end; end; begin Result := False; Data := Engine.GetFileInfo(FileName, False, True, nil); if Data = nil then begin Result := False; Exit; end; 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; AFSymLink.RelativeCheckButton.Visible := False; if AFSymlink.Run = mbOK then Result := HandleEditSymlink(UTF8ToStr(AFSymlink.FromEntry.Text), UTF8ToStr(AFSymlink.ToEntry.Text)); finally FreeDataItem(Data); AFSymlink.Free; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure 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; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) 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; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) function CRCGetInfo(FileName: string; Engine: TPanelEngine; var TargetName: string; var TargetCRC: Cardinal; 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, Count, Start: integer; FD: TEngineFileDes; Buffer: Pointer; s: string; Error: PGError; 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; Error := nil; FD := Engine.OpenFile(FileName, omRead, @Error); if Error <> nil then begin g_error_free(nil); Exit; end; s := ''; repeat Error := nil; Count := Engine.ReadFile(FD, Buffer, CRCBlockSize, @Error); if Error <> nil then begin libc_free(Buffer); g_error_free(nil); Engine.CloseFile(FD, nil); 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, nil); libc_free(Buffer); Result := True; end; (********************************************************************************************************************************) function WriteCRCFile(Sender: TObject; Engine: TPanelEngine; TargetFile, SplitFileName: string; const FileSize: Int64; const FileCRC: Longword): boolean; var FD: TEngineFileDes; Count: integer; s: string; Error: PGError; begin Result := False; if Pos('.', TargetFile) > 1 then TargetFile := ChangeFileExt(TargetFile, '.crc') else TargetFile := TargetFile + '.crc'; Error := nil; FD := Engine.OpenFile(TargetFile, omWrite, @Error); if FD = nil then begin if Error <> nil then begin ShowError(TCustomGTKForm(Sender), Format('An error occured while opening file ''%s''', [TargetFile]), Error); g_error_free(Error); end; 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 <> nil) { or (Count <> Length(s)) } then begin ShowError(TCustomGTKForm(Sender), Format('An error occured while writing file ''%s''', [TargetFile]), Error); g_error_free(Error); Exit; end; Engine.CloseFile(FD, nil); Result := True; 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 <> nil) and (mntent^.mnt_type <> nil) and (strlen(mntent^.mnt_dir) > 0) and (strlen(mntent^.mnt_type) > 0) and (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') 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 PurgeDirectory(APath: string): boolean; var Handle : PDIR; DirEnt : PDirent64; StatBuf : Pstat64; Buf : PChar; begin Result := True; try 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; (********************************************************************************************************************************) (********************************************************************************************************************************) function TConnMgrItem.GetURI(IncludePassword: boolean): string; begin Result := ConstructURI(IncludePassword, False, ServiceType, Server, Username, Password, TargetDir); 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; SearchTextHistory := 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; SearchTextHistory.Free; end.