TStringList.IndexOf() 导致线程崩溃答案

【问题标题】：TStringList.IndexOf() causes thread to crashTStringList.IndexOf() 导致线程崩溃
【发布时间】：2013-10-27 20:19:30
【问题描述】：

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

但是，大约每 10 次运行中就有 1 次出现线程崩溃，但出现以下异常：

经过一番调试，我在搜索线程中将这一行隔离为崩溃原因：

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

在致电IndexOf() 之前，我曾尝试进行Assigned(FExtensions) 检查，但这并没有消除崩溃。如果我评论这一行，线程压力测试工作正常（以 100 毫秒的间隔创建/销毁它）。我知道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，但那是因为我想避免数据重复，所以我在线程销毁后将它传递给另一个继续使用它的对象）}

以及创建线程的过程：

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

【问题讨论】：

标签： multithreading delphi

【解决方案1】：

我只是通过调用 FFileSearchThreads.Free 来销毁线程，然后应该释放它的对象，因为 OwnObjects 是设置为真。 FFileSearchThreads 属于 TObjectList 输入。

等一下。你告诉你的线程之前 Terminate() 和 WaitFor() 让它们完成，是吗？如果没有，那你真的应该这样做！

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

可能值得考虑FreeOnTerminate := TRUE，本质上是让线程单独完成它们的清理工作。您仍然负责启动此过程，通常通过设置共享全局标志或TEvent 实例或类似的东西。这样您就可以解耦事物并摆脱线程列表。两种方法都有其优点和缺点。

【讨论】：

我相信TThread.Destroy() 已经这样做了？（Terminate() 然后WaitFor()）。检查System.Classes.TThread.Destroy()析构函数代码。
好的，所以我刚刚尝试了 .Terminate() 和 .WaitFor() 而不是只释放 objectlist 并且它有效！但是TThread 的.Destroy() 中的相同代码的目的是什么，为什么它不能那样工作？
你首先释放你的数据结构，然后调用inherited Destroy。此外，根据我的感觉，DTOR 不是等待线程终止的正确位置，恕我直言，VCL 代码只是为了避免显而易见的问题。但这是我个人的选择。
是的，我现在明白了。这确实解释了。我自己也得出了同样的结论。但是所写的答案并不能解释问题。我希望看到一个真正的答案来解释这一点。如果我是你，我会将所有类移动为Execute 的局部变量。通过将字符串列表复制到 CTOR 中的动态数组中，将信息传递给他们。
这将使您无法在对象被销毁后访问它们。本地化总是有助于避免此类陷阱。

【解决方案2】：

为了完整起见，这里是发生了什么：

Execute 方法使用FIgnorePaths 和FExtensions 对象。
析构函数会在 Execute 仍在运行时销毁这些对象。
然后Execute 在这些对象被释放后访问它们。轰隆隆！

查看线程的析构函数：

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;

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

【讨论】：

是的，我不知道最高级别的.Destroy()实际上是在线程从.Execute()退出之前调用的。
您可以在 DTOR 顶部调用 Terminate 和 WaitFor