paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 00:02:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

FileUtil: implement TFileSearcher.OnQueryFileFound and OnQueryDirectoryFound. Gives the user the possibility

Browse Source 
to reject files and/or directories. If rejected OnFileFound/OnDirectoryFound/OnDirectoryEnter will not be fired.
This commit is contained in:
Bart 2023-11-06 15:16:32 +01:00
parent 54e9cc9171
commit 9ec85e5d2a
2 changed files with 42 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
components/lazutils/fileutil.inc
View File

@ -767,6 +767,19 @@ begin
if Assigned(FOnFileFound) then OnFileFound(Self); if Assigned(FOnFileFound) then OnFileFound(Self);
end; end;
procedure TFileSearcher.DoQueryFileFound(const Fn: String; var Accept: Boolean);
begin
if Assigned(FOnQueryFileFound) then
FOnQueryFileFound(Self, Fn, Accept);
end;
procedure TFileSearcher.DoQueryDirectoryFound(const Dir: String;
var Accept: Boolean);
begin
if Assigned(FOnQueryDirectoryFound) then
FOnQueryDirectoryFound(Self, Dir, Accept);
end;
constructor TFileSearcher.Create; constructor TFileSearcher.Create;
begin begin
inherited Create; inherited Create;
@ -785,12 +798,22 @@ var
SearchDirectories: TStringList; SearchDirectories: TStringList;
procedure DoSearch(const APath: String; const ALevel: Integer); procedure DoSearch(const APath: String; const ALevel: Integer);
function AcceptFile(const Fn: String): Boolean;
begin
Result := True;
DoQueryFileFound(Fn, Result);
end;
function AcceptDir(const Dir: String): Boolean;
begin
Result := True;
DoQueryDirectoryFound(Dir, Result);
end;
var var
P: String; P: String;
PathInfo: TSearchRec; PathInfo: TSearchRec;
begin begin
P := APath + AllDirectoryEntriesMask; P := APath + AllDirectoryEntriesMask;
if FindFirstUTF8(P, FileAttribute, PathInfo) = 0 then if FindFirstUTF8(P, FileAttribute, PathInfo) = 0 then
try try
repeat repeat
@ -800,7 +823,7 @@ var
// Deal with both files and directories // Deal with both files and directories
if (PathInfo.Attr and faDirectory) = 0 then if (PathInfo.Attr and faDirectory) = 0 then
begin // File begin // File
if (MaskList = nil) or MaskList.Matches(PathInfo.Name) then if ((MaskList = nil) or MaskList.Matches(PathInfo.Name)) and AcceptFile(PathInfo.Name) then
begin begin
FPath := APath; FPath := APath;
FLevel := ALevel; FLevel := ALevel;
@ -809,10 +832,13 @@ var
end; end;
end end
else begin // Directory else begin // Directory
FPath := APath; if AcceptDir(PathInfo.Name) then
FLevel := ALevel; begin
FFileInfo := PathInfo; FPath := APath;
DoDirectoryFound; FLevel := ALevel;
FFileInfo := PathInfo;
DoDirectoryFound;
end;
end; end;
until (FindNextUTF8(PathInfo) <> 0) or not FSearching; until (FindNextUTF8(PathInfo) <> 0) or not FSearching;
@ -827,7 +853,8 @@ var
repeat repeat
if (PathInfo.Name = '.') or (PathInfo.Name = '..') or if (PathInfo.Name = '.') or (PathInfo.Name = '..') or
(PathInfo.Name = '') or ((PathInfo.Attr and faDirectory) = 0) or (PathInfo.Name = '') or ((PathInfo.Attr and faDirectory) = 0) or
(not FFollowSymLink and FileIsSymlink(APath + PathInfo.Name)) (not FFollowSymLink and FileIsSymlink(APath + PathInfo.Name)) or
(not AcceptDir(PathInfo.Name))
then Continue; then Continue;
FPath := APath; FPath := APath;

8
components/lazutils/fileutil.pas
View File

@ -121,6 +121,8 @@ type
TFileFoundEvent = procedure (FileIterator: TFileIterator) of object; TFileFoundEvent = procedure (FileIterator: TFileIterator) of object;
TDirectoryFoundEvent = procedure (FileIterator: TFileIterator) of object; TDirectoryFoundEvent = procedure (FileIterator: TFileIterator) of object;
TDirectoryEnterEvent = procedure (FileIterator: TFileIterator) of object; TDirectoryEnterEvent = procedure (FileIterator: TFileIterator) of object;
TQueryFileFoundEvent = procedure (FileIterator: TFileIterator; const Fn: String; var Accept: Boolean) of object;
TQueryDirectoryFoundEvent = procedure (FileIterator: TFileIterator; const Dir: String; var Accept: Boolean) of object;
{ TFileSearcher } { TFileSearcher }
@ -134,11 +136,15 @@ type
FOnDirectoryEnter: TDirectoryEnterEvent; FOnDirectoryEnter: TDirectoryEnterEvent;
FFileAttribute: Word; FFileAttribute: Word;
FDirectoryAttribute: Word; FDirectoryAttribute: Word;
FOnQueryFileFound: TQueryFileFoundEvent;
FOnQueryDirectoryFound: TQueryDirectoryFoundEvent;
procedure RaiseSearchingError; procedure RaiseSearchingError;
protected protected
procedure DoDirectoryEnter; virtual; procedure DoDirectoryEnter; virtual;
procedure DoDirectoryFound; virtual; procedure DoDirectoryFound; virtual;
procedure DoFileFound; virtual; procedure DoFileFound; virtual;
procedure DoQueryFileFound(const Fn: String; var Accept: Boolean);
procedure DoQueryDirectoryFound(const Dir: String; var Accept: Boolean);
public public
constructor Create; constructor Create;
procedure Search(const ASearchPath: String; const ASearchMask: String = ''; procedure Search(const ASearchPath: String; const ASearchMask: String = '';
@ -152,6 +158,8 @@ type
property OnDirectoryFound: TDirectoryFoundEvent read FOnDirectoryFound write FOnDirectoryFound; property OnDirectoryFound: TDirectoryFoundEvent read FOnDirectoryFound write FOnDirectoryFound;
property OnFileFound: TFileFoundEvent read FOnFileFound write FOnFileFound; property OnFileFound: TFileFoundEvent read FOnFileFound write FOnFileFound;
property OnDirectoryEnter: TDirectoryEnterEvent read FOnDirectoryEnter write FOnDirectoryEnter; property OnDirectoryEnter: TDirectoryEnterEvent read FOnDirectoryEnter write FOnDirectoryEnter;
property OnQueryFileFound: TQueryFileFoundEvent read FOnQueryFileFound write FOnQueryFileFound;
property OnQueryDirectoryFound: TQueryDirectoryFoundEvent read FOnQueryDirectoryFound write FOnQueryDirectoryFound;
end; end;
{ TListFileSearcher } { TListFileSearcher }