mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-28 10:02:14 +00:00
UPD: Split files in newdesign directory.
This commit is contained in:
cobines
parent
841dfbd336
commit
2b07ae4078
116 changed files with 9147 additions and 9046 deletions
File diff suppressed because it is too large
Load diff
|
|
@ -1,200 +1,200 @@
|
|||
unit uFileSystemCalcStatisticsOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceCalcStatisticsOperation,
|
||||
uFileSource,
|
||||
uFileSourceOperationUI,
|
||||
uFile,
|
||||
uGlobs, uLog;
|
||||
|
||||
type
|
||||
|
||||
TFileSystemCalcStatisticsOperation = class(TFileSourceCalcStatisticsOperation)
|
||||
|
||||
private
|
||||
FStatistics: TFileSourceCalcStatisticsOperationStatistics; // local copy of statistics
|
||||
|
||||
procedure ProcessFile(aFile: TFile);
|
||||
procedure ProcessLink(aFile: TFile);
|
||||
procedure ProcessSubDirs(const srcPath: String);
|
||||
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
|
||||
public
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
var theFiles: TFiles); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uFileSourceOperationOptions, uOSUtils, uLng, uFindEx,
|
||||
uFileSystemFileSource;
|
||||
|
||||
constructor TFileSystemCalcStatisticsOperation.Create(
|
||||
aTargetFileSource: IFileSource;
|
||||
var theFiles: TFiles);
|
||||
begin
|
||||
inherited Create(aTargetFileSource, theFiles);
|
||||
end;
|
||||
|
||||
destructor TFileSystemCalcStatisticsOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.Initialize;
|
||||
begin
|
||||
// Get initialized statistics; then we change only what is needed.
|
||||
FStatistics := RetrieveStatistics;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.MainExecute;
|
||||
var
|
||||
CurrentFileIndex: Integer;
|
||||
begin
|
||||
for CurrentFileIndex := 0 to Files.Count - 1 do
|
||||
begin
|
||||
ProcessFile(Files[CurrentFileIndex]);
|
||||
CheckOperationState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.ProcessFile(aFile: TFile);
|
||||
begin
|
||||
FStatistics.CurrentFile := aFile.Path + aFile.Name;
|
||||
UpdateStatistics(FStatistics);
|
||||
|
||||
if aFile.IsDirectory then
|
||||
begin
|
||||
Inc(FStatistics.Directories);
|
||||
ProcessSubDirs(aFile.Path + aFile.Name + DirectorySeparator);
|
||||
end
|
||||
else if aFile.IsLink then
|
||||
begin
|
||||
Inc(FStatistics.Links);
|
||||
|
||||
case FSymLinkOption of
|
||||
fsooslFollow:
|
||||
ProcessLink(aFile);
|
||||
fsooslDontFollow: ; // do nothing
|
||||
fsooslNone:
|
||||
begin
|
||||
case AskQuestion('', Format(rsMsgFollowSymlink, [aFile.Name]),
|
||||
[fsourYes, fsourAll, fsourNo, fsourSkipAll],
|
||||
fsourYes, fsourNo)
|
||||
of
|
||||
fsourYes:
|
||||
ProcessLink(aFile);
|
||||
fsourAll:
|
||||
begin
|
||||
FSymLinkOption := fsooslFollow;
|
||||
ProcessLink(aFile);
|
||||
end;
|
||||
fsourNo: ; // do nothing
|
||||
fsourSkipAll:
|
||||
FSymLinkOption := fsooslDontFollow;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Not always this will be regular file (on Unix can be socket, FIFO, block, char, etc.)
|
||||
// Maybe check with: FPS_ISREG() on Unix?
|
||||
|
||||
Inc(FStatistics.Files);
|
||||
FStatistics.Size := FStatistics.Size + aFile.Size;
|
||||
if aFile.ModificationTime < FStatistics.OldestFile then
|
||||
FStatistics.OldestFile := aFile.ModificationTime;
|
||||
if aFile.ModificationTime > FStatistics.NewestFile then
|
||||
FStatistics.NewestFile := aFile.ModificationTime;
|
||||
end;
|
||||
|
||||
UpdateStatistics(FStatistics);
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.ProcessLink(aFile: TFile);
|
||||
var
|
||||
PathToFile: String;
|
||||
aLinkFile: TFile = nil;
|
||||
begin
|
||||
PathToFile := mbReadAllLinks(aFile.FullPath);
|
||||
if PathToFile <> '' then
|
||||
begin
|
||||
try
|
||||
aLinkFile := TFileSystemFileSource.CreateFileFromFile(PathToFile);
|
||||
try
|
||||
ProcessFile(aLinkFile);
|
||||
finally
|
||||
FreeAndNil(aLinkFile);
|
||||
end;
|
||||
|
||||
except
|
||||
on EFileNotFound do
|
||||
begin
|
||||
LogMessage(rsMsgErrInvalidLink + ': ' + aFile.FullPath + ' -> ' + PathToFile, [log_errors], lmtError);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
LogMessage(rsMsgErrInvalidLink + ': ' + aFile.FullPath + ' -> ' + PathToFile, [log_errors], lmtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.ProcessSubDirs(const srcPath: String);
|
||||
var
|
||||
sr: TSearchRecEx;
|
||||
aFile: TFile;
|
||||
FindResult: Longint;
|
||||
begin
|
||||
FindResult := FindFirstEx(srcPath + '*', faAnyFile, sr);
|
||||
try
|
||||
if FindResult = 0 then
|
||||
repeat
|
||||
if (sr.Name='.') or (sr.Name='..') then Continue;
|
||||
|
||||
aFile := TFileSystemFileSource.CreateFile(srcPath, @sr);
|
||||
try
|
||||
ProcessFile(aFile);
|
||||
finally
|
||||
FreeAndNil(aFile);
|
||||
end;
|
||||
|
||||
CheckOperationState;
|
||||
until FindNextEx(sr) <> 0;
|
||||
|
||||
finally
|
||||
FindCloseEx(sr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
begin
|
||||
case logMsgType of
|
||||
lmtError:
|
||||
if not (log_errors in gLogOptions) then Exit;
|
||||
lmtInfo:
|
||||
if not (log_info in gLogOptions) then Exit;
|
||||
lmtSuccess:
|
||||
if not (log_success in gLogOptions) then Exit;
|
||||
end;
|
||||
|
||||
if logOptions <= gLogOptions then
|
||||
begin
|
||||
logWrite(Thread, sMessage, logMsgType);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uFileSystemCalcStatisticsOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceCalcStatisticsOperation,
|
||||
uFileSource,
|
||||
uFileSourceOperationUI,
|
||||
uFile,
|
||||
uGlobs, uLog;
|
||||
|
||||
type
|
||||
|
||||
TFileSystemCalcStatisticsOperation = class(TFileSourceCalcStatisticsOperation)
|
||||
|
||||
private
|
||||
FStatistics: TFileSourceCalcStatisticsOperationStatistics; // local copy of statistics
|
||||
|
||||
procedure ProcessFile(aFile: TFile);
|
||||
procedure ProcessLink(aFile: TFile);
|
||||
procedure ProcessSubDirs(const srcPath: String);
|
||||
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
|
||||
public
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
var theFiles: TFiles); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uFileSourceOperationOptions, uOSUtils, uLng, uFindEx,
|
||||
uFileSystemFileSource;
|
||||
|
||||
constructor TFileSystemCalcStatisticsOperation.Create(
|
||||
aTargetFileSource: IFileSource;
|
||||
var theFiles: TFiles);
|
||||
begin
|
||||
inherited Create(aTargetFileSource, theFiles);
|
||||
end;
|
||||
|
||||
destructor TFileSystemCalcStatisticsOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.Initialize;
|
||||
begin
|
||||
// Get initialized statistics; then we change only what is needed.
|
||||
FStatistics := RetrieveStatistics;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.MainExecute;
|
||||
var
|
||||
CurrentFileIndex: Integer;
|
||||
begin
|
||||
for CurrentFileIndex := 0 to Files.Count - 1 do
|
||||
begin
|
||||
ProcessFile(Files[CurrentFileIndex]);
|
||||
CheckOperationState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.ProcessFile(aFile: TFile);
|
||||
begin
|
||||
FStatistics.CurrentFile := aFile.Path + aFile.Name;
|
||||
UpdateStatistics(FStatistics);
|
||||
|
||||
if aFile.IsDirectory then
|
||||
begin
|
||||
Inc(FStatistics.Directories);
|
||||
ProcessSubDirs(aFile.Path + aFile.Name + DirectorySeparator);
|
||||
end
|
||||
else if aFile.IsLink then
|
||||
begin
|
||||
Inc(FStatistics.Links);
|
||||
|
||||
case FSymLinkOption of
|
||||
fsooslFollow:
|
||||
ProcessLink(aFile);
|
||||
fsooslDontFollow: ; // do nothing
|
||||
fsooslNone:
|
||||
begin
|
||||
case AskQuestion('', Format(rsMsgFollowSymlink, [aFile.Name]),
|
||||
[fsourYes, fsourAll, fsourNo, fsourSkipAll],
|
||||
fsourYes, fsourNo)
|
||||
of
|
||||
fsourYes:
|
||||
ProcessLink(aFile);
|
||||
fsourAll:
|
||||
begin
|
||||
FSymLinkOption := fsooslFollow;
|
||||
ProcessLink(aFile);
|
||||
end;
|
||||
fsourNo: ; // do nothing
|
||||
fsourSkipAll:
|
||||
FSymLinkOption := fsooslDontFollow;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Not always this will be regular file (on Unix can be socket, FIFO, block, char, etc.)
|
||||
// Maybe check with: FPS_ISREG() on Unix?
|
||||
|
||||
Inc(FStatistics.Files);
|
||||
FStatistics.Size := FStatistics.Size + aFile.Size;
|
||||
if aFile.ModificationTime < FStatistics.OldestFile then
|
||||
FStatistics.OldestFile := aFile.ModificationTime;
|
||||
if aFile.ModificationTime > FStatistics.NewestFile then
|
||||
FStatistics.NewestFile := aFile.ModificationTime;
|
||||
end;
|
||||
|
||||
UpdateStatistics(FStatistics);
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.ProcessLink(aFile: TFile);
|
||||
var
|
||||
PathToFile: String;
|
||||
aLinkFile: TFile = nil;
|
||||
begin
|
||||
PathToFile := mbReadAllLinks(aFile.FullPath);
|
||||
if PathToFile <> '' then
|
||||
begin
|
||||
try
|
||||
aLinkFile := TFileSystemFileSource.CreateFileFromFile(PathToFile);
|
||||
try
|
||||
ProcessFile(aLinkFile);
|
||||
finally
|
||||
FreeAndNil(aLinkFile);
|
||||
end;
|
||||
|
||||
except
|
||||
on EFileNotFound do
|
||||
begin
|
||||
LogMessage(rsMsgErrInvalidLink + ': ' + aFile.FullPath + ' -> ' + PathToFile, [log_errors], lmtError);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
LogMessage(rsMsgErrInvalidLink + ': ' + aFile.FullPath + ' -> ' + PathToFile, [log_errors], lmtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.ProcessSubDirs(const srcPath: String);
|
||||
var
|
||||
sr: TSearchRecEx;
|
||||
aFile: TFile;
|
||||
FindResult: Longint;
|
||||
begin
|
||||
FindResult := FindFirstEx(srcPath + '*', faAnyFile, sr);
|
||||
try
|
||||
if FindResult = 0 then
|
||||
repeat
|
||||
if (sr.Name='.') or (sr.Name='..') then Continue;
|
||||
|
||||
aFile := TFileSystemFileSource.CreateFile(srcPath, @sr);
|
||||
try
|
||||
ProcessFile(aFile);
|
||||
finally
|
||||
FreeAndNil(aFile);
|
||||
end;
|
||||
|
||||
CheckOperationState;
|
||||
until FindNextEx(sr) <> 0;
|
||||
|
||||
finally
|
||||
FindCloseEx(sr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCalcStatisticsOperation.LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
begin
|
||||
case logMsgType of
|
||||
lmtError:
|
||||
if not (log_errors in gLogOptions) then Exit;
|
||||
lmtInfo:
|
||||
if not (log_info in gLogOptions) then Exit;
|
||||
lmtSuccess:
|
||||
if not (log_success in gLogOptions) then Exit;
|
||||
end;
|
||||
|
||||
if logOptions <= gLogOptions then
|
||||
begin
|
||||
logWrite(Thread, sMessage, logMsgType);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -314,4 +314,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -81,4 +81,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -70,4 +70,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -323,4 +323,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -443,4 +443,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -135,4 +135,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -233,4 +233,4 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
end.
|
||||
|
|
@ -234,4 +234,4 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
end.
|
||||
|
|
@ -87,4 +87,4 @@ end;
|
|||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,152 +1,152 @@
|
|||
unit uTempFileSystemFileSource;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSystemFileSource;
|
||||
|
||||
type
|
||||
|
||||
ITempFileSystemFileSource = interface(IFileSystemFileSource)
|
||||
['{1B6CFF05-15D5-45AF-A382-9C12C1A52024}']
|
||||
|
||||
function GetDeleteOnDestroy: Boolean;
|
||||
procedure SetDeleteOnDestroy(NewDeleteOnDestroy: Boolean);
|
||||
|
||||
property DeleteOnDestroy: Boolean read GetDeleteOnDestroy write SetDeleteOnDestroy;
|
||||
property FileSystemRoot: String read GetRootDir;
|
||||
end;
|
||||
|
||||
{ TTempFileSystemFileSource }
|
||||
|
||||
{en
|
||||
Filesystem file source that stores temporary files.
|
||||
|
||||
Operations can be done like on a regular file system but all the contents
|
||||
can be deleted when the file source is destroyed, depending on DeleteOnDestroy
|
||||
property.
|
||||
}
|
||||
TTempFileSystemFileSource = class(TFileSystemFileSource, ITempFileSystemFileSource)
|
||||
|
||||
private
|
||||
FDeleteOnDestroy: Boolean;
|
||||
FTempRootDir: String;
|
||||
|
||||
function GetDeleteOnDestroy: Boolean;
|
||||
procedure SetDeleteOnDestroy(NewDeleteOnDestroy: Boolean);
|
||||
|
||||
protected
|
||||
|
||||
public
|
||||
constructor Create; override;
|
||||
constructor Create(const aPath: String); virtual; overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
class function GetFileSource: ITempFileSystemFileSource;
|
||||
|
||||
function IsPathAtRoot(Path: String): Boolean; override;
|
||||
function GetParentDir(sPath: String): String; override;
|
||||
function GetRootDir(sPath: String): String; override; overload;
|
||||
function GetRootDir: String; override; overload;
|
||||
|
||||
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
|
||||
|
||||
property DeleteOnDestroy: Boolean read FDeleteOnDestroy write FDeleteOnDestroy default True;
|
||||
property FilesystemRoot: String read FTempRootDir;
|
||||
end;
|
||||
|
||||
ETempFileSourceException = class(Exception);
|
||||
ECannotCreateTempFileSourceException = class(ETempFileSourceException);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DCOSUtils, uOSUtils, DCStrUtils, uFileProcs;
|
||||
|
||||
constructor TTempFileSystemFileSource.Create;
|
||||
begin
|
||||
Create('');
|
||||
end;
|
||||
|
||||
constructor TTempFileSystemFileSource.Create(const aPath: String);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
if (aPath <> EmptyStr) and mbDirectoryExists(aPath) then
|
||||
FTempRootDir := aPath
|
||||
else
|
||||
begin
|
||||
FTempRootDir := GetTempName(GetTempDir + '_dc');
|
||||
|
||||
if (FTempRootDir = EmptyStr) or (mbForceDirectory(FTempRootDir) = False) then
|
||||
begin
|
||||
FDeleteOnDestroy := False;
|
||||
raise ECannotCreateTempFileSourceException.Create('Cannot create temp file source');
|
||||
end;
|
||||
end;
|
||||
|
||||
FCurrentAddress := FTempRootDir;
|
||||
FDeleteOnDestroy := True;
|
||||
|
||||
FTempRootDir := IncludeTrailingPathDelimiter(FTempRootDir);
|
||||
end;
|
||||
|
||||
destructor TTempFileSystemFileSource.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
|
||||
if FDeleteOnDestroy and mbDirectoryExists(FTempRootDir) then
|
||||
begin
|
||||
DelTree(FCurrentAddress);
|
||||
mbRemoveDir(FCurrentAddress);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetDeleteOnDestroy: Boolean;
|
||||
begin
|
||||
Result := FDeleteOnDestroy;
|
||||
end;
|
||||
|
||||
procedure TTempFileSystemFileSource.SetDeleteOnDestroy(NewDeleteOnDestroy: Boolean);
|
||||
begin
|
||||
FDeleteOnDestroy := NewDeleteOnDestroy;
|
||||
end;
|
||||
|
||||
class function TTempFileSystemFileSource.GetFileSource: ITempFileSystemFileSource;
|
||||
begin
|
||||
Result := TTempFileSystemFileSource.Create;
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean;
|
||||
begin
|
||||
Result := GetDiskFreeSpace(FTempRootDir, FreeSize, TotalSize);
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.IsPathAtRoot(Path: String): Boolean;
|
||||
begin
|
||||
Result := (IncludeTrailingPathDelimiter(Path) = FTempRootDir);
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetParentDir(sPath: String): String;
|
||||
begin
|
||||
if IsPathAtRoot(sPath) then
|
||||
Result := ''
|
||||
else
|
||||
Result := DCStrUtils.GetParentDir(sPath);
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetRootDir(sPath: String): String;
|
||||
begin
|
||||
Result := FTempRootDir;
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetRootDir: String;
|
||||
begin
|
||||
Result := FTempRootDir;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uTempFileSystemFileSource;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSystemFileSource;
|
||||
|
||||
type
|
||||
|
||||
ITempFileSystemFileSource = interface(IFileSystemFileSource)
|
||||
['{1B6CFF05-15D5-45AF-A382-9C12C1A52024}']
|
||||
|
||||
function GetDeleteOnDestroy: Boolean;
|
||||
procedure SetDeleteOnDestroy(NewDeleteOnDestroy: Boolean);
|
||||
|
||||
property DeleteOnDestroy: Boolean read GetDeleteOnDestroy write SetDeleteOnDestroy;
|
||||
property FileSystemRoot: String read GetRootDir;
|
||||
end;
|
||||
|
||||
{ TTempFileSystemFileSource }
|
||||
|
||||
{en
|
||||
Filesystem file source that stores temporary files.
|
||||
|
||||
Operations can be done like on a regular file system but all the contents
|
||||
can be deleted when the file source is destroyed, depending on DeleteOnDestroy
|
||||
property.
|
||||
}
|
||||
TTempFileSystemFileSource = class(TFileSystemFileSource, ITempFileSystemFileSource)
|
||||
|
||||
private
|
||||
FDeleteOnDestroy: Boolean;
|
||||
FTempRootDir: String;
|
||||
|
||||
function GetDeleteOnDestroy: Boolean;
|
||||
procedure SetDeleteOnDestroy(NewDeleteOnDestroy: Boolean);
|
||||
|
||||
protected
|
||||
|
||||
public
|
||||
constructor Create; override;
|
||||
constructor Create(const aPath: String); virtual; overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
class function GetFileSource: ITempFileSystemFileSource;
|
||||
|
||||
function IsPathAtRoot(Path: String): Boolean; override;
|
||||
function GetParentDir(sPath: String): String; override;
|
||||
function GetRootDir(sPath: String): String; override; overload;
|
||||
function GetRootDir: String; override; overload;
|
||||
|
||||
function GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean; override;
|
||||
|
||||
property DeleteOnDestroy: Boolean read FDeleteOnDestroy write FDeleteOnDestroy default True;
|
||||
property FilesystemRoot: String read FTempRootDir;
|
||||
end;
|
||||
|
||||
ETempFileSourceException = class(Exception);
|
||||
ECannotCreateTempFileSourceException = class(ETempFileSourceException);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DCOSUtils, uOSUtils, DCStrUtils, uFileProcs;
|
||||
|
||||
constructor TTempFileSystemFileSource.Create;
|
||||
begin
|
||||
Create('');
|
||||
end;
|
||||
|
||||
constructor TTempFileSystemFileSource.Create(const aPath: String);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
if (aPath <> EmptyStr) and mbDirectoryExists(aPath) then
|
||||
FTempRootDir := aPath
|
||||
else
|
||||
begin
|
||||
FTempRootDir := GetTempName(GetTempDir + '_dc');
|
||||
|
||||
if (FTempRootDir = EmptyStr) or (mbForceDirectory(FTempRootDir) = False) then
|
||||
begin
|
||||
FDeleteOnDestroy := False;
|
||||
raise ECannotCreateTempFileSourceException.Create('Cannot create temp file source');
|
||||
end;
|
||||
end;
|
||||
|
||||
FCurrentAddress := FTempRootDir;
|
||||
FDeleteOnDestroy := True;
|
||||
|
||||
FTempRootDir := IncludeTrailingPathDelimiter(FTempRootDir);
|
||||
end;
|
||||
|
||||
destructor TTempFileSystemFileSource.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
|
||||
if FDeleteOnDestroy and mbDirectoryExists(FTempRootDir) then
|
||||
begin
|
||||
DelTree(FCurrentAddress);
|
||||
mbRemoveDir(FCurrentAddress);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetDeleteOnDestroy: Boolean;
|
||||
begin
|
||||
Result := FDeleteOnDestroy;
|
||||
end;
|
||||
|
||||
procedure TTempFileSystemFileSource.SetDeleteOnDestroy(NewDeleteOnDestroy: Boolean);
|
||||
begin
|
||||
FDeleteOnDestroy := NewDeleteOnDestroy;
|
||||
end;
|
||||
|
||||
class function TTempFileSystemFileSource.GetFileSource: ITempFileSystemFileSource;
|
||||
begin
|
||||
Result := TTempFileSystemFileSource.Create;
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetFreeSpace(Path: String; out FreeSize, TotalSize : Int64) : Boolean;
|
||||
begin
|
||||
Result := GetDiskFreeSpace(FTempRootDir, FreeSize, TotalSize);
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.IsPathAtRoot(Path: String): Boolean;
|
||||
begin
|
||||
Result := (IncludeTrailingPathDelimiter(Path) = FTempRootDir);
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetParentDir(sPath: String): String;
|
||||
begin
|
||||
if IsPathAtRoot(sPath) then
|
||||
Result := ''
|
||||
else
|
||||
Result := DCStrUtils.GetParentDir(sPath);
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetRootDir(sPath: String): String;
|
||||
begin
|
||||
Result := FTempRootDir;
|
||||
end;
|
||||
|
||||
function TTempFileSystemFileSource.GetRootDir: String;
|
||||
begin
|
||||
Result := FTempRootDir;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -1,79 +1,79 @@
|
|||
unit uArchiveFileSource;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uLocalFileSource,
|
||||
uFileSource,
|
||||
uFile,
|
||||
uFileProperty;
|
||||
|
||||
type
|
||||
|
||||
IArchiveFileSource = interface(ILocalFileSource)
|
||||
['{13A8637C-FFDF-46B0-B5B4-E7C6851C157A}']
|
||||
|
||||
{en
|
||||
Full path to the archive on the ParentFileSource.
|
||||
}
|
||||
property ArchiveFileName: String read GetCurrentAddress;
|
||||
|
||||
end;
|
||||
|
||||
TArchiveFileSource = class(TLocalFileSource, IArchiveFileSource)
|
||||
|
||||
protected
|
||||
function GetSupportedFileProperties: TFilePropertiesTypes; override;
|
||||
|
||||
public
|
||||
{en
|
||||
Creates an archive file source.
|
||||
|
||||
@param(anArchiveFileSource
|
||||
File source that stores the archive.
|
||||
Usually it will be direct-access file source, like filesystem.)
|
||||
@param(anArchiveFileName
|
||||
Full path to the archive on the ArchiveFileSource.)
|
||||
}
|
||||
constructor Create(anArchiveFileSource: IFileSource;
|
||||
anArchiveFileName: String); virtual reintroduce overload;
|
||||
|
||||
class function CreateFile(const APath: String): TFile; override;
|
||||
|
||||
property ArchiveFileName: String read GetCurrentAddress;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TArchiveFileSource.Create(anArchiveFileSource: IFileSource;
|
||||
anArchiveFileName: String);
|
||||
begin
|
||||
FCurrentAddress := anArchiveFileName;
|
||||
inherited Create;
|
||||
ParentFileSource := anArchiveFileSource;
|
||||
end;
|
||||
|
||||
class function TArchiveFileSource.CreateFile(const APath: String): TFile;
|
||||
begin
|
||||
Result := TFile.Create(APath);
|
||||
|
||||
with Result do
|
||||
begin
|
||||
SizeProperty := TFileSizeProperty.Create;
|
||||
CompressedSizeProperty := TFileCompressedSizeProperty.Create;
|
||||
AttributesProperty := TFileAttributesProperty.CreateOSAttributes;
|
||||
ModificationTimeProperty := TFileModificationDateTimeProperty.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TArchiveFileSource.GetSupportedFileProperties: TFilePropertiesTypes;
|
||||
begin
|
||||
Result := inherited GetSupportedFileProperties
|
||||
+ [fpSize, fpCompressedSize, fpAttributes, fpModificationTime];
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uArchiveFileSource;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uLocalFileSource,
|
||||
uFileSource,
|
||||
uFile,
|
||||
uFileProperty;
|
||||
|
||||
type
|
||||
|
||||
IArchiveFileSource = interface(ILocalFileSource)
|
||||
['{13A8637C-FFDF-46B0-B5B4-E7C6851C157A}']
|
||||
|
||||
{en
|
||||
Full path to the archive on the ParentFileSource.
|
||||
}
|
||||
property ArchiveFileName: String read GetCurrentAddress;
|
||||
|
||||
end;
|
||||
|
||||
TArchiveFileSource = class(TLocalFileSource, IArchiveFileSource)
|
||||
|
||||
protected
|
||||
function GetSupportedFileProperties: TFilePropertiesTypes; override;
|
||||
|
||||
public
|
||||
{en
|
||||
Creates an archive file source.
|
||||
|
||||
@param(anArchiveFileSource
|
||||
File source that stores the archive.
|
||||
Usually it will be direct-access file source, like filesystem.)
|
||||
@param(anArchiveFileName
|
||||
Full path to the archive on the ArchiveFileSource.)
|
||||
}
|
||||
constructor Create(anArchiveFileSource: IFileSource;
|
||||
anArchiveFileName: String); virtual reintroduce overload;
|
||||
|
||||
class function CreateFile(const APath: String): TFile; override;
|
||||
|
||||
property ArchiveFileName: String read GetCurrentAddress;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TArchiveFileSource.Create(anArchiveFileSource: IFileSource;
|
||||
anArchiveFileName: String);
|
||||
begin
|
||||
FCurrentAddress := anArchiveFileName;
|
||||
inherited Create;
|
||||
ParentFileSource := anArchiveFileSource;
|
||||
end;
|
||||
|
||||
class function TArchiveFileSource.CreateFile(const APath: String): TFile;
|
||||
begin
|
||||
Result := TFile.Create(APath);
|
||||
|
||||
with Result do
|
||||
begin
|
||||
SizeProperty := TFileSizeProperty.Create;
|
||||
CompressedSizeProperty := TFileCompressedSizeProperty.Create;
|
||||
AttributesProperty := TFileAttributesProperty.CreateOSAttributes;
|
||||
ModificationTimeProperty := TFileModificationDateTimeProperty.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TArchiveFileSource.GetSupportedFileProperties: TFilePropertiesTypes;
|
||||
begin
|
||||
Result := inherited GetSupportedFileProperties
|
||||
+ [fpSize, fpCompressedSize, fpAttributes, fpModificationTime];
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -1,239 +1,239 @@
|
|||
unit uArchiveFileSourceUtil;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileView,
|
||||
uFile,
|
||||
uArchiveFileSource,
|
||||
uFileSource;
|
||||
|
||||
function GetArchiveFileSource(SourceFileSource: IFileSource;
|
||||
ArchiveFile: TFile;
|
||||
ArchiveType: String = '';
|
||||
ArchiveSign: Boolean = False): IArchiveFileSource;
|
||||
|
||||
procedure TestArchive(aFileView: TFileView; aFiles: TFiles);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uShowMsg,
|
||||
uLng,
|
||||
DCStrUtils,
|
||||
uFileSourceProperty,
|
||||
uWcxArchiveFileSource,
|
||||
uMultiArchiveFileSource,
|
||||
uFileSystemFileSource,
|
||||
uTempFileSystemFileSource,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationTypes,
|
||||
uOperationsManager;
|
||||
|
||||
// Only for direct access file sources.
|
||||
function GetArchiveFileSourceDirect(SourceFileSource: IFileSource;
|
||||
ArchiveFileName: String;
|
||||
ArchiveType: String;
|
||||
ArchiveSign: Boolean = False): IArchiveFileSource;
|
||||
begin
|
||||
if not (fspDirectAccess in SourceFileSource.Properties) then
|
||||
Exit(nil);
|
||||
|
||||
if (ArchiveType = EmptyStr) and (ArchiveSign = False) then
|
||||
begin
|
||||
ArchiveType := ExtractOnlyFileExt(ArchiveFileName);
|
||||
end;
|
||||
|
||||
// Check if there is a registered WCX plugin for possible archive.
|
||||
Result := FileSourceManager.Find(TWcxArchiveFileSource, ArchiveFileName) as IArchiveFileSource;
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
if ArchiveSign then
|
||||
Result := TWcxArchiveFileSource.CreateByArchiveSign(SourceFileSource, ArchiveFileName)
|
||||
else
|
||||
Result := TWcxArchiveFileSource.CreateByArchiveType(SourceFileSource, ArchiveFileName, ArchiveType);
|
||||
end;
|
||||
// Check if there is a registered MultiArc addon for possible archive.
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
Result := FileSourceManager.Find(TMultiArchiveFileSource, ArchiveFileName) as IArchiveFileSource;
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
if ArchiveSign then
|
||||
Result := TMultiArchiveFileSource.CreateByArchiveSign(SourceFileSource, ArchiveFileName)
|
||||
else
|
||||
Result := TMultiArchiveFileSource.CreateByArchiveType(SourceFileSource, ArchiveFileName, ArchiveType);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetArchiveFileSource(SourceFileSource: IFileSource;
|
||||
ArchiveFile: TFile;
|
||||
ArchiveType: String = '';
|
||||
ArchiveSign: Boolean = False): IArchiveFileSource;
|
||||
var
|
||||
TempFS: ITempFileSystemFileSource = nil;
|
||||
Operation: TFileSourceOperation = nil;
|
||||
Files: TFiles = nil;
|
||||
LocalArchiveFile: TFile;
|
||||
begin
|
||||
if fspDirectAccess in SourceFileSource.Properties then
|
||||
begin
|
||||
Result := GetArchiveFileSourceDirect(SourceFileSource, ArchiveFile.FullPath, ArchiveType, ArchiveSign);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Result := nil;
|
||||
|
||||
if fspLinksToLocalFiles in SourceFileSource.Properties then
|
||||
begin
|
||||
LocalArchiveFile := ArchiveFile.Clone;
|
||||
try
|
||||
if SourceFileSource.GetLocalName(LocalArchiveFile) then
|
||||
begin
|
||||
TempFS := TTempFileSystemFileSource.Create(LocalArchiveFile.Path);
|
||||
// Source FileSource manages the files, not the TempFileSource.
|
||||
TempFS.DeleteOnDestroy := False;
|
||||
// The files on temp file source are valid as long as source FileSource is valid.
|
||||
TempFS.ParentFileSource := SourceFileSource;
|
||||
Result := GetArchiveFileSourceDirect(TempFS, LocalArchiveFile.FullPath, ArchiveType, ArchiveSign);
|
||||
// If not successful will try to get files through CopyOut below.
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(LocalArchiveFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
if (not Assigned(Result)) and
|
||||
(fsoCopyOut in SourceFileSource.GetOperationsTypes) then
|
||||
begin
|
||||
if (ArchiveType = EmptyStr) and (ArchiveSign = False) then
|
||||
begin
|
||||
ArchiveType := ArchiveFile.Extension;
|
||||
end;
|
||||
|
||||
// If checking by extension we don't have to unpack files yet.
|
||||
// First check if there is a registered plugin for the archive extension.
|
||||
if (not ArchiveSign) and
|
||||
(not (TWcxArchiveFileSource.CheckPluginByExt(ArchiveType) or
|
||||
TMultiArchiveFileSource.CheckAddonByExt(ArchiveType))) then
|
||||
begin
|
||||
// No registered handlers for the archive extension.
|
||||
Exit;
|
||||
end;
|
||||
// else either there is a handler for the archive extension
|
||||
// or we have to unpack files first to check
|
||||
// (if creating file source by archive signature).
|
||||
|
||||
try
|
||||
TempFS := TTempFileSystemFileSource.Create;
|
||||
Files := TFiles.Create(ArchiveFile.Path);
|
||||
Files.Add(ArchiveFile.Clone);
|
||||
|
||||
Operation := SourceFileSource.CreateCopyOutOperation(TempFS, Files, TempFS.FilesystemRoot);
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
Operation.Execute;
|
||||
|
||||
if Operation.Result = fsorFinished then
|
||||
begin
|
||||
Result := GetArchiveFileSourceDirect(
|
||||
TempFS,
|
||||
IncludeTrailingPathDelimiter(TempFS.FilesystemRoot) + ArchiveFile.Name,
|
||||
ArchiveType,
|
||||
ArchiveSign);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
TempFS := nil;
|
||||
if Assigned(Files) then
|
||||
FreeAndNil(Files);
|
||||
if Assigned(Operation) then
|
||||
FreeAndNil(Operation);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TestArchive(aFileView: TFileView; aFiles: TFiles);
|
||||
var
|
||||
I: Integer;
|
||||
FilesToTest: TFiles = nil;
|
||||
Operation: TFileSourceOperation = nil;
|
||||
ArchiveFileSource: IArchiveFileSource;
|
||||
begin
|
||||
try
|
||||
// if in archive
|
||||
if aFileView.FileSource.IsClass(TArchiveFileSource) then
|
||||
begin
|
||||
FilesToTest := aFiles.Clone;
|
||||
if fsoTestArchive in aFileView.FileSource.GetOperationsTypes then
|
||||
begin
|
||||
Operation := aFileView.FileSource.CreateTestArchiveOperation(FilesToTest);
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
// Start operation.
|
||||
OperationsManager.AddOperation(Operation);
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgNotImplemented);
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
end
|
||||
else
|
||||
// if filesystem
|
||||
if aFileView.FileSource.IsClass(TFileSystemFileSource) then
|
||||
begin
|
||||
for I := 0 to aFiles.Count - 1 do // test all selected archives
|
||||
begin
|
||||
// Check if there is a ArchiveFileSource for possible archive.
|
||||
ArchiveFileSource := GetArchiveFileSource(aFileView.FileSource, aFiles[i]);
|
||||
|
||||
if Assigned(ArchiveFileSource) then
|
||||
begin
|
||||
// Check if List and fsoTestArchive are supported.
|
||||
if [fsoList, fsoTestArchive] * ArchiveFileSource.GetOperationsTypes = [fsoList, fsoTestArchive] then
|
||||
begin
|
||||
// Get files to test.
|
||||
FilesToTest := ArchiveFileSource.GetFiles(ArchiveFileSource.GetRootDir);
|
||||
|
||||
if Assigned(FilesToTest) then
|
||||
try
|
||||
// test all files
|
||||
Operation := ArchiveFileSource.CreateTestArchiveOperation(FilesToTest);
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
// Start operation.
|
||||
OperationsManager.AddOperation(Operation);
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgNotImplemented);
|
||||
|
||||
finally
|
||||
if Assigned(FilesToTest) then
|
||||
FreeAndNil(FilesToTest);
|
||||
end;
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
end;
|
||||
// Short pause, so that all operations are not spawned at once.
|
||||
Sleep(100);
|
||||
end; // for
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
finally
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uArchiveFileSourceUtil;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileView,
|
||||
uFile,
|
||||
uArchiveFileSource,
|
||||
uFileSource;
|
||||
|
||||
function GetArchiveFileSource(SourceFileSource: IFileSource;
|
||||
ArchiveFile: TFile;
|
||||
ArchiveType: String = '';
|
||||
ArchiveSign: Boolean = False): IArchiveFileSource;
|
||||
|
||||
procedure TestArchive(aFileView: TFileView; aFiles: TFiles);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uShowMsg,
|
||||
uLng,
|
||||
DCStrUtils,
|
||||
uFileSourceProperty,
|
||||
uWcxArchiveFileSource,
|
||||
uMultiArchiveFileSource,
|
||||
uFileSystemFileSource,
|
||||
uTempFileSystemFileSource,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationTypes,
|
||||
uOperationsManager;
|
||||
|
||||
// Only for direct access file sources.
|
||||
function GetArchiveFileSourceDirect(SourceFileSource: IFileSource;
|
||||
ArchiveFileName: String;
|
||||
ArchiveType: String;
|
||||
ArchiveSign: Boolean = False): IArchiveFileSource;
|
||||
begin
|
||||
if not (fspDirectAccess in SourceFileSource.Properties) then
|
||||
Exit(nil);
|
||||
|
||||
if (ArchiveType = EmptyStr) and (ArchiveSign = False) then
|
||||
begin
|
||||
ArchiveType := ExtractOnlyFileExt(ArchiveFileName);
|
||||
end;
|
||||
|
||||
// Check if there is a registered WCX plugin for possible archive.
|
||||
Result := FileSourceManager.Find(TWcxArchiveFileSource, ArchiveFileName) as IArchiveFileSource;
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
if ArchiveSign then
|
||||
Result := TWcxArchiveFileSource.CreateByArchiveSign(SourceFileSource, ArchiveFileName)
|
||||
else
|
||||
Result := TWcxArchiveFileSource.CreateByArchiveType(SourceFileSource, ArchiveFileName, ArchiveType);
|
||||
end;
|
||||
// Check if there is a registered MultiArc addon for possible archive.
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
Result := FileSourceManager.Find(TMultiArchiveFileSource, ArchiveFileName) as IArchiveFileSource;
|
||||
if not Assigned(Result) then
|
||||
begin
|
||||
if ArchiveSign then
|
||||
Result := TMultiArchiveFileSource.CreateByArchiveSign(SourceFileSource, ArchiveFileName)
|
||||
else
|
||||
Result := TMultiArchiveFileSource.CreateByArchiveType(SourceFileSource, ArchiveFileName, ArchiveType);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetArchiveFileSource(SourceFileSource: IFileSource;
|
||||
ArchiveFile: TFile;
|
||||
ArchiveType: String = '';
|
||||
ArchiveSign: Boolean = False): IArchiveFileSource;
|
||||
var
|
||||
TempFS: ITempFileSystemFileSource = nil;
|
||||
Operation: TFileSourceOperation = nil;
|
||||
Files: TFiles = nil;
|
||||
LocalArchiveFile: TFile;
|
||||
begin
|
||||
if fspDirectAccess in SourceFileSource.Properties then
|
||||
begin
|
||||
Result := GetArchiveFileSourceDirect(SourceFileSource, ArchiveFile.FullPath, ArchiveType, ArchiveSign);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Result := nil;
|
||||
|
||||
if fspLinksToLocalFiles in SourceFileSource.Properties then
|
||||
begin
|
||||
LocalArchiveFile := ArchiveFile.Clone;
|
||||
try
|
||||
if SourceFileSource.GetLocalName(LocalArchiveFile) then
|
||||
begin
|
||||
TempFS := TTempFileSystemFileSource.Create(LocalArchiveFile.Path);
|
||||
// Source FileSource manages the files, not the TempFileSource.
|
||||
TempFS.DeleteOnDestroy := False;
|
||||
// The files on temp file source are valid as long as source FileSource is valid.
|
||||
TempFS.ParentFileSource := SourceFileSource;
|
||||
Result := GetArchiveFileSourceDirect(TempFS, LocalArchiveFile.FullPath, ArchiveType, ArchiveSign);
|
||||
// If not successful will try to get files through CopyOut below.
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(LocalArchiveFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
if (not Assigned(Result)) and
|
||||
(fsoCopyOut in SourceFileSource.GetOperationsTypes) then
|
||||
begin
|
||||
if (ArchiveType = EmptyStr) and (ArchiveSign = False) then
|
||||
begin
|
||||
ArchiveType := ArchiveFile.Extension;
|
||||
end;
|
||||
|
||||
// If checking by extension we don't have to unpack files yet.
|
||||
// First check if there is a registered plugin for the archive extension.
|
||||
if (not ArchiveSign) and
|
||||
(not (TWcxArchiveFileSource.CheckPluginByExt(ArchiveType) or
|
||||
TMultiArchiveFileSource.CheckAddonByExt(ArchiveType))) then
|
||||
begin
|
||||
// No registered handlers for the archive extension.
|
||||
Exit;
|
||||
end;
|
||||
// else either there is a handler for the archive extension
|
||||
// or we have to unpack files first to check
|
||||
// (if creating file source by archive signature).
|
||||
|
||||
try
|
||||
TempFS := TTempFileSystemFileSource.Create;
|
||||
Files := TFiles.Create(ArchiveFile.Path);
|
||||
Files.Add(ArchiveFile.Clone);
|
||||
|
||||
Operation := SourceFileSource.CreateCopyOutOperation(TempFS, Files, TempFS.FilesystemRoot);
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
Operation.Execute;
|
||||
|
||||
if Operation.Result = fsorFinished then
|
||||
begin
|
||||
Result := GetArchiveFileSourceDirect(
|
||||
TempFS,
|
||||
IncludeTrailingPathDelimiter(TempFS.FilesystemRoot) + ArchiveFile.Name,
|
||||
ArchiveType,
|
||||
ArchiveSign);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
TempFS := nil;
|
||||
if Assigned(Files) then
|
||||
FreeAndNil(Files);
|
||||
if Assigned(Operation) then
|
||||
FreeAndNil(Operation);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TestArchive(aFileView: TFileView; aFiles: TFiles);
|
||||
var
|
||||
I: Integer;
|
||||
FilesToTest: TFiles = nil;
|
||||
Operation: TFileSourceOperation = nil;
|
||||
ArchiveFileSource: IArchiveFileSource;
|
||||
begin
|
||||
try
|
||||
// if in archive
|
||||
if aFileView.FileSource.IsClass(TArchiveFileSource) then
|
||||
begin
|
||||
FilesToTest := aFiles.Clone;
|
||||
if fsoTestArchive in aFileView.FileSource.GetOperationsTypes then
|
||||
begin
|
||||
Operation := aFileView.FileSource.CreateTestArchiveOperation(FilesToTest);
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
// Start operation.
|
||||
OperationsManager.AddOperation(Operation);
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgNotImplemented);
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
end
|
||||
else
|
||||
// if filesystem
|
||||
if aFileView.FileSource.IsClass(TFileSystemFileSource) then
|
||||
begin
|
||||
for I := 0 to aFiles.Count - 1 do // test all selected archives
|
||||
begin
|
||||
// Check if there is a ArchiveFileSource for possible archive.
|
||||
ArchiveFileSource := GetArchiveFileSource(aFileView.FileSource, aFiles[i]);
|
||||
|
||||
if Assigned(ArchiveFileSource) then
|
||||
begin
|
||||
// Check if List and fsoTestArchive are supported.
|
||||
if [fsoList, fsoTestArchive] * ArchiveFileSource.GetOperationsTypes = [fsoList, fsoTestArchive] then
|
||||
begin
|
||||
// Get files to test.
|
||||
FilesToTest := ArchiveFileSource.GetFiles(ArchiveFileSource.GetRootDir);
|
||||
|
||||
if Assigned(FilesToTest) then
|
||||
try
|
||||
// test all files
|
||||
Operation := ArchiveFileSource.CreateTestArchiveOperation(FilesToTest);
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
// Start operation.
|
||||
OperationsManager.AddOperation(Operation);
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgNotImplemented);
|
||||
|
||||
finally
|
||||
if Assigned(FilesToTest) then
|
||||
FreeAndNil(FilesToTest);
|
||||
end;
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
end;
|
||||
// Short pause, so that all operations are not spawned at once.
|
||||
Sleep(100);
|
||||
end; // for
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
finally
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,115 +1,115 @@
|
|||
unit uFileSourceCreateDirectoryOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationTypes,
|
||||
uFileSource;
|
||||
|
||||
type
|
||||
|
||||
{ TFileSourceCreateDirectoryOperation }
|
||||
|
||||
TFileSourceCreateDirectoryOperation = class(TFileSourceOperation)
|
||||
|
||||
private
|
||||
FFileSource: IFileSource;
|
||||
FBasePath: String;
|
||||
FDirectoryPath: String;
|
||||
FAbsolutePath: String;
|
||||
FRelativePath: String;
|
||||
|
||||
protected
|
||||
function GetID: TFileSourceOperationType; override;
|
||||
procedure UpdateStatisticsAtStartTime; override;
|
||||
procedure DoReloadFileSources; override;
|
||||
|
||||
property BasePath: String read FBasePath;
|
||||
property DirectoryPath: String read FDirectoryPath;
|
||||
property AbsolutePath: String read FAbsolutePath;
|
||||
property RelativePath: String read FRelativePath;
|
||||
|
||||
public
|
||||
{en
|
||||
@param(aTargetFileSource
|
||||
File source where the directory should be created.)
|
||||
@param(aCurrentPath
|
||||
Absolute path to current directory where the new directory
|
||||
should be created (if its path is not absolute).)
|
||||
@param(aDirectoryPath
|
||||
Absolute or relative (to TargetFileSource.CurrentPath) path
|
||||
to a directory that should be created.)
|
||||
}
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
aCurrentPath: String;
|
||||
aDirectoryPath: String); virtual reintroduce;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
function GetDescription(Details: TFileSourceOperationDescriptionDetails): String; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DCStrUtils, uLng;
|
||||
|
||||
constructor TFileSourceCreateDirectoryOperation.Create(
|
||||
aTargetFileSource: IFileSource;
|
||||
aCurrentPath: String;
|
||||
aDirectoryPath: String);
|
||||
begin
|
||||
inherited Create(aTargetFileSource);
|
||||
|
||||
FFileSource := aTargetFileSource;
|
||||
FBasePath := aCurrentPath;
|
||||
FDirectoryPath := aDirectoryPath;
|
||||
|
||||
if FFileSource.GetPathType(FDirectoryPath) = ptAbsolute then
|
||||
begin
|
||||
FAbsolutePath := FDirectoryPath;
|
||||
FRelativePath := ExtractDirLevel(aCurrentPath, FDirectoryPath);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FAbsolutePath := aCurrentPath + FDirectoryPath;
|
||||
FRelativePath := FDirectoryPath;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TFileSourceCreateDirectoryOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFileSourceCreateDirectoryOperation.UpdateStatisticsAtStartTime;
|
||||
begin
|
||||
// empty
|
||||
end;
|
||||
|
||||
function TFileSourceCreateDirectoryOperation.GetID: TFileSourceOperationType;
|
||||
begin
|
||||
Result := fsoCreateDirectory;
|
||||
end;
|
||||
|
||||
procedure TFileSourceCreateDirectoryOperation.DoReloadFileSources;
|
||||
begin
|
||||
FFileSource.Reload(FFileSource.GetParentDir(FAbsolutePath));
|
||||
end;
|
||||
|
||||
function TFileSourceCreateDirectoryOperation.GetDescription(Details: TFileSourceOperationDescriptionDetails): String;
|
||||
begin
|
||||
case Details of
|
||||
fsoddJobAndTarget:
|
||||
Result := Format(rsOperCreatingSomeDirectory, [AbsolutePath]);
|
||||
else
|
||||
Result := rsOperCreatingDirectory;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uFileSourceCreateDirectoryOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationTypes,
|
||||
uFileSource;
|
||||
|
||||
type
|
||||
|
||||
{ TFileSourceCreateDirectoryOperation }
|
||||
|
||||
TFileSourceCreateDirectoryOperation = class(TFileSourceOperation)
|
||||
|
||||
private
|
||||
FFileSource: IFileSource;
|
||||
FBasePath: String;
|
||||
FDirectoryPath: String;
|
||||
FAbsolutePath: String;
|
||||
FRelativePath: String;
|
||||
|
||||
protected
|
||||
function GetID: TFileSourceOperationType; override;
|
||||
procedure UpdateStatisticsAtStartTime; override;
|
||||
procedure DoReloadFileSources; override;
|
||||
|
||||
property BasePath: String read FBasePath;
|
||||
property DirectoryPath: String read FDirectoryPath;
|
||||
property AbsolutePath: String read FAbsolutePath;
|
||||
property RelativePath: String read FRelativePath;
|
||||
|
||||
public
|
||||
{en
|
||||
@param(aTargetFileSource
|
||||
File source where the directory should be created.)
|
||||
@param(aCurrentPath
|
||||
Absolute path to current directory where the new directory
|
||||
should be created (if its path is not absolute).)
|
||||
@param(aDirectoryPath
|
||||
Absolute or relative (to TargetFileSource.CurrentPath) path
|
||||
to a directory that should be created.)
|
||||
}
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
aCurrentPath: String;
|
||||
aDirectoryPath: String); virtual reintroduce;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
function GetDescription(Details: TFileSourceOperationDescriptionDetails): String; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DCStrUtils, uLng;
|
||||
|
||||
constructor TFileSourceCreateDirectoryOperation.Create(
|
||||
aTargetFileSource: IFileSource;
|
||||
aCurrentPath: String;
|
||||
aDirectoryPath: String);
|
||||
begin
|
||||
inherited Create(aTargetFileSource);
|
||||
|
||||
FFileSource := aTargetFileSource;
|
||||
FBasePath := aCurrentPath;
|
||||
FDirectoryPath := aDirectoryPath;
|
||||
|
||||
if FFileSource.GetPathType(FDirectoryPath) = ptAbsolute then
|
||||
begin
|
||||
FAbsolutePath := FDirectoryPath;
|
||||
FRelativePath := ExtractDirLevel(aCurrentPath, FDirectoryPath);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FAbsolutePath := aCurrentPath + FDirectoryPath;
|
||||
FRelativePath := FDirectoryPath;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TFileSourceCreateDirectoryOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFileSourceCreateDirectoryOperation.UpdateStatisticsAtStartTime;
|
||||
begin
|
||||
// empty
|
||||
end;
|
||||
|
||||
function TFileSourceCreateDirectoryOperation.GetID: TFileSourceOperationType;
|
||||
begin
|
||||
Result := fsoCreateDirectory;
|
||||
end;
|
||||
|
||||
procedure TFileSourceCreateDirectoryOperation.DoReloadFileSources;
|
||||
begin
|
||||
FFileSource.Reload(FFileSource.GetParentDir(FAbsolutePath));
|
||||
end;
|
||||
|
||||
function TFileSourceCreateDirectoryOperation.GetDescription(Details: TFileSourceOperationDescriptionDetails): String;
|
||||
begin
|
||||
case Details of
|
||||
fsoddJobAndTarget:
|
||||
Result := Format(rsOperCreatingSomeDirectory, [AbsolutePath]);
|
||||
else
|
||||
Result := rsOperCreatingDirectory;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -1,320 +1,320 @@
|
|||
unit uFileSourceUtil;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSource, uFileView, uFile;
|
||||
|
||||
{en
|
||||
Decides what should be done when user chooses a file in a file view.
|
||||
This function may add/remove a file source from the view,
|
||||
change path, execute a file or a command, etc.
|
||||
}
|
||||
procedure ChooseFile(aFileView: TFileView; aFile: TFile);
|
||||
|
||||
{en
|
||||
Checks if choosing the given file will change to another file source,
|
||||
and adds this new file source to the view if it does.
|
||||
@returns @true if the file matched any rules and a new file source was created,
|
||||
@false otherwise, which means no action was taken.
|
||||
}
|
||||
function ChooseFileSource(aFileView: TFileView; aFile: TFile): Boolean; overload;
|
||||
|
||||
function ChooseFileSource(aFileView: TFileView; const aPath: UTF8String): Boolean; overload;
|
||||
|
||||
function ChooseArchive(aFileView: TFileView; aFile: TFile; bForce: Boolean = False): Boolean;
|
||||
|
||||
procedure ChooseSymbolicLink(aFileView: TFileView; aFile: TFile);
|
||||
|
||||
function RenameFile(aFileSource: IFileSource; const aFile: TFile;
|
||||
const NewFileName: UTF8String; Interactive: Boolean): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLProc, fFileExecuteYourSelf, uGlobs, uShellExecute, uFindEx, uDebug,
|
||||
uOSUtils, uShowMsg, uLng, uVfsModule, DCOSUtils, DCStrUtils,
|
||||
uFileSourceOperation,
|
||||
uFileSourceSetFilePropertyOperation,
|
||||
uFileSourceExecuteOperation,
|
||||
uVfsFileSource,
|
||||
uFileSystemFileSource,
|
||||
uWfxPluginFileSource,
|
||||
uArchiveFileSourceUtil,
|
||||
uFileSourceOperationTypes,
|
||||
uFileSourceOperationMessageBoxesUI,
|
||||
uFileProperty;
|
||||
|
||||
procedure ChooseFile(aFileView: TFileView; aFile: TFile);
|
||||
var
|
||||
sOpenCmd: String;
|
||||
Operation: TFileSourceExecuteOperation = nil;
|
||||
aFileCopy: TFile = nil;
|
||||
begin
|
||||
// First test for file sources.
|
||||
if ChooseFileSource(aFileView, aFile) then
|
||||
Exit;
|
||||
|
||||
// For now work only for FileSystem until temporary file system is done.
|
||||
if aFileView.FileSource.IsClass(TFileSystemFileSource) then
|
||||
begin
|
||||
//now test if exists Open command in doublecmd.ext :)
|
||||
sOpenCmd:= gExts.GetExtActionCmd(aFile, 'open');
|
||||
if (sOpenCmd<>'') then
|
||||
begin
|
||||
(*
|
||||
if Pos('{!VFS}',sOpenCmd)>0 then
|
||||
begin
|
||||
if fVFS.FindModule(sName) then
|
||||
begin
|
||||
LoadPanelVFS(pfri);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
sOpenCmd := PrepareParameter(sOpenCmd, aFile);
|
||||
if ProcessExtCommand(sOpenCmd, aFileView.CurrentPath) then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (fsoExecute in aFileView.FileSource.GetOperationsTypes) then
|
||||
try
|
||||
aFileCopy := aFile.Clone;
|
||||
Operation := aFileView.FileSource.CreateExecuteOperation(
|
||||
aFileCopy,
|
||||
aFileView.CurrentPath,
|
||||
'open') as TFileSourceExecuteOperation;
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
Operation.Execute;
|
||||
case Operation.ExecuteOperationResult of
|
||||
fseorError:
|
||||
begin
|
||||
// Show error message
|
||||
if Length(Operation.ResultString) = 0 then
|
||||
msgError(rsMsgErrEOpen)
|
||||
else
|
||||
msgError(Operation.ResultString);
|
||||
end;
|
||||
fseorYourSelf:
|
||||
begin
|
||||
// Copy out file to temp file system and execute
|
||||
if not ShowFileExecuteYourSelf(aFileView, aFile, False) then
|
||||
DCDebug('Execution error!');
|
||||
end;
|
||||
fseorWithAll:
|
||||
begin
|
||||
// Copy out all files to temp file system and execute chosen
|
||||
if not ShowFileExecuteYourSelf(aFileView, aFile, True) then
|
||||
DCDebug('Execution error!');
|
||||
end;
|
||||
fseorSymLink:
|
||||
begin
|
||||
// change directory to new path (returned in Operation.ResultString)
|
||||
DCDebug('Change directory to ', Operation.ResultString);
|
||||
with aFileView do
|
||||
begin
|
||||
if (FileSource.IsClass(TFileSystemFileSource)) or
|
||||
(mbSetCurrentDir(ExcludeTrailingPathDelimiter(Operation.ResultString)) = False) then
|
||||
begin
|
||||
// Simply change path
|
||||
CurrentPath:= Operation.ResultString;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Get a new filesystem file source
|
||||
AddFileSource(TFileSystemFileSource.GetFileSource, Operation.ResultString);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end; // case
|
||||
end; // assigned
|
||||
finally
|
||||
FreeAndNil(aFileCopy);
|
||||
FreeAndNil(Operation);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ChooseFileSource(aFileView: TFileView; aFile: TFile): Boolean;
|
||||
var
|
||||
FileSource: IFileSource;
|
||||
VfsModule: TVfsModule;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if ChooseArchive(aFileView, aFile) then
|
||||
Exit(True);
|
||||
|
||||
// Work only for TVfsFileSource.
|
||||
if aFileView.FileSource.IsClass(TVfsFileSource) then
|
||||
begin
|
||||
// Check if there is a registered WFX plugin by file system root name.
|
||||
FileSource := FileSourceManager.Find(TWfxPluginFileSource, 'wfx://' + aFile.Name);
|
||||
if not Assigned(FileSource) then
|
||||
FileSource := TWfxPluginFileSource.CreateByRootName(aFile.Name);
|
||||
|
||||
if not Assigned(FileSource) then
|
||||
begin
|
||||
// Check if there is a registered Vfs module by file system root name.
|
||||
VfsModule:= gVfsModuleList.VfsModule[aFile.Name];
|
||||
if Assigned(VfsModule) then
|
||||
begin
|
||||
FileSource := FileSourceManager.Find(VfsModule.FileSourceClass, aFile.Name);
|
||||
if not Assigned(FileSource) then
|
||||
FileSource := VfsModule.FileSourceClass.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Assigned(FileSource) then
|
||||
begin
|
||||
aFileView.AddFileSource(FileSource, FileSource.GetRootDir);
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ChooseFileSource(aFileView: TFileView; const aPath: UTF8String): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
aFileSourceClass: TFileSourceClass;
|
||||
begin
|
||||
Result:= True;
|
||||
aFileSourceClass:= gVfsModuleList.GetFileSource(aPath);
|
||||
if Assigned(aFileSourceClass) then
|
||||
begin
|
||||
// If found FileSource is same as current then simply change path
|
||||
if aFileSourceClass.ClassNameIs(aFileView.FileSource.ClassName) then
|
||||
aFileView.CurrentPath := aPath
|
||||
else
|
||||
aFileView.AddFileSource(aFileSourceClass.Create, aPath);
|
||||
end
|
||||
else
|
||||
// Search for filesystem file source in this view, and remove others.
|
||||
with aFileView do
|
||||
begin
|
||||
for I := FileSourcesCount - 1 downto 0 do
|
||||
begin
|
||||
// Search FileSource with same class name, we can not use "is"
|
||||
// operator because it also works for descendant classes
|
||||
if TFileSystemFileSource.ClassNameIs(FileSources[I].ClassName) then
|
||||
begin
|
||||
CurrentPath := aPath;
|
||||
Break;
|
||||
end
|
||||
else
|
||||
RemoveCurrentFileSource;
|
||||
end;
|
||||
|
||||
if FileSourcesCount = 0 then
|
||||
begin
|
||||
// If not found, get a new filesystem file source.
|
||||
AddFileSource(TFileSystemFileSource.GetFileSource, aPath);
|
||||
end;
|
||||
|
||||
Result:= mbSetCurrentDir(aPath);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ChooseArchive(aFileView: TFileView; aFile: TFile; bForce: Boolean): Boolean;
|
||||
var
|
||||
FileSource: IFileSource;
|
||||
begin
|
||||
// Check if there is a ArchiveFileSource for possible archive.
|
||||
FileSource := GetArchiveFileSource(aFileView.FileSource, aFile, EmptyStr, bForce);
|
||||
|
||||
if Assigned(FileSource) then
|
||||
begin
|
||||
aFileView.AddFileSource(FileSource, FileSource.GetRootDir);
|
||||
Exit(True);
|
||||
end;
|
||||
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure ChooseSymbolicLink(aFileView: TFileView; aFile: TFile);
|
||||
var
|
||||
SearchRec: TSearchRecEx;
|
||||
sPath: UTF8String;
|
||||
begin
|
||||
if not aFileView.FileSource.IsClass(TFileSystemFileSource) then
|
||||
begin
|
||||
aFileView.ChangePathToChild(aFile);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
sPath:= aFileView.CurrentPath + IncludeTrailingPathDelimiter(aFile.Name);
|
||||
try
|
||||
if FindFirstEx(sPath + AllFilesMask, faAnyFile, SearchRec) = 0 then
|
||||
begin
|
||||
with aFileView do
|
||||
CurrentPath := CurrentPath + IncludeTrailingPathDelimiter(aFile.Name);
|
||||
end
|
||||
else
|
||||
begin
|
||||
sPath:= ReadSymLink(aFile.FullPath);
|
||||
if sPath <> EmptyStr then
|
||||
aFileView.CurrentPath := IncludeTrailingPathDelimiter(GetAbsoluteFileName(aFileView.CurrentPath, sPath))
|
||||
else
|
||||
msgError(Format(rsMsgChDirFailed, [aFile.FullPath]));
|
||||
end;
|
||||
finally
|
||||
FindCloseEx(SearchRec);
|
||||
end;
|
||||
end;
|
||||
|
||||
function RenameFile(aFileSource: IFileSource; const aFile: TFile;
|
||||
const NewFileName: UTF8String; Interactive: Boolean): Boolean;
|
||||
var
|
||||
aFiles: TFiles = nil;
|
||||
Operation: TFileSourceSetFilePropertyOperation = nil;
|
||||
NewProperties: TFileProperties;
|
||||
UserInterface: TFileSourceOperationMessageBoxesUI = nil;
|
||||
begin
|
||||
Result:= False;
|
||||
|
||||
if fsoSetFileProperty in aFileSource.GetOperationsTypes then
|
||||
begin
|
||||
FillByte(NewProperties, SizeOf(NewProperties), 0);
|
||||
NewProperties[fpName] := TFileNameProperty.Create(NewFileName);
|
||||
try
|
||||
aFiles := TFiles.Create(aFile.Path);
|
||||
aFiles.Add(aFile.Clone);
|
||||
|
||||
Operation := aFileSource.CreateSetFilePropertyOperation(
|
||||
aFiles,
|
||||
NewProperties) as TFileSourceSetFilePropertyOperation;
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
// Only if the operation can change file name.
|
||||
if fpName in Operation.SupportedProperties then
|
||||
begin
|
||||
Operation.SkipErrors := not Interactive;
|
||||
|
||||
if Interactive then
|
||||
begin
|
||||
UserInterface := TFileSourceOperationMessageBoxesUI.Create;
|
||||
Operation.AddUserInterface(UserInterface);
|
||||
end;
|
||||
|
||||
Operation.Execute;
|
||||
Result := (Operation.Result = fsorFinished);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeThenNil(NewProperties[fpName]);
|
||||
FreeThenNil(Operation);
|
||||
FreeThenNil(UserInterface);
|
||||
FreeThenNil(aFiles);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uFileSourceUtil;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSource, uFileView, uFile;
|
||||
|
||||
{en
|
||||
Decides what should be done when user chooses a file in a file view.
|
||||
This function may add/remove a file source from the view,
|
||||
change path, execute a file or a command, etc.
|
||||
}
|
||||
procedure ChooseFile(aFileView: TFileView; aFile: TFile);
|
||||
|
||||
{en
|
||||
Checks if choosing the given file will change to another file source,
|
||||
and adds this new file source to the view if it does.
|
||||
@returns @true if the file matched any rules and a new file source was created,
|
||||
@false otherwise, which means no action was taken.
|
||||
}
|
||||
function ChooseFileSource(aFileView: TFileView; aFile: TFile): Boolean; overload;
|
||||
|
||||
function ChooseFileSource(aFileView: TFileView; const aPath: UTF8String): Boolean; overload;
|
||||
|
||||
function ChooseArchive(aFileView: TFileView; aFile: TFile; bForce: Boolean = False): Boolean;
|
||||
|
||||
procedure ChooseSymbolicLink(aFileView: TFileView; aFile: TFile);
|
||||
|
||||
function RenameFile(aFileSource: IFileSource; const aFile: TFile;
|
||||
const NewFileName: UTF8String; Interactive: Boolean): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLProc, fFileExecuteYourSelf, uGlobs, uShellExecute, uFindEx, uDebug,
|
||||
uOSUtils, uShowMsg, uLng, uVfsModule, DCOSUtils, DCStrUtils,
|
||||
uFileSourceOperation,
|
||||
uFileSourceSetFilePropertyOperation,
|
||||
uFileSourceExecuteOperation,
|
||||
uVfsFileSource,
|
||||
uFileSystemFileSource,
|
||||
uWfxPluginFileSource,
|
||||
uArchiveFileSourceUtil,
|
||||
uFileSourceOperationTypes,
|
||||
uFileSourceOperationMessageBoxesUI,
|
||||
uFileProperty;
|
||||
|
||||
procedure ChooseFile(aFileView: TFileView; aFile: TFile);
|
||||
var
|
||||
sOpenCmd: String;
|
||||
Operation: TFileSourceExecuteOperation = nil;
|
||||
aFileCopy: TFile = nil;
|
||||
begin
|
||||
// First test for file sources.
|
||||
if ChooseFileSource(aFileView, aFile) then
|
||||
Exit;
|
||||
|
||||
// For now work only for FileSystem until temporary file system is done.
|
||||
if aFileView.FileSource.IsClass(TFileSystemFileSource) then
|
||||
begin
|
||||
//now test if exists Open command in doublecmd.ext :)
|
||||
sOpenCmd:= gExts.GetExtActionCmd(aFile, 'open');
|
||||
if (sOpenCmd<>'') then
|
||||
begin
|
||||
(*
|
||||
if Pos('{!VFS}',sOpenCmd)>0 then
|
||||
begin
|
||||
if fVFS.FindModule(sName) then
|
||||
begin
|
||||
LoadPanelVFS(pfri);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
sOpenCmd := PrepareParameter(sOpenCmd, aFile);
|
||||
if ProcessExtCommand(sOpenCmd, aFileView.CurrentPath) then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (fsoExecute in aFileView.FileSource.GetOperationsTypes) then
|
||||
try
|
||||
aFileCopy := aFile.Clone;
|
||||
Operation := aFileView.FileSource.CreateExecuteOperation(
|
||||
aFileCopy,
|
||||
aFileView.CurrentPath,
|
||||
'open') as TFileSourceExecuteOperation;
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
Operation.Execute;
|
||||
case Operation.ExecuteOperationResult of
|
||||
fseorError:
|
||||
begin
|
||||
// Show error message
|
||||
if Length(Operation.ResultString) = 0 then
|
||||
msgError(rsMsgErrEOpen)
|
||||
else
|
||||
msgError(Operation.ResultString);
|
||||
end;
|
||||
fseorYourSelf:
|
||||
begin
|
||||
// Copy out file to temp file system and execute
|
||||
if not ShowFileExecuteYourSelf(aFileView, aFile, False) then
|
||||
DCDebug('Execution error!');
|
||||
end;
|
||||
fseorWithAll:
|
||||
begin
|
||||
// Copy out all files to temp file system and execute chosen
|
||||
if not ShowFileExecuteYourSelf(aFileView, aFile, True) then
|
||||
DCDebug('Execution error!');
|
||||
end;
|
||||
fseorSymLink:
|
||||
begin
|
||||
// change directory to new path (returned in Operation.ResultString)
|
||||
DCDebug('Change directory to ', Operation.ResultString);
|
||||
with aFileView do
|
||||
begin
|
||||
if (FileSource.IsClass(TFileSystemFileSource)) or
|
||||
(mbSetCurrentDir(ExcludeTrailingPathDelimiter(Operation.ResultString)) = False) then
|
||||
begin
|
||||
// Simply change path
|
||||
CurrentPath:= Operation.ResultString;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Get a new filesystem file source
|
||||
AddFileSource(TFileSystemFileSource.GetFileSource, Operation.ResultString);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end; // case
|
||||
end; // assigned
|
||||
finally
|
||||
FreeAndNil(aFileCopy);
|
||||
FreeAndNil(Operation);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ChooseFileSource(aFileView: TFileView; aFile: TFile): Boolean;
|
||||
var
|
||||
FileSource: IFileSource;
|
||||
VfsModule: TVfsModule;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if ChooseArchive(aFileView, aFile) then
|
||||
Exit(True);
|
||||
|
||||
// Work only for TVfsFileSource.
|
||||
if aFileView.FileSource.IsClass(TVfsFileSource) then
|
||||
begin
|
||||
// Check if there is a registered WFX plugin by file system root name.
|
||||
FileSource := FileSourceManager.Find(TWfxPluginFileSource, 'wfx://' + aFile.Name);
|
||||
if not Assigned(FileSource) then
|
||||
FileSource := TWfxPluginFileSource.CreateByRootName(aFile.Name);
|
||||
|
||||
if not Assigned(FileSource) then
|
||||
begin
|
||||
// Check if there is a registered Vfs module by file system root name.
|
||||
VfsModule:= gVfsModuleList.VfsModule[aFile.Name];
|
||||
if Assigned(VfsModule) then
|
||||
begin
|
||||
FileSource := FileSourceManager.Find(VfsModule.FileSourceClass, aFile.Name);
|
||||
if not Assigned(FileSource) then
|
||||
FileSource := VfsModule.FileSourceClass.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Assigned(FileSource) then
|
||||
begin
|
||||
aFileView.AddFileSource(FileSource, FileSource.GetRootDir);
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ChooseFileSource(aFileView: TFileView; const aPath: UTF8String): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
aFileSourceClass: TFileSourceClass;
|
||||
begin
|
||||
Result:= True;
|
||||
aFileSourceClass:= gVfsModuleList.GetFileSource(aPath);
|
||||
if Assigned(aFileSourceClass) then
|
||||
begin
|
||||
// If found FileSource is same as current then simply change path
|
||||
if aFileSourceClass.ClassNameIs(aFileView.FileSource.ClassName) then
|
||||
aFileView.CurrentPath := aPath
|
||||
else
|
||||
aFileView.AddFileSource(aFileSourceClass.Create, aPath);
|
||||
end
|
||||
else
|
||||
// Search for filesystem file source in this view, and remove others.
|
||||
with aFileView do
|
||||
begin
|
||||
for I := FileSourcesCount - 1 downto 0 do
|
||||
begin
|
||||
// Search FileSource with same class name, we can not use "is"
|
||||
// operator because it also works for descendant classes
|
||||
if TFileSystemFileSource.ClassNameIs(FileSources[I].ClassName) then
|
||||
begin
|
||||
CurrentPath := aPath;
|
||||
Break;
|
||||
end
|
||||
else
|
||||
RemoveCurrentFileSource;
|
||||
end;
|
||||
|
||||
if FileSourcesCount = 0 then
|
||||
begin
|
||||
// If not found, get a new filesystem file source.
|
||||
AddFileSource(TFileSystemFileSource.GetFileSource, aPath);
|
||||
end;
|
||||
|
||||
Result:= mbSetCurrentDir(aPath);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ChooseArchive(aFileView: TFileView; aFile: TFile; bForce: Boolean): Boolean;
|
||||
var
|
||||
FileSource: IFileSource;
|
||||
begin
|
||||
// Check if there is a ArchiveFileSource for possible archive.
|
||||
FileSource := GetArchiveFileSource(aFileView.FileSource, aFile, EmptyStr, bForce);
|
||||
|
||||
if Assigned(FileSource) then
|
||||
begin
|
||||
aFileView.AddFileSource(FileSource, FileSource.GetRootDir);
|
||||
Exit(True);
|
||||
end;
|
||||
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure ChooseSymbolicLink(aFileView: TFileView; aFile: TFile);
|
||||
var
|
||||
SearchRec: TSearchRecEx;
|
||||
sPath: UTF8String;
|
||||
begin
|
||||
if not aFileView.FileSource.IsClass(TFileSystemFileSource) then
|
||||
begin
|
||||
aFileView.ChangePathToChild(aFile);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
sPath:= aFileView.CurrentPath + IncludeTrailingPathDelimiter(aFile.Name);
|
||||
try
|
||||
if FindFirstEx(sPath + AllFilesMask, faAnyFile, SearchRec) = 0 then
|
||||
begin
|
||||
with aFileView do
|
||||
CurrentPath := CurrentPath + IncludeTrailingPathDelimiter(aFile.Name);
|
||||
end
|
||||
else
|
||||
begin
|
||||
sPath:= ReadSymLink(aFile.FullPath);
|
||||
if sPath <> EmptyStr then
|
||||
aFileView.CurrentPath := IncludeTrailingPathDelimiter(GetAbsoluteFileName(aFileView.CurrentPath, sPath))
|
||||
else
|
||||
msgError(Format(rsMsgChDirFailed, [aFile.FullPath]));
|
||||
end;
|
||||
finally
|
||||
FindCloseEx(SearchRec);
|
||||
end;
|
||||
end;
|
||||
|
||||
function RenameFile(aFileSource: IFileSource; const aFile: TFile;
|
||||
const NewFileName: UTF8String; Interactive: Boolean): Boolean;
|
||||
var
|
||||
aFiles: TFiles = nil;
|
||||
Operation: TFileSourceSetFilePropertyOperation = nil;
|
||||
NewProperties: TFileProperties;
|
||||
UserInterface: TFileSourceOperationMessageBoxesUI = nil;
|
||||
begin
|
||||
Result:= False;
|
||||
|
||||
if fsoSetFileProperty in aFileSource.GetOperationsTypes then
|
||||
begin
|
||||
FillByte(NewProperties, SizeOf(NewProperties), 0);
|
||||
NewProperties[fpName] := TFileNameProperty.Create(NewFileName);
|
||||
try
|
||||
aFiles := TFiles.Create(aFile.Path);
|
||||
aFiles.Add(aFile.Clone);
|
||||
|
||||
Operation := aFileSource.CreateSetFilePropertyOperation(
|
||||
aFiles,
|
||||
NewProperties) as TFileSourceSetFilePropertyOperation;
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
// Only if the operation can change file name.
|
||||
if fpName in Operation.SupportedProperties then
|
||||
begin
|
||||
Operation.SkipErrors := not Interactive;
|
||||
|
||||
if Interactive then
|
||||
begin
|
||||
UserInterface := TFileSourceOperationMessageBoxesUI.Create;
|
||||
Operation.AddUserInterface(UserInterface);
|
||||
end;
|
||||
|
||||
Operation.Execute;
|
||||
Result := (Operation.Result = fsorFinished);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeThenNil(NewProperties[fpName]);
|
||||
FreeThenNil(Operation);
|
||||
FreeThenNil(UserInterface);
|
||||
FreeThenNil(aFiles);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -130,4 +130,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
|
@ -305,4 +305,4 @@ begin
|
|||
WcxDeleteOperation := nil;
|
||||
end;
|
||||
|
||||
end.
|
||||
end.
|
||||
|
|
@ -352,4 +352,4 @@ begin
|
|||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1,320 +1,320 @@
|
|||
unit uFileViewHeader;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, ExtCtrls, ComCtrls,
|
||||
uPathLabel, uFileView, KASPathEdit;
|
||||
|
||||
type
|
||||
|
||||
{ TFileViewHeader }
|
||||
|
||||
TFileViewHeader = class(TPanel)
|
||||
private
|
||||
FFileView: TFileView;
|
||||
FAddressLabel: TPathLabel;
|
||||
FPathLabel: TPathLabel;
|
||||
FPathEdit: TKASPathEdit;
|
||||
procedure HeaderResize(Sender: TObject);
|
||||
procedure PathEditExit(Sender: TObject);
|
||||
procedure PathEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure PathLabelClick(Sender: TObject);
|
||||
procedure PathLabelMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
public
|
||||
constructor Create(AOwner: TFileView; AParent: TWinControl); reintroduce;
|
||||
|
||||
procedure UpdateAddressLabel;
|
||||
procedure UpdatePathLabel;
|
||||
|
||||
procedure ShowPathEdit;
|
||||
procedure SetActive(bActive: Boolean);
|
||||
end;
|
||||
|
||||
{ TBriefHeaderControl }
|
||||
|
||||
TBriefHeaderControl = class(THeaderControl)
|
||||
private
|
||||
FDown: Boolean;
|
||||
FMouseInControl: Boolean;
|
||||
FSelectedSection: Integer;
|
||||
procedure UpdateState;
|
||||
protected
|
||||
procedure Click; override;
|
||||
procedure MouseEnter; override;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLType, ShellCtrls, uDCUtils, DCOSUtils, DCStrUtils,
|
||||
fMain, uFileSourceUtil;
|
||||
|
||||
{ TFileViewHeader }
|
||||
|
||||
procedure TFileViewHeader.PathEditExit(Sender: TObject);
|
||||
begin
|
||||
FPathEdit.Visible := False;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.PathEditKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
var
|
||||
NewPath: UTF8String;
|
||||
begin
|
||||
case Key of
|
||||
VK_ESCAPE:
|
||||
begin
|
||||
Key := 0;
|
||||
FPathEdit.Visible:=False;
|
||||
FFileView.SetFocus;
|
||||
end;
|
||||
|
||||
VK_RETURN,
|
||||
VK_SELECT:
|
||||
begin
|
||||
Key := 0; // catch the enter
|
||||
NewPath:= NormalizePathDelimiters(FPathEdit.Text);
|
||||
NewPath:= ReplaceEnvVars(ReplaceTilde(NewPath));
|
||||
if not mbFileExists(NewPath) then
|
||||
ChooseFileSource(FFileView, NewPath)
|
||||
else
|
||||
begin
|
||||
ChooseFileSource(FFileView, ExtractFileDir(NewPath));
|
||||
FFileView.SetActiveFile(ExtractFileName(NewPath));
|
||||
end;
|
||||
FPathEdit.Visible := False;
|
||||
FFileView.SetFocus;
|
||||
end;
|
||||
|
||||
{$IFDEF LCLGTK2}
|
||||
// Workaround for GTK2 - up and down arrows moving through controls.
|
||||
VK_UP,
|
||||
VK_DOWN:
|
||||
Key := 0;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.PathLabelClick(Sender: TObject);
|
||||
var
|
||||
walkPath, dirNameToSelect: UTF8String;
|
||||
begin
|
||||
FFileView.SetFocus;
|
||||
|
||||
if FPathLabel.SelectedDir <> '' then
|
||||
begin
|
||||
// User clicked on a subdirectory of the path.
|
||||
walkPath := FFileView.CurrentPath;
|
||||
FFileView.CurrentPath := FPathLabel.SelectedDir;
|
||||
|
||||
while (Length(walkPath) > Length(FPathLabel.SelectedDir) + 1) do
|
||||
begin
|
||||
dirNameToSelect := ExtractFileName(ExcludeTrailingPathDelimiter(walkPath));
|
||||
walkPath := FFileView.FileSource.GetParentDir(walkPath);
|
||||
end;
|
||||
FFileView.SetActiveFile(dirNameToSelect);
|
||||
end
|
||||
else
|
||||
frmMain.Commands.cm_ViewHistory([]);
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.PathLabelMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
case Button of
|
||||
mbMiddle:
|
||||
begin
|
||||
FFileView.SetFocus;
|
||||
frmMain.Commands.cm_DirHotList([]);
|
||||
end;
|
||||
|
||||
mbRight:
|
||||
begin
|
||||
ShowPathEdit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFileViewHeader.Create(AOwner: TFileView; AParent: TWinControl);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
FFileView:= AOwner;
|
||||
Parent:= AParent;
|
||||
Align:= alTop;
|
||||
BevelInner:= bvNone;
|
||||
BevelOuter:= bvNone;
|
||||
AutoSize:= True;
|
||||
|
||||
FAddressLabel := TPathLabel.Create(Self, False);
|
||||
FAddressLabel.Parent := Self;
|
||||
FAddressLabel.BorderSpacing.Bottom := 1;
|
||||
|
||||
FPathLabel := TPathLabel.Create(Self, True);
|
||||
FPathLabel.Parent := Self;
|
||||
|
||||
// Display path below address.
|
||||
// For correct alignment, first put path at the top, then address at the top.
|
||||
FPathLabel.Align := alTop;
|
||||
FAddressLabel.Align := alTop;
|
||||
|
||||
FPathEdit:= TKASPathEdit.Create(FPathLabel);
|
||||
FPathEdit.Parent:= Self;
|
||||
FPathEdit.Visible:= False;
|
||||
FPathEdit.TabStop:= False;
|
||||
FPathEdit.ObjectTypes:= [otFolders, otHidden];
|
||||
|
||||
OnResize:= @HeaderResize;
|
||||
|
||||
FPathEdit.OnExit:= @PathEditExit;
|
||||
FPathEdit.OnKeyDown:= @PathEditKeyDown;
|
||||
|
||||
FPathLabel.OnClick := @PathLabelClick;
|
||||
FPathLabel.OnMouseUp := @PathLabelMouseUp;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.HeaderResize(Sender: TObject);
|
||||
begin
|
||||
UpdateAddressLabel;
|
||||
UpdatePathLabel;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.UpdateAddressLabel;
|
||||
begin
|
||||
if FFileView.CurrentAddress = '' then
|
||||
begin
|
||||
FAddressLabel.Visible := False;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FAddressLabel.Top:= 0;
|
||||
FAddressLabel.Visible := True;
|
||||
FAddressLabel.Caption := FFileView.CurrentAddress;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.UpdatePathLabel;
|
||||
begin
|
||||
FPathLabel.Caption := MinimizeFilePath(FFileView.CurrentPath, FPathLabel.Canvas, FPathLabel.Width);
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.ShowPathEdit;
|
||||
begin
|
||||
with FPathLabel do
|
||||
begin
|
||||
FPathEdit.SetBounds(Left, Top, Width, Height);
|
||||
FPathEdit.Text := FFileView.CurrentPath;
|
||||
FPathEdit.Visible := True;
|
||||
FPathEdit.SetFocus;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.SetActive(bActive: Boolean);
|
||||
begin
|
||||
FAddressLabel.SetActive(bActive);
|
||||
FPathLabel.SetActive(bActive);
|
||||
end;
|
||||
|
||||
{ TBriefHeaderControl }
|
||||
|
||||
procedure TBriefHeaderControl.UpdateState;
|
||||
var
|
||||
i, Index: Integer;
|
||||
MaxState: THeaderSectionState;
|
||||
P: TPoint;
|
||||
begin
|
||||
MaxState := hsNormal;
|
||||
if Enabled then
|
||||
if FDown then
|
||||
begin
|
||||
MaxState := hsPressed;
|
||||
Index := FSelectedSection;
|
||||
end else if FMouseInControl then
|
||||
begin
|
||||
MaxState := hsHot;
|
||||
P := ScreenToClient(Mouse.CursorPos);
|
||||
Index := GetSectionAt(P);
|
||||
end;
|
||||
|
||||
for i := 0 to Sections.Count - 1 do
|
||||
if (i <> Index) then
|
||||
Sections[i].State := hsNormal
|
||||
else
|
||||
Sections[i].State := MaxState;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.Click;
|
||||
var
|
||||
Index: Integer;
|
||||
begin
|
||||
if FDown then
|
||||
begin
|
||||
inherited Click;
|
||||
Index := GetSectionAt(ScreenToClient(Mouse.CursorPos));
|
||||
if Index <> -1 then
|
||||
SectionClick(Sections[Index]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseEnter;
|
||||
begin
|
||||
inherited MouseEnter;
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FMouseInControl := True;
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseLeave;
|
||||
begin
|
||||
inherited MouseLeave;
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FMouseInControl := False;
|
||||
FDown := False;
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseDown(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FDown:= True;
|
||||
FSelectedSection:=GetSectionAt(Point(X, Y));
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FDown:= False;
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit uFileViewHeader;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, ExtCtrls, ComCtrls,
|
||||
uPathLabel, uFileView, KASPathEdit;
|
||||
|
||||
type
|
||||
|
||||
{ TFileViewHeader }
|
||||
|
||||
TFileViewHeader = class(TPanel)
|
||||
private
|
||||
FFileView: TFileView;
|
||||
FAddressLabel: TPathLabel;
|
||||
FPathLabel: TPathLabel;
|
||||
FPathEdit: TKASPathEdit;
|
||||
procedure HeaderResize(Sender: TObject);
|
||||
procedure PathEditExit(Sender: TObject);
|
||||
procedure PathEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure PathLabelClick(Sender: TObject);
|
||||
procedure PathLabelMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
public
|
||||
constructor Create(AOwner: TFileView; AParent: TWinControl); reintroduce;
|
||||
|
||||
procedure UpdateAddressLabel;
|
||||
procedure UpdatePathLabel;
|
||||
|
||||
procedure ShowPathEdit;
|
||||
procedure SetActive(bActive: Boolean);
|
||||
end;
|
||||
|
||||
{ TBriefHeaderControl }
|
||||
|
||||
TBriefHeaderControl = class(THeaderControl)
|
||||
private
|
||||
FDown: Boolean;
|
||||
FMouseInControl: Boolean;
|
||||
FSelectedSection: Integer;
|
||||
procedure UpdateState;
|
||||
protected
|
||||
procedure Click; override;
|
||||
procedure MouseEnter; override;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLType, ShellCtrls, uDCUtils, DCOSUtils, DCStrUtils,
|
||||
fMain, uFileSourceUtil;
|
||||
|
||||
{ TFileViewHeader }
|
||||
|
||||
procedure TFileViewHeader.PathEditExit(Sender: TObject);
|
||||
begin
|
||||
FPathEdit.Visible := False;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.PathEditKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
var
|
||||
NewPath: UTF8String;
|
||||
begin
|
||||
case Key of
|
||||
VK_ESCAPE:
|
||||
begin
|
||||
Key := 0;
|
||||
FPathEdit.Visible:=False;
|
||||
FFileView.SetFocus;
|
||||
end;
|
||||
|
||||
VK_RETURN,
|
||||
VK_SELECT:
|
||||
begin
|
||||
Key := 0; // catch the enter
|
||||
NewPath:= NormalizePathDelimiters(FPathEdit.Text);
|
||||
NewPath:= ReplaceEnvVars(ReplaceTilde(NewPath));
|
||||
if not mbFileExists(NewPath) then
|
||||
ChooseFileSource(FFileView, NewPath)
|
||||
else
|
||||
begin
|
||||
ChooseFileSource(FFileView, ExtractFileDir(NewPath));
|
||||
FFileView.SetActiveFile(ExtractFileName(NewPath));
|
||||
end;
|
||||
FPathEdit.Visible := False;
|
||||
FFileView.SetFocus;
|
||||
end;
|
||||
|
||||
{$IFDEF LCLGTK2}
|
||||
// Workaround for GTK2 - up and down arrows moving through controls.
|
||||
VK_UP,
|
||||
VK_DOWN:
|
||||
Key := 0;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.PathLabelClick(Sender: TObject);
|
||||
var
|
||||
walkPath, dirNameToSelect: UTF8String;
|
||||
begin
|
||||
FFileView.SetFocus;
|
||||
|
||||
if FPathLabel.SelectedDir <> '' then
|
||||
begin
|
||||
// User clicked on a subdirectory of the path.
|
||||
walkPath := FFileView.CurrentPath;
|
||||
FFileView.CurrentPath := FPathLabel.SelectedDir;
|
||||
|
||||
while (Length(walkPath) > Length(FPathLabel.SelectedDir) + 1) do
|
||||
begin
|
||||
dirNameToSelect := ExtractFileName(ExcludeTrailingPathDelimiter(walkPath));
|
||||
walkPath := FFileView.FileSource.GetParentDir(walkPath);
|
||||
end;
|
||||
FFileView.SetActiveFile(dirNameToSelect);
|
||||
end
|
||||
else
|
||||
frmMain.Commands.cm_ViewHistory([]);
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.PathLabelMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
case Button of
|
||||
mbMiddle:
|
||||
begin
|
||||
FFileView.SetFocus;
|
||||
frmMain.Commands.cm_DirHotList([]);
|
||||
end;
|
||||
|
||||
mbRight:
|
||||
begin
|
||||
ShowPathEdit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFileViewHeader.Create(AOwner: TFileView; AParent: TWinControl);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
FFileView:= AOwner;
|
||||
Parent:= AParent;
|
||||
Align:= alTop;
|
||||
BevelInner:= bvNone;
|
||||
BevelOuter:= bvNone;
|
||||
AutoSize:= True;
|
||||
|
||||
FAddressLabel := TPathLabel.Create(Self, False);
|
||||
FAddressLabel.Parent := Self;
|
||||
FAddressLabel.BorderSpacing.Bottom := 1;
|
||||
|
||||
FPathLabel := TPathLabel.Create(Self, True);
|
||||
FPathLabel.Parent := Self;
|
||||
|
||||
// Display path below address.
|
||||
// For correct alignment, first put path at the top, then address at the top.
|
||||
FPathLabel.Align := alTop;
|
||||
FAddressLabel.Align := alTop;
|
||||
|
||||
FPathEdit:= TKASPathEdit.Create(FPathLabel);
|
||||
FPathEdit.Parent:= Self;
|
||||
FPathEdit.Visible:= False;
|
||||
FPathEdit.TabStop:= False;
|
||||
FPathEdit.ObjectTypes:= [otFolders, otHidden];
|
||||
|
||||
OnResize:= @HeaderResize;
|
||||
|
||||
FPathEdit.OnExit:= @PathEditExit;
|
||||
FPathEdit.OnKeyDown:= @PathEditKeyDown;
|
||||
|
||||
FPathLabel.OnClick := @PathLabelClick;
|
||||
FPathLabel.OnMouseUp := @PathLabelMouseUp;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.HeaderResize(Sender: TObject);
|
||||
begin
|
||||
UpdateAddressLabel;
|
||||
UpdatePathLabel;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.UpdateAddressLabel;
|
||||
begin
|
||||
if FFileView.CurrentAddress = '' then
|
||||
begin
|
||||
FAddressLabel.Visible := False;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FAddressLabel.Top:= 0;
|
||||
FAddressLabel.Visible := True;
|
||||
FAddressLabel.Caption := FFileView.CurrentAddress;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.UpdatePathLabel;
|
||||
begin
|
||||
FPathLabel.Caption := MinimizeFilePath(FFileView.CurrentPath, FPathLabel.Canvas, FPathLabel.Width);
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.ShowPathEdit;
|
||||
begin
|
||||
with FPathLabel do
|
||||
begin
|
||||
FPathEdit.SetBounds(Left, Top, Width, Height);
|
||||
FPathEdit.Text := FFileView.CurrentPath;
|
||||
FPathEdit.Visible := True;
|
||||
FPathEdit.SetFocus;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileViewHeader.SetActive(bActive: Boolean);
|
||||
begin
|
||||
FAddressLabel.SetActive(bActive);
|
||||
FPathLabel.SetActive(bActive);
|
||||
end;
|
||||
|
||||
{ TBriefHeaderControl }
|
||||
|
||||
procedure TBriefHeaderControl.UpdateState;
|
||||
var
|
||||
i, Index: Integer;
|
||||
MaxState: THeaderSectionState;
|
||||
P: TPoint;
|
||||
begin
|
||||
MaxState := hsNormal;
|
||||
if Enabled then
|
||||
if FDown then
|
||||
begin
|
||||
MaxState := hsPressed;
|
||||
Index := FSelectedSection;
|
||||
end else if FMouseInControl then
|
||||
begin
|
||||
MaxState := hsHot;
|
||||
P := ScreenToClient(Mouse.CursorPos);
|
||||
Index := GetSectionAt(P);
|
||||
end;
|
||||
|
||||
for i := 0 to Sections.Count - 1 do
|
||||
if (i <> Index) then
|
||||
Sections[i].State := hsNormal
|
||||
else
|
||||
Sections[i].State := MaxState;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.Click;
|
||||
var
|
||||
Index: Integer;
|
||||
begin
|
||||
if FDown then
|
||||
begin
|
||||
inherited Click;
|
||||
Index := GetSectionAt(ScreenToClient(Mouse.CursorPos));
|
||||
if Index <> -1 then
|
||||
SectionClick(Sections[Index]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseEnter;
|
||||
begin
|
||||
inherited MouseEnter;
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FMouseInControl := True;
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseLeave;
|
||||
begin
|
||||
inherited MouseLeave;
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FMouseInControl := False;
|
||||
FDown := False;
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseDown(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FDown:= True;
|
||||
FSelectedSection:=GetSectionAt(Point(X, Y));
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBriefHeaderControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FDown:= False;
|
||||
UpdateState;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue