Question

我一直在编写单元来搜索以指定扩展名结尾并且能够跳过搜索指定目录的文件。此数据分别包含在FExtensions和FIgnorePaths TStringList个对象中。

但是，大约有十分之一的运行，线程崩溃，但有以下异常：

thread crash exception

稍微调试一下后，我将搜索线程中的这一行隔离为崩溃原因：

if FExtensions.IndexOf(ExtractFileExt(search_rec.Name)) <> -1 then

在我致电Assigned(FExtensions)之前，我曾尝试IndexOf()检查，但这并没有消除崩溃。如果我评论这一行，线程压力测试工作正常（以100ms间隔创建/销毁它）。我知道TStringList不是线程安全的，但我不会在其范围之外的任何地方访问FExtensions或任何其他TStringList，因此并发访问不应该是崩溃原因。

这是文件搜索线程单元：

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.

_{（我知道我不会在析构函数中释放FFiles，但这是因为我想避免数据重复，因此我在线程销毁后将其传递给另一个继续使用它的对象）} < / p>

创建线程的程序：

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>类型。

Answer 1

我只是通过调用FFileSearchThreads.Free来销毁线程，然后应该释放它的对象，因为OwnObjects是设为TRUE。 FFileSearchThreads是TObjectList 类型。

等一下。你告诉你的主题终止（）之前和 WaitFor（）它们完成，是吗？如果没有，那么你真的应该这样做！

线程不仅包含存储在TThread实例中的数据。它分配与操作系统线程对象关联的一堆系统资源，该对象表示单个流程/执行上下文。必须正确释放这些资源并且需要停止执行，然后才能在内部OS对象周围Free（）Delphi对象。

值得考虑FreeOnTerminate := TRUE，基本上让线程单独进行清理工作。您仍然负责启动此过程，通常是通过设置共享全局标志或TEvent实例或类似的东西。通过这种方式，您可以解耦事物并摆脱线程列表。这两种方法都有其专业和有效性。

Answer 2

为了完整起见，这是正在发生的事情：

Execute方法正在使用FIgnorePaths和FExtensions个对象。
析构函数在Execute仍处于飞行状态时会破坏这些对象。
然后Execute在释放这些对象后访问它们。 BOOM！

查看线程的析构函数：

destructor TFileSearchThread.Destroy;
begin
  FExtensions.Free;  
  // Execute is still active at this point

  FIgnorePaths.Free; 
  // and still active here

  inherited;      
  // this calls Terminate and WaitFor, and that brings matters to a close, 
  // but not before the thread has opportunity to access the objects which
  // you just destroyed
end;

您需要重新设计内容，以确保线程在销毁后不会使用任何对象。

TStringList.IndexOf（）导致线程崩溃

2 个答案: