为什么线程在线程 XXXXX 拥有的临界区被阻塞

Question

线程被等待链部分中的消息阻塞 “在线程 xxxxx 拥有的关键部分上阻塞” 如果我在创建线程后给睡眠，它们运行良好。 不知道为什么他们在关键部分被阻止 关键部分没有太多代码。任何人都可以帮助解决这个问题。

我的线程执行方法有一个全局变量，它位于关键部分，如下所示

procedure TMyThread.Execute();
Var
Filename : String;
FIleDone : Boolean;
begin
  inherited;
  FIleDone := False;
  while not FIleDone do                     //while there are still files
  begin
    try
    EnterCriticalSection(CriticalSection);   //Try to catch the critical section
                     //Access the shared variables
    //Are there still files available
    if FileList.Count = 0 then
    begin
      //Leave the critical section, when there are no files left
      LeaveCriticalSection(CriticalSection);
      //Leave the while loop
      FIleDone := true;
      self.Terminate;
      break;
    end
    else
    begin
      //Read the filename
      Filename := FileList.Strings[0];
      //Delete the file from the list
      FileList.Delete(0);
      //Leave the critical section
      LeaveCriticalSection(CriticalSection);

      CopyTable(ChangeFileExt(filename,''),Form1.TargetDir.Text);
    end;
    except
      LeaveCriticalSection(CriticalSection);
    end;
  end;

end;



procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
   t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15 : TMythread;
  TimeThen: TDateTime;
  TimeNow: TDateTime;
  Counter,id1,id2 : Integer;
begin

  TimeThen := now;
  FileList := TStringList.create();

  if Length(TargetDir.Text) > 1 then
    if TargetDir.Text[Length(TargetDir.Text)] <> '\' then
       TargetDir.Text := TargetDir.Text + '\';
  GetFileStringList(TargetDir.Text + '*.db', FileList);
  ProgressBar.Max := FileList.Count;
  t1  := TMyThread.create(false);
  //sleep(1000);
  t2 := TMyThread.create(false);
  //sleep(1000);
  t3 := TMyThread.create(false);
  //sleep(1000);
  t4 := TMyThread.create(false);
  //sleep(1000);
  t5 := TMyThread.create(false);
  //sleep(1000);
  t6  := TMyThread.create(false);
  //sleep(1000);
  t7 := TMyThread.create(false);
  //sleep(1000);
  t8 := TMyThread.create(false);
  //sleep(1000);
  t9 := TMyThread.create(false);
  //sleep(1000);
  t10 := TMyThread.create(false);
  //sleep(1000);
  t11 := TMyThread.create(false);
  //sleep(1000);
  t12 := TMyThread.create(false);
  //sleep(1000);
  t13 := TMyThread.create(false);
  //sleep(1000);
  t14 := TMyThread.create(false);
  //sleep(1000);
  //t15 := TMyThread.create(false);
 // sleep(1000);
  //mythread.Execute;
   while Done < 14 do
  begin
    progressBar.Position :=   ProgressBar.Max - FileList.Count;

    Application.ProcessMessages;
  end;

  // end;
    //ProgressBar.Position := ProgressBar.Position + 1;
  //end;
  //ChangeCOCompanyLegalName();
  TimeNow := Now;
  if ((TimeNow - TimeThen) * 24 * 60 * 60) < 60 then
    ShowMessage('done in ' + FormatFloat('###',((Now - TimeThen) * 24 * 60 * 60)) + ' seconds')
  else
    if ((TimeNow - TimeThen) * 24 * 60) < 60 then
      ShowMessage('done in ' + FormatFloat('###.00',((Now - TimeThen) * 24 * 60)) + ' minutes')
    else
      ShowMessage('done in ' + FormatFloat('###.00',((Now - TimeThen) * 24)) + ' hours');

  //FileList.Free;
end;

Answer 1

您没有正确管理关键部分（甚至在更新进度条时根本没有使用它）。您的代码还有其他问题，例如在 TMyThread.Execute() 内部使用 Form1.TargetDir.Text 不是线程安全的，因此您需要摆脱它。

尝试类似的方法：

type
  TMyThread = class(TThread)
  private
    FTargetDir: string;
    ...
  protected
    procedure Execute; override;
  public
    constructor Create(const ATargetDir: String); reintroduce;
  end;

var
  CriticalSection: TRTLCriticalSection;
  FileList: TStringList;

constructor TMyThread.Create(const ATargetDir: String);
begin  
  inherited Create(False);
  FTargetDir := ATargetDir;
end;

procedure TMyThread.Execute;
var
  Filename : String;
begin
  while not Terminated do
  begin
    EnterCriticalSection(CriticalSection);
    try
      if FileList.Count = 0 then Exit;
      Filename := FileList.Strings[0];
      FileList.Delete(0);
    finally
      LeaveCriticalSection(CriticalSection);
    end;

    if not Terminated then
      CopyTable(ChangeFileExt(FileName, ''), FTargetDir);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  MaxThreads = 15;
var
  Idx, NumThreads: Integer;
  Threads: array[0..MaxThreads-1] of TMyThread;
  Handles: array[0..MaxThreads-1] of THandle;
  TimeStart, TimeElapsed, Ret: DWORD;
  Dir: string;
