I've been writing unit to search for files that end with specified extensions and with ability to skip searching through specified directories. This data is contained in FExtensions and FIgnorePaths TStringList objects, respectively.
However, approximately 1 out of 10 runs, thread crashes with following exception:
After debugging a bit, I isolated this line in search thread as a crash cause:
if FExtensions.IndexOf(ExtractFileExt(search_rec.Name)) <> -1 then
I've tried to do Assigned(FExtensions) check before I call IndexOf(), but that didn't eliminated the crash. If I comment this line, thread stress test works fine (creating/destroying it with 100ms intervals). I know that TStringList isn't thread safe, but I do not access FExtensions nor any other TStringList in thread anywhere out of it's scope, so concurrent access shouldn't be crash cause.
Here is the file search thread unit:
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 don't free FFiles in destructor, but that is because I want to avoid data duplication, so I pass it after thread destruction to another object that keeps using it)
And 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;
I destroy thread simply by calling FFileSearchThreads.Free, which then should free it's objects, since OwnObjects is set to TRUE. FFileSearchThreads is of TObjectList<TFileSearchThread> type.