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

* Fix handling of broken symlinks

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-09-26 08:22:31 +02:00
parent 1c6efc9edc
commit 564b477e05
1 changed files with 50 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
components/filebrowser/filebrowsertypes.pas
View File

@ -70,7 +70,7 @@ Type
Public
Constructor Create(aParent : TFileSystemEntry; const aName: string); override;
Destructor Destroy; override;
Procedure Clear; virtual;
Procedure Clear; override;
Procedure ReadEntries(aOptions : TReadEntryOptions); override;
Class function EntryType : TEntryType; override;
Class function HasEntries(aPath : String; aShowHidden : Boolean; aTypes : TEntryTypes = AllEntryTypes) : Boolean; virtual;
@ -86,6 +86,7 @@ Type
TFileEntryArray = Array of TFileEntry;
TTreeDoneEvent = procedure (Sender : TThread; aTree : TDirectoryEntry) of object;
TTreeErrorEvent = procedure (Sender : TThread; const aError : String) of object;
{ TTreeCreatorThread }
@ -94,9 +95,15 @@ Type
FRootDir : String;
FOptions : TReadEntryOptions;
FOnDone : TTreeDoneEvent;
FOnError : TTreeErrorEvent;
FNode : TDirectoryEntry;
FError : String;
Protected
procedure FillNode(N: TDirectoryEntry);
procedure DoDone;
procedure DoError;
Public
constructor Create(aRootDir: String; aOptions: TReadEntryOptions; aOnDone: TTreeDoneEvent);
constructor Create(aRootDir: String; aOptions: TReadEntryOptions; aOnDone: TTreeDoneEvent; aOnError : TTreeErrorEvent);
procedure execute; override;
end;
@ -121,10 +128,14 @@ const
KeySearchMatchOnlyFilename = 'MatchOnlyFileNames';
KeySearchAbsoluteFilenames = 'AbsoluteFileNames';
SViewFilebrowser = 'File browser';
resourcestring
SFileBrowserIDEMenuCaption = 'File Browser';
SFileSearcherIDEMenuCaption = 'File Searcher';
SErrSearching = 'Error searching for files in directory "%s": %s';
SFilesFound = 'Collected %d files in directory "%s"';
SSearchingFiles = 'Start collecting files in directory "%s"';
implementation
@ -236,7 +247,7 @@ var
LinkTarget : RawByteString;
isHidden : Boolean;
isType : TEntryType;
Add : Boolean;
begin
Clear;
CurrentDir:=IncludeTrailingPathDelimiter(AbsolutePath);
@ -267,8 +278,13 @@ begin
etDirectory : Entry:=TDirectoryEntry.Create(Self,Name);
etSymlink :
begin
try
if not FileGetSymLinkTarget(CurrentDir+Name,LinkTarget) then
LinkTarget:='<?>';
except
// We get an exception in 3.2.2
LinkTarget:='<?>';
end;
Entry:=TSymLinkEntry.Create(Self,Name,LinkTarget);
end;
else
@ -369,11 +385,14 @@ end;
{ TTreeCreatorThread }
constructor TTreeCreatorThread.Create(aRootDir: String; aOptions: TReadEntryOptions; aOnDone : TTreeDoneEvent);
constructor TTreeCreatorThread.Create(aRootDir: String;
aOptions: TReadEntryOptions; aOnDone: TTreeDoneEvent;
aOnError: TTreeErrorEvent);
begin
FRootDir:=aRootDir;
FOptions:=aOptions;
FOnDone:=aOnDone;
FOnError:=aOnError;
Inherited Create(false);
end;
@ -393,23 +412,40 @@ begin
end;
end;
procedure TTreeCreatorThread.DoDone;
begin
FOnDone(Self,FNode);
// Caller is responsible for freeing now...
FNode:=Nil;
end;
procedure TTreeCreatorThread.DoError;
begin
if assigned(FonError) then
FOnError(Self,FError);
end;
procedure TTreeCreatorThread.execute;
var
FNode : TDirectoryEntry;
begin
FNode:=TDirectoryEntry.Create(Nil,FRootDir);
try
FillNode(FNode);
Try
FillNode(FNode);
except
on E : Exception do
begin
FError:=Format('Error indexing %s : %s',[E.ClassName,E.Message]);
if Assigned(FOnError) then
Synchronize(@DoError);
Terminate;
end;
end;
if Not Terminated then
begin
if Assigned(FOnDOne) then
begin
FOnDone(Self,FNode);
// Caller is responsible for freeing now...
FNode:=Nil;
end;
Synchronize(@DoDone);
end;
finally
FNode.Free;