begin
  TimeStart := GetTickCount;

  FileList := TStringList.Create;
  try
    Dir := TargetDir.Text;
    if Dir <> '' then Dir := IncludeTrailingPathDelimiter(Dir);

    GetFileStringList(Dir + '*.db', FileList);
    ProgressBar.Max := FileList.Count;
    if FileList.Count = 0 then Exit;

    NumThreads := 0;
    try
      for Idx := 1 to MaxThreads do
      begin
        Threads[NumThreads] := TMyThread.Create(Dir);
        Handles[NumThreads] := Threads[NumThreads].Handle;
        Inc(NumThreads);
      end;

      Timer1.Enabled := True;
      try
        repeat
          Ret := WaitForMultipleObjects(NumThreads, PWOHandleArray(@Handles), False, INFINITE);
          if Ret := WAIT_FAILED then RaiseLastOSError;
          if (Ret >= WAIT_OBJECT_0) and (Ret < (WAIT_OBJECT_0+NumThreads)) then
          begin
            Idx := Integer(Ret - WAIT_OBJECT_0);
            Threads[Idx].Free;
            if Idx < (NumThreads-1) then
            begin
              Move(Threads[Idx+1], Threads[idx], (NumThreads-(Idx+1)) * SizeOf(TMyThread));
              Move(Handles[Idx+1], Handles[Idx], (NumThreads-(Idx+1)) * SizeOf(THandle));
            end;
            Dec(NumThreads);
          end
          else if Ret = (WAIT_OBJECT_0+NumThreads) then
          begin
            Application.ProcessMessages;
          end;
        until NumThreads = 0;
      finally
        Timer1.Enabled := False;
      end;
    finally
      for Idx := 0 to NumThreads-1 do
      begin
        Threads[Idx].Terminate;
        Threads[Idx].WaitFor;
        Threads[Idx].Free;
      end;
    end;
  finally
    FileList.Free;
  end;

  TimeElapsed := GetTickCount - TimeStart;

  if TimeElapsed < 1000 then
    ShowMessage('done in ' + FormatFloat('###', TimeElapsed) + ' milliseconds')
  else if TimeElapsed < (1000 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60)) + ' seconds')
  else if TimeElapsed < (1000 * 60 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60)) + ' minutes')
  else
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60 * 24)) + ' hours');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Cnt: Integer;
begin    
  EnterCriticalSection(CriticalSection);
  try
    Cnt := FileList.Count;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
  ProgressBar.Position := ProgressBar.Max - Cnt;
end;

或者，将 UI 代码更改为根本不使用等待循环：

type
  TMyThread = class(TThread)
  private
    FTargetDir: string;
    ...
  protected
    procedure Execute; override;
  public
    constructor Create(const ATargetDir: String); reintroduce;
  end;

var
  CriticalSection: TRTLCriticalSection;
  FileList: TStringList;

constructor TMyThread.Create(const ATargetDir: String);
begin  
  inherited Create(True);
  FreeOnTerminate := True;
  FTargetDir := ATargetDir;
end;

procedure TMyThread.Execute;
var
  Filename : String;
begin
  while not Terminated do
  begin
    EnterCriticalSection(CriticalSection);
    try
      if FileList.Count = 0 then Exit;
      Filename := FileList.Strings[0];
      FileList.Delete(0);
    finally
      LeaveCriticalSection(CriticalSection);
    end;

    if not Terminated then
      CopyTable(ChangeFileExt(FileName, ''), FTargetDir);
  end;
end;

const
  MaxThreads = 15;

var
  Threads: TList;
  TimeStart: DWORD;

procedure TForm1.Button1Click(Sender: TObject);
var
  Idx: Integer;
  Thread: TMyThread;
  Dir: string;
begin
  if Threads <> nil then
  begin
    while Threads.Count > 0 do
    begin
      with TMyThread(Threads[0]) do
      begin
        OnTerminate := nil;
        Terminate;
      end;
      Threads.Delete(0);
    end;
  end;

  if FileList = nil then
    FileList := TStringList.Create;

  Dir := TargetDir.Text;
  if Dir <> '' then Dir := IncludeTrailingPathDelimiter(Dir);

  TimeStart := GetTickCount;

  GetFileStringList(Dir + '*.db', FileList);
  ProgressBar.Max := FileList.Count;
  if FileList.Count = 0 then Exit;

  if Threads = nil then
    Threads := TList.Create;

  for Idx := 1 to MaxThreads do
  begin
    Thread := TMyThread.Create(Dir);
    Thread.OnTerminate := ThreadTerminated;
    try
      Threads.Add(Thread);
      try
        Thread.Resume;
      except
        Threads.Remove(Thread);
        raise;
      end;
    except
      Thread.Free;
      raise;
    end;
  end;

  Timer1.Enabled := True;
end;

procedure TForm1.ThreadTerminated(Sender: TObject);
var
  TimeElapsed: DWORD;
begin
  Threads.Remove(TMyThread(Sender));
  if Threads.Count > 0 then Exit;

  Timer1.Enabled := False;
  FreeAndNil(Threads);
  FreeAndNil(FileList);

  TimeElapsed := GetTickCount - TimeStart;

  if TimeElapsed < 1000 then
    ShowMessage('done in ' + FormatFloat('###', TimeElapsed) + ' milliseconds')
  else if TimeElapsed < (1000 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60)) + ' seconds')
  else if TimeElapsed < (1000 * 60 * 60) then
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60)) + ' minutes')
  else
    ShowMessage('done in ' + FormatFloat('###.00', TimeElapsed / (1000 * 60 * 60 * 24)) + ' hours');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Cnt: Integer;
begin    
  EnterCriticalSection(CriticalSection);
  try
    Cnt := FileList.Count;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
  ProgressBar.Position := ProgressBar.Max - Cnt;
end;