I am writing a block to search for files ending with the specified extensions, and with the ability to skip the search for the specified directories. These data are contained in objects FExtensionsand FIgnorePaths TStringList, accordingly.
However, approximately 1 out of 10 starts, the flow of accidents with the following exception:
After debugging the bit, I highlighted this line in the search bar as the reason for the failure:
if FExtensions.IndexOf(ExtractFileExt(search_rec.Name)) <> -1 then
I tried to check Assigned(FExtensions)before calling IndexOf(), but that didn’t fix the crash. If I comment on this line, the stress test of the thread works fine (creating / destroying it with an interval of 100 ms). I know that TStringListit is not thread safe, but I do not get access to FExtensionsor to any other TStringListin the stream outside its scope, so simultaneous access should not be the cause of the failure.
Here is the file search flow section:
unit uFileSearchThread;
interface
uses
Winapi.Windows, System.Classes, System.Generics.Collections;
type
TFileSearchThread = class(TThread)
private
FExternalMessageHandler: HWND;
FMsg_FSTDone : Cardinal;
FPath : String;
FIgnorePaths : TStringList;
FExtensions : TStringList;
FFiles : TStringList;
function IsIgnoreDir(const ADir: String; out AKeepIgnoreCheck: Boolean): Boolean;
protected
procedure Execute; override;
public
constructor Create(const APath: String; const AIgnorePaths: TStringList; const AAllowedExtensions: TStringList; const AExternalMessageHandler: HWND; const AMsg_FSTDone: Cardinal);
destructor Destroy; override;
property Path : String read FPath;
property Files: TStringList read FFiles;
end;
TFileSearchThreads = TObjectList<TFileSearchThread>;
implementation
uses
System.SysUtils, System.StrUtils;
constructor TFileSearchThread.Create(const APath: String; const AIgnorePaths: TStringList; const AAllowedExtensions: TStringList; const AExternalMessageHandler: HWND; const AMsg_FSTDone: Cardinal);
begin
inherited Create(TRUE);
FExternalMessageHandler := AExternalMessageHandler;
FMsg_FSTDone := AMsg_FSTDone;
FPath := IncludeTrailingPathDelimiter(APath);
FIgnorePaths := TStringList.Create;
FIgnorePaths.Assign(AIgnorePaths);
FExtensions := TStringList.Create;
FExtensions.Assign(AAllowedExtensions);
FFiles := TStringList.Create;
WriteLn(FPath, ' file search thread created.');
end;
destructor TFileSearchThread.Destroy;
begin
FExtensions.Free;
FIgnorePaths.Free;
WriteLn(FPath, ' file search thread destroyed.');
inherited;
end;
function TFileSearchThread.IsIgnoreDir(const ADir: String; out AKeepIgnoreCheck: Boolean): Boolean;
var
C1: Integer;
begin
AKeepIgnoreCheck := FALSE;
if not Assigned(FIgnorePaths) then
Exit(FALSE);
for C1 := 0 to FIgnorePaths.Count - 1 do
if AnsiStartsText(FIgnorePaths[C1], ADir) then
Exit(TRUE)
else
if not AKeepIgnoreCheck then
AKeepIgnoreCheck := AnsiStartsText(ADir, FIgnorePaths[C1]);
Exit(FALSE);
end;
procedure TFileSearchThread.Execute;
var
search_rec : TSearchRec;
dirs : TStringList;
dirs_nocheck : TStringList;
dir : String;
ignore_check : Boolean;
ignore_check_tmp: Boolean;
newdir : String;
begin
dirs := TStringList.Create;
try
dirs_nocheck := TStringList.Create;
try
dirs.Add(FPath);
while (not Terminated) and
((dirs.Count > 0) or (dirs_nocheck.Count > 0)) do
begin
ignore_check := dirs.Count > 0;
if ignore_check then
begin
dir := dirs[0];
dirs.Delete(0);
end
else
begin
dir := dirs_nocheck[0];
dirs_nocheck.Delete(0);
end;
if (not ignore_check) or
(not IsIgnoreDir(LowerCase(dir), ignore_check)) then
if FindFirst(dir + '*', faAnyFile, search_rec) = 0 then
try
repeat
if (search_rec.Attr and faDirectory) = 0 then
begin
if FExtensions.IndexOf(ExtractFileExt(search_rec.Name)) <> -1 then // crashes here
FFiles.Add(dir + search_rec.Name);
end
else
if (search_rec.Name <> '.') and (search_rec.Name <> '..') then
begin
newdir := dir + search_rec.Name + '\';
if not ignore_check then
dirs_nocheck.Add(newdir)
else
if not IsIgnoreDir(LowerCase(newdir), ignore_check_tmp) then
if ignore_check_tmp then
dirs.Add(newdir)
else
dirs_nocheck.Add(newdir);
end;
until (Terminated) or (FindNext(search_rec) <> 0);
finally
FindClose(search_rec);
end;
end;
finally
dirs_nocheck.Free;
end;
finally
dirs.Free;
end;
PostMessage(FExternalMessageHandler, FMsg_FSTDone, NativeUInt(pointer(self)), 0);
end;
end.
(I know that I do not free FFiles in the destructor, but this is because I want to avoid duplication of data, so I pass it after destroying the stream to another object that continues to use it)
And the procedure that creates the thread:
procedure CreateFileSearchThread(const APath: String);
const
{$I ignore_dirs.inc}
{$I allowed_extensions.inc}
var
ignore_dirs_list, allowed_exts_list: TStringList;
file_search_thread : TFileSearchThread;
C1 : Integer;
begin
ignore_dirs_list := TStringList.Create;
try
ignore_dirs_list.Sorted := TRUE;
ignore_dirs_list.CaseSensitive := FALSE;
ignore_dirs_list.Duplicates := dupIgnore;
for C1 := Low(IGNORE_DIRS) to High(IGNORE_DIRS) do
ignore_dirs_list.Add(LowerCase(ExpandEnvStrings(IGNORE_DIRS[C1])));
allowed_exts_list := TStringList.Create;
try
allowed_exts_list.Sorted := TRUE;
allowed_exts_list.CaseSensitive := FALSE;
allowed_exts_list.Duplicates := dupIgnore;
for C1 := Low(ALLOWED_EXTS) to High(ALLOWED_EXTS) do
allowed_exts_list.Add('.' + ALLOWED_EXTS[C1]);
file_search_thread := TFileSearchThread.Create(APath, ignore_dirs_list, allowed_exts_list, FMessageHandler, FMsg_FSTDone);
FFileSearchThreads.Add(file_search_thread);
file_search_thread.Start;
finally
allowed_exts_list.Free;
end;
finally
ignore_dirs_list.Free;
end;
end;
, FFileSearchThreads.Free, , OwnObjects TRUE. FFileSearchThreads TObjectList<TFileSearchThread>.