Prawdopodobnie w tym jest zastosowane rozwiązanie
procedure TFileSearch.SearchPerFilter(const ThisDir, ThisFilter: ansistring);
// Search the specified directory for specified filter. If
// SearchSubdirectories is set and a directory item is found, then that
// directory is searched recursively.
var
Item: TSearchRec;
Att: longint;
SearchRes: longint;
begin
Att := Attributes;
if SearchSubdirectories then
begin
SearchRes := SysUtils.FindFirst(ThisDir + '*',
(faDirectory or Att or faSymlink), Item);
try
//writeln(stderr, 'Debug: ', DateTimeToStr(Now), ': attributes chosen: $', IntToHex(faDirectory or Att or faSymlink, 4), '; symlink selected: $',IntToHex((faDirectory or Att or faSymlink) And faSymlink,4));
//also search in hidden, readonly etc dirs if we search for those files
//Fpc 2.3.1 supports faSymLink in the FindFirst/FindNext series of calls.
//If it is included in the attributes, then symbolic links are included as
//symbolic links and not as the file/dir they refer to.
//We must not follow symlinks to directories as they
// may lead to endless loops.
while SearchRes = 0 do
begin
{$IFDEF CRAZYDEBUG}
writeln(stderr, 'Debug: ', DateTimeToStr(Now),
': find says ', Item.Name, ' is a directory? ',
(Item.Attr and faDirectory) = faDirectory);
writeln(stderr, 'Debug: ', DateTimeToStr(Now),
': find says ', Item.Name, ' is a symlink? ',
(Item.Attr and faSymlink) = faSymLink);
{$ENDIF}
// Filter out any symlink/reparse point, as well as current and parent directories:
if (Item.Attr and faDirectory > 0) and (Item.Attr and faSymlink = 0) and
(Item.Name <> '.') and (Item.Name <> '..')
{$IFDEF Windows}
and ((Item.FindData.dwFileAttributes and FILE_ATTRIBUTE_REPARSE_POINT) = 0)
{$ENDIF}
then
begin
//Subdirectory; no symlink
{$IFDEF DEBUG}
writeln(stderr, 'Debug: ', DateTimeToStr(Now), ': into subdir ',
Item.Name, ': attribs: $', IntToHex(Item.Attr, 4), ';faSymlink: $',
IntToHex(faSymlink, 4), '; anded: ', Item.Attr and faSymlink);
{$ENDIF}
{$IFDEF STRINGLISTMETHOD}
{$IFDEF DEBUG}
writeln(stderr, 'Debug: ', DateTimeToStr(Now), ': adding tstringlist for ',
ThisDir + Item.Name + DirectorySeparator);
{$ENDIF}
SearchDirectories.Add(ThisDir + Item.Name + DirectorySeparator);
{$ENDIF}
SearchPerFilter(ThisDir + Item.Name + DirectorySeparator, ThisFilter);
end;
SearchRes := SysUtils.FindNext(Item);
end;
finally // prevent memory leaks:
SysUtils.FindClose(Item);
//In general, defined in filutil.h. For windows, defined in
end;
end; //done with searching subdirectories
SearchRes := SysUtils.FindFirst(ThisDir + ThisFilter,
((Att or faSymlink) and not faDirectory), Item);
//Find non-directory files; don't follow symlinks.
try
while SearchRes = 0 do
begin
if (Item.Name <> '.') and (Item.Name <> '..')
{$IFDEF Windows}
and ((Item.FindData.dwFileAttributes and FILE_ATTRIBUTE_REPARSE_POINT) = 0)
{$ENDIF}
then //added .. for Linux compatibility. Not sure if we really need it
begin
AddFileToResult(ThisDir, Item);
end
else //it is a directory: . or .. or a reparse point
begin
// Just ignore it.
{$IFDEF DEBUG}
writeln(stderr, 'Debug: ', DateTimeToStr(Now),
': found . or .. for file : ', Item.Name);
{$ENDIF}
end; //testing for dirs/reparse points
SearchRes := SysUtils.FindNext(Item);
end; //while
{$IFDEF STRINGLISTMETHOD}
{* Attempt to use stringlists to store directories that we still need to scan to avoid stack recursion
but it seems recursion works fine now so we don't need it. *}
//Entire directory checked so we can remove this from our to-do list:
{$IFDEF DEBUG}
writeln(stderr, 'Debug: ', DateTimeToStr(Now),
': removing tstringlist for ', ThisDir);
{$ENDIF}
try
SearchDirectories.Delete(SearchDirectories.IndexOf(ThisDir));
except
// We now have a directory dangling that we'll keep trying to index!?!?!
{$IFDEF DEBUG}
writeln(stderr, 'Debug: ', DateTimeToStr(Now),
': error removing tstringlist for ', ThisDir);
{$ENDIF}
end;
{$ENDIF}//stringlistmethod
finally //avoid memory leak
SysUtils.FindClose(Item);
end;
end